ghc-modi takes "cmd arg".

This commit is contained in:
Kazu Yamamoto 2014-03-24 17:32:06 +09:00
parent 9b629a0afb
commit 9b67baafba
2 changed files with 25 additions and 15 deletions

View File

@ -61,7 +61,7 @@
(setq ghc-check-original-file file) (setq ghc-check-original-file file)
(erase-buffer) (erase-buffer)
(let ((pro (ghc-check-get-process cpro name buf))) (let ((pro (ghc-check-get-process cpro name buf)))
(process-send-string pro (concat file "\n")))))))) (process-send-string pro (concat "check " file "\n"))))))))
(defun ghc-check-get-process-name () (defun ghc-check-get-process-name ()
(let ((file (buffer-file-name))) (let ((file (buffer-file-name)))

View File

@ -1,14 +1,14 @@
module Main where module Main where
import Control.Monad import Control.Monad (when, void)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.List import Data.List (intercalate)
import Data.Set as S import Data.Set as S
import Exception (ghandle, SomeException(..)) import Exception (ghandle, SomeException(..))
import GHC import GHC
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Internal import Language.Haskell.GhcMod.Internal
import System.IO import System.IO (hFlush,stdout)
main :: IO () main :: IO ()
main = do main = do
@ -35,21 +35,31 @@ run (LineSeparator ls) body = do
loop :: IO [String] -> LineSeparator -> Set FilePath -> Ghc () loop :: IO [String] -> LineSeparator -> Set FilePath -> Ghc ()
loop readLog ls set = do loop readLog ls set = do
file <- liftIO $ getLine cmdArg <- liftIO $ getLine
let (cmd,arg') = break (== ' ') cmdArg
arg = dropWhile (== ' ') arg'
(msgs,ok,set') <- case cmd of
"check" -> checkStx readLog ls set arg
_ -> return ([], False, set)
mapM_ (liftIO . putStrLn) msgs
liftIO $ putStrLn $ if ok then "OK" else "NG"
liftIO $ hFlush stdout
when ok $ loop readLog ls set'
checkStx :: IO [String]
-> LineSeparator
-> Set FilePath
-> FilePath
-> Ghc ([String], Bool, Set FilePath)
checkStx readLog ls set file = do
let add = not $ S.member file set let add = not $ S.member file set
(errmsgs,ok) <- ghandle handler $ do ghandle handler $ do
when add $ addTargetFiles [file] when add $ addTargetFiles [file]
void $ load LoadAllTargets void $ load LoadAllTargets
msgs <- liftIO $ readLog msgs <- liftIO $ readLog
return (msgs, True) let set' = if add then S.insert file set else set
mapM_ (liftIO . putStrLn) errmsgs return (msgs, True, set')
liftIO $ putStrLn $ if ok then "OK" else "NG"
liftIO $ hFlush stdout
let set'
| add && ok = S.insert file set
| otherwise = set
when ok $ loop readLog ls set'
where where
handler err = do handler err = do
errmsgs <- handleErrMsg ls err errmsgs <- handleErrMsg ls err
return (errmsgs, False) return (errmsgs, False, set)