- 追加された行はこの色です。
- 削除された行はこの色です。
*[[Haskell:http://www.haskell.org/]] [#r7b07a76]
#ref(http://upload.wikimedia.org/wikipedia/commons/thumb/1/1c/Haskell-Logo.svg/200px-Haskell-Logo.svg.png,right,around,nolink,Haskell)
&color(White,#5F2F2F){ ''◆CONTENTS◆'' };&br;
#contents
*Summary [#j02438c3]
Haskell は非正格な純粋関数型プログラミング言語です．~
-[http://www.haskell.org/ Haskell]
-[http://www.haskell.org/haskellwiki/Haskell HaskellWiki]
-[http://www.haskell.org/pipermail/libraries/ The Libraries Archives]
-[[HaskellJP wiki:http://wiki.haskell.jp/]]
-[[Learn You a Haskell for Great Good!:http://learnyouahaskell.com/]]
-[http://d.hatena.ne.jp/kazu-yamamoto/touch/20140206/1391666962 Real World Haskell の古いところ]
-[[ゆるふわHaskell (Light & Airy Haskell):http://kzfm.github.io/laskell/]]
-http://maoe.hatenadiary.jp/archive/category/Haskell
-[[本物のプログラマはHaskellを使う:http://itpro.nikkeibp.co.jp/article/COLUMN/20060915/248215/]]
-[[Haskellで文字列を UTF-32 ⇔UTF-16 変換する。:http://d.hatena.ne.jp/sirocco/20130416/1366103044]]
-[[Haskellで副作用を起こす(Win32 API によるUTF-16 ⇔ Shift-JIS 変換):http://d.hatena.ne.jp/sirocco/20130422/1366632065]]
-[[島ぶくろ Haskellプログラミング:http://saltheads.blog134.fc2.com/blog-category-16.html]]
-[[unsafePerformIOでunsafeなグローバル変数を作る。:http://d.hatena.ne.jp/napthats/20120426/1335416167]]
-[[Haskellの構造体をCと同期させる:http://tsubaki.hatenablog.com/entry/20110112/1294759187]]
-[[Haskell@Windowsのコンソールで日本語が文字化けする話の対策:http://tsubaki.hatenablog.com/entry/2013/02/20/090115]]
-[[How do I use Haskell's FFI on structs?:http://stackoverflow.com/questions/670221/how-do-i-use-haskells-ffi-on-structs]]
-http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise6.html
-http://darcs.haskell.org/testsuite/timeout/
--http://darcs.haskell.org/testsuite/timeout/WinCBindings.hsc
-https://bitbucket.org/dionthegod/fuzzywuzzy/src/cfd324244691/System/Win32/DebugProcess.hsc
-http://tanakh.jp/pub/pfi-seminar-2011-12-08.html#1
-http://www.ync-net.co.jp/~kaz/cgi-bin/WiLiKi/wiliki.cgi?try%2fthrow%2fcatch%2ffinally
-http://keqh.net/cookbook/
-[[Haskell の例外処理:http://tnomura9.exblog.jp/15094780/]]
-[[Haskell での例外処理:http://d.hatena.ne.jp/kazu-yamamoto/20120604/1338802792]], [[Haskellでの例外処理(その2):http://d.hatena.ne.jp/kazu-yamamoto/20120605/1338871044]]
-http://stackoverflow.com/questions/6009384/exception-handling-in-haskell
-http://stackoverflow.com/questions/2386210/how-to-get-a-pointer-value-in-haskell
-[[48時間でSchemeを書こう:http://ja.wikibooks.org/wiki/48%E6%99%82%E9%96%93%E3%81%A7Scheme%E3%82%92%E6%9B%B8%E3%81%93%E3%81%86]]
-[[Haskellの勉強をしていたら、Elixirのパイプライン演算子がF#由来であることを知った:http://d.hatena.ne.jp/ajiyoshi/20130127/1359284684]]
-[[ファンクタ, アプリカティブ, モナド:https://gist.github.com/kohyama/5856037]]
-[[lhs2TeX:http://www.andres-loeh.de/lhs2tex/]]
-[[Haskell Advent Calendar 2013 - Qiita [キータ]:http://qiita.com/advent-calendar/2013/haskell]]
-[[Theorem Prover Advent Calendar 2013 - Qiita [キータ]:http://qiita.com/advent-calendar/2013/theorem_prover]]
-[[Haskell for OCaml programmers:http://staff.science.uva.nl/~poss/haskell-for-ocaml-programmers.html]]
-[http://cx4a.org/posts/2014-06-03-solve-the-configurations-problem-for-haskell.html HaskellにおけるConfigurations Problemを解決する]
-[http://www.sampou.org/haskell/haskell2010-report-htja/ Haskell 2010 言語報告書]
--[http://www.sampou.org/haskell/haskell2010-report-htja/haskellch8.html Chapter 8 外部関数インターフェイス]
*Haskell で LaTeX [#b3f747e0]
**HaTeX [#vb17eba3]
-[http://www.haskell.org/haskellwiki/HaTeX HaTeX - HaskellWiki]
*[[fwdsumatrapdf>SumatraPDF/fwdsumatrapdf]] &aname(fwdsumatrapdf); [#j60bcd39]
**Haskell 版 [#cbd580e5]
The Glorious Glasgow Haskell Compilation System, version 7.8.2 で動作確認しています．~
Windows PowerShell またはコマンド プロンプトから以下のようにしてビルドします．~
ghc fwdsumatrapdf.hs
----
-fwdsumatrapdf.hs
----
-- vim: ts=4 sw=4 expandtab:
-- >ghc fwdsumatrapdf.hs
module Main where
import System.Directory (doesFileExist)
import System.Environment (getArgs, getProgName)
import System.Exit (exitWith, ExitCode(ExitSuccess, ExitFailure))
import System.IO.Unsafe (unsafePerformIO)
import System.Win32.Registry (regOpenKeyEx, regQueryValue, regCloseKey, hKEY_LOCAL_MACHINE, kEY_QUERY_VALUE)
import System.Win32.Types (nullPtr, nullFinalHANDLE, BOOL, BYTE, WORD, DWORD, UINT, LPARAM, LPBYTE, LPDWORD, LPWSTR, LPCWSTR, LPVOID, HANDLE)
import Graphics.Win32.GDI.Types (HWND)
import Data.Bits ((.|.))
import Data.IORef (newIORef, readIORef, writeIORef, IORef)
import Control.Exception (bracket, catch, throwIO, SomeException)
import Foreign.C.String (newCWString, withCWString, withCWStringLen, CWString)
import Foreign.C.Types (CInt(..), CUInt(..), CWchar(..))
import Foreign.Ptr (castPtr, Ptr, FunPtr)
import Foreign.Marshal.Alloc (alloca, free)
import Foreign.Marshal.Array (mallocArray)
import Foreign.Storable (alignment, sizeOf, peek, peekByteOff, poke, pokeByteOff, Storable)
foreign import ccall unsafe "wchar.h wcscmp"
c_wcscmp :: CWString -> CWString -> IO CInt
foreign import ccall unsafe "wchar.h wcsrchr"
c_wcsrchr :: CWString -> CWchar -> IO (Ptr CWchar)
foreign import stdcall unsafe "windows.h GetWindowTextW"
getWindowTextW :: HWND -> LPWSTR -> CInt -> IO CInt
foreign import stdcall unsafe "wrapper"
mkEnumWindowsProc :: EnumWindowsProc -> IO (FunPtr EnumWindowsProc)
foreign import stdcall safe "windows.h EnumWindows"
enumWindows :: FunPtr EnumWindowsProc -> LPARAM -> IO BOOL
foreign import stdcall unsafe "windows.h CreateProcessW"
createProcessW :: LPCWSTR -> LPWSTR -> Ptr () -> Ptr () -> BOOL -> DWORD -> LPVOID -> LPCWSTR -> LPSTARTUPINFOW -> LPPROCESS_INFORMATION -> IO BOOL
foreign import stdcall unsafe "windows.h WaitForInputIdle"
waitForInputIdle :: HANDLE -> DWORD -> IO DWORD
foreign import stdcall unsafe "wrapper"
mkDdeCallback :: DdeCallback -> IO (FunPtr DdeCallback)
foreign import stdcall unsafe "ddeml.h DdeInitializeW"
ddeInitializeW :: LPDWORD -> FunPtr DdeCallback -> DWORD -> DWORD -> IO UINT
foreign import stdcall unsafe "ddeml.h DdeUninitialize"
ddeUninitialize :: DWORD -> IO BOOL
foreign import stdcall unsafe "ddeml.h DdeCreateStringHandleW"
ddeCreateStringHandleW :: DWORD -> LPWSTR -> CInt -> IO HANDLE
foreign import stdcall unsafe "ddeml.h DdeFreeStringHandle"
ddeFreeStringHandle :: DWORD -> HANDLE -> IO BOOL
foreign import stdcall unsafe "ddeml.h DdeGetLastError"
ddeGetLastError :: DWORD -> IO UINT
foreign import stdcall unsafe "ddeml.h DdeCreateDataHandle"
ddeCreateDataHandle :: DWORD -> LPBYTE -> DWORD -> DWORD -> HANDLE -> UINT -> UINT -> IO HANDLE
foreign import stdcall unsafe "ddeml.h DdeFreeDataHandle"
ddeFreeDataHandle :: HANDLE -> IO BOOL
foreign import stdcall unsafe "ddeml.h DdeClientTransaction"
ddeClientTransaction :: LPBYTE -> DWORD -> HANDLE -> HANDLE -> UINT -> UINT -> DWORD -> LPDWORD -> IO HANDLE
foreign import stdcall unsafe "ddeml.h DdeConnect"
ddeConnect :: DWORD -> HANDLE -> HANDLE -> Ptr () -> IO HANDLE
foreign import stdcall unsafe "ddeml.h DdeDisconnect"
ddeDisconnect :: HANDLE -> IO BOOL
type EnumWindowsProc = HWND -> LPARAM -> IO BOOL
type DdeCallback = UINT -> UINT -> HANDLE -> HANDLE -> HANDLE -> HANDLE -> DWORD -> DWORD -> IO HANDLE
type LPPROCESS_INFORMATION = Ptr PROCESS_INFORMATION
data PROCESS_INFORMATION = PROCESS_INFORMATION
{ piProcess :: HANDLE
, piThread :: HANDLE
, piProcessId :: DWORD
, piThreadId :: DWORD
} deriving Show
instance Storable PROCESS_INFORMATION where
sizeOf = const (16)
alignment = sizeOf
poke buf pi = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (piProcess pi)
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (piThread pi)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (piProcessId pi)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) buf (piThreadId pi)
peek buf = do
vhProcess <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
vhThread <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
vdwProcessId <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
vdwThreadId <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) buf
return $ PROCESS_INFORMATION {
piProcess = vhProcess,
piThread = vhThread,
piProcessId = vdwProcessId,
piThreadId = vdwThreadId}
type LPSTARTUPINFOW = Ptr STARTUPINFOW
data STARTUPINFOW = STARTUPINFOW
{ siCb :: DWORD
, siDesktop :: LPWSTR
, siTitle :: LPWSTR
, siX :: DWORD
, siY :: DWORD
, siXSize :: DWORD
, siYSize :: DWORD
, siXCountChars :: DWORD
, siYCountChars :: DWORD
, siFillAttribute :: DWORD
, siFlags :: DWORD
, siShowWindow :: WORD
, siStdInput :: HANDLE
, siStdOutput :: HANDLE
, siStdError :: HANDLE
} deriving Show
instance Storable STARTUPINFOW where
sizeOf = const (68)
alignment = sizeOf
poke buf si = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (siCb si)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (siDesktop si)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) buf (siTitle si)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) buf (siX si)
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) buf (siY si)
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) buf (siXSize si)
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) buf (siYSize si)
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) buf (siXCountChars si)
((\hsc_ptr -> pokeByteOff hsc_ptr 36)) buf (siYCountChars si)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) buf (siFillAttribute si)
((\hsc_ptr -> pokeByteOff hsc_ptr 44)) buf (siFlags si)
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) buf (siShowWindow si)
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) buf (siStdInput si)
((\hsc_ptr -> pokeByteOff hsc_ptr 60)) buf (siStdOutput si)
((\hsc_ptr -> pokeByteOff hsc_ptr 64)) buf (siStdError si)
peek buf = do
vcb <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
vlpDesktop <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
vlpTitle <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) buf
vdwX <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) buf
vdwY <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) buf
vdwXSize <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) buf
vdwYSize <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) buf
vdwXCountChars <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) buf
vdwYCountChars <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) buf
vdwFillAttribute <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) buf
vdwFlags <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf
vwShowWindow <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) buf
vhStdInput <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) buf
vhStdOutput <- ((\hsc_ptr -> peekByteOff hsc_ptr 60)) buf
vhStdError <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) buf
return $ STARTUPINFOW {
siCb = vcb,
siDesktop = vlpDesktop,
siTitle = vlpTitle,
siX = vdwX,
siY = vdwY,
siXSize = vdwXSize,
siYSize = vdwYSize,
siXCountChars = vdwXCountChars,
siYCountChars = vdwYCountChars,
siFillAttribute = vdwFillAttribute,
siFlags = vdwFlags,
siShowWindow = vwShowWindow,
siStdInput = vhStdInput,
siStdOutput = vhStdOutput,
siStdError = vhStdError}
aPPCMD_CLIENTONLY :: DWORD
aPPCMD_CLIENTONLY = 0x10
cP_WINUNICODE :: CInt
cP_WINUNICODE = 1200
cF_UNICODETEXT :: UINT
cF_UNICODETEXT = 13
xCLASS_FLAGS :: UINT
xCLASS_FLAGS = 0x4000
xTYP_EXECUTE :: UINT
xTYP_EXECUTE = 0x0050 .|. xCLASS_FLAGS
timeout :: DWORD
timeout = 10000
{-# NOINLINE existSumatraHWND #-}
existSumatraHWND :: IORef Bool
existSumatraHWND = unsafePerformIO $ newIORef False
runSumatraPDF :: String -> IO Bool
runSumatraPDF pdf = do
enumwindowsproc <- mkEnumWindowsProc getSumatraHWND
enumWindows enumwindowsproc lParam
existSumatraPDF <- readIORef existSumatraHWND
case existSumatraPDF of
True -> return True
False -> do
findSumatraPDFInRegistry
return True
where
sumatrapdfWin32 = "C:\\Program Files\\SumatraPDF\\SumatraPDF.exe"
sumatrapdfWin64 = "C:\\Program Files (x86)\\SumatraPDF\\SumatraPDF.exe"
reuseInstance = "-reuse-instance"
lParam = 0
getSumatraHWND hwnd lParam = do
let maxSize = 1024
let latinCapitalLetterS = 0x53 -- 'S' == 0x53
bracket
(do windowText <- mallocArray (fromIntegral maxSize)
sumatrapdf <- newCWString "SumatraPDF"
return (windowText, sumatrapdf))
(\(windowText, sumatrapdf) -> do
free windowText
free sumatrapdf)
(\(windowText, sumatrapdf) -> do
getWindowTextW hwnd windowText maxSize
title <- c_wcsrchr windowText latinCapitalLetterS
if title /= nullPtr
then do
cmp <- c_wcscmp title sumatrapdf
if cmp == 0 then do
writeIORef existSumatraHWND True
return True
else do
return True
else do
return True)
findSumatraPDFInRegistry = do
let keyPath = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\SumatraPDF.exe"
regKey <- regOpenKeyEx hKEY_LOCAL_MACHINE keyPath kEY_QUERY_VALUE
if regKey /= nullFinalHANDLE
then do
sumatrapdfRegistry <- regQueryValue regKey Nothing
regCloseKey regKey
startSumatraPDF sumatrapdfRegistry
return True
else do
findSumatraPDF sumatrapdfWin32
findSumatraPDF sumatrapdfWin64
return False
findSumatraPDF file = do
exist <- doesFileExist file
if exist
then do
startSumatraPDF file
return True
else do
return False
startSumatraPDF file = do
let sumatrapdfCommandLine = "\"" ++ file ++ "\" " ++ reuseInstance ++ " " ++ "\"" ++ pdf ++ "\""
withCWString sumatrapdfCommandLine $ \cmd -> do
alloca $ \p_si -> do
alloca $ \p_pi -> do
createProcessW nullPtr cmd nullPtr nullPtr False 0 nullPtr nullPtr p_si p_pi
pi <- peek p_pi
waitForInputIdle (piProcess pi) (fromIntegral timeout)
ddeExecute :: String -> String -> String -> IO (DWORD, HANDLE, HANDLE, HANDLE, HANDLE, HANDLE)
ddeExecute server topic command = do
bracket
(getIdInstance)
(\idInstance -> do
if idInstance /= 0 then ddeUninitialize idInstance else return False)
(\idInstance -> do
bracket
(getHszServer idInstance server)
(\hszServer -> do
if hszServer /= nullPtr then ddeFreeStringHandle idInstance hszServer else return False)
(\hszServer -> do
bracket
(getHszTopic idInstance topic)
(\hszTopic -> do
if hszTopic /= nullPtr then ddeFreeStringHandle idInstance hszTopic else return False)
(\hszTopic -> do
bracket
(getHConvClient idInstance hszServer hszTopic)
(\hConvClient -> do
if hConvClient /= nullPtr then ddeDisconnect hConvClient else return False)
(\hConvClient -> do
bracket
(getHDdeData idInstance command)
(\hDdeData -> do
if hDdeData /= nullPtr then ddeFreeDataHandle hDdeData else return False)
(\hDdeData -> do
bracket
(getHDdeTransactionData hDdeData hConvClient)
(\hDdeTransactionData -> do
if hDdeTransactionData /= nullPtr then ddeFreeDataHandle hDdeTransactionData else return False)
(\hDdeTransactionData -> do
return (idInstance, hszServer, hszTopic, hConvClient, hDdeData, hDdeTransactionData)))))))
where
sumatraDdeCallback uType uFmt hconv hsz1 hsza2 hdata dwData1 dwData2 = do
return nullPtr
getIdInstance = do
alloca $ \p_idInstance -> do
ddecallback <- mkDdeCallback sumatraDdeCallback
e <- ddeInitializeW p_idInstance ddecallback aPPCMD_CLIENTONLY 0
idInstance <- peek p_idInstance
if idInstance == 0 || e /= 0 then do
throwIO $ userError "ddeInitializeW Error"
return idInstance
else return idInstance
getHszServer idInstance server = do
withCWString server $ \sv -> do
hszServer <- ddeCreateStringHandleW idInstance sv cP_WINUNICODE
if hszServer == nullPtr then throwIO $ userError "ddeCreateStringHandleW Error" else return True
return hszServer
getHszTopic idInstance topic = do
withCWString topic $ \tp -> do
hszTopic <- ddeCreateStringHandleW idInstance tp cP_WINUNICODE
if hszTopic == nullPtr then throwIO $ userError "ddeCreateStringHandleW Error" else return True
return hszTopic
getHConvClient idInstance hszServer hszTopic = do
hConvClient <- ddeConnect idInstance hszServer hszTopic nullPtr
if hConvClient == nullPtr then throwIO $ userError "ddeConnect Error" else return True
return hConvClient
getHDdeData idInstance command = do
withCWStringLen command $ \(cmd, len) -> do
hDdeData <- ddeCreateDataHandle idInstance (castPtr cmd) (fromIntegral ((len + 1) * (sizeOf (undefined :: CWchar)))) 0 nullPtr cF_UNICODETEXT 0
if hDdeData == nullPtr then throwIO $ userError "ddeCreateDataHandle Error" else return True
return hDdeData
getHDdeTransactionData hDdeData hConvClient = do
hDdeTransactionData <- ddeClientTransaction (castPtr hDdeData) (-1) hConvClient nullPtr 0 xTYP_EXECUTE timeout nullPtr
if hDdeTransactionData == nullPtr then throwIO $ userError "ddeClientTransaction Error" else return True
return hDdeTransactionData
main :: IO a
main = do
args <- getArgs
usage args
let pdf = args !! 0
let tex = args !! 1
let line = read $ args !! 2 :: Int
runSumatraPDF pdf `catch` printError
let active = 0
let forwardSearch = "[ForwardSearch(\"" ++ pdf ++ "\",\"" ++ tex ++ "\"," ++ show line ++ ",0,0," ++ show active ++ ")]"
ddeExecute "SUMATRA" "control" forwardSearch `catch` printError
exitWith ExitSuccess
where
usage args = do
case length args of
3 -> return ExitSuccess
_ -> do
progName <- getProgName
putStrLn $ "usage: " ++ progName ++ " pdffile texfile line"
exitWith $ ExitFailure 2
printError :: SomeException -> IO a
printError e = do
print e
exitWith $ ExitFailure 1
----
