adding ghc-modi.

This commit is contained in:
Kazu Yamamoto 2014-03-19 10:23:47 +09:00
parent be926f0366
commit b40f162979
2 changed files with 57 additions and 0 deletions

View File

@ -92,6 +92,19 @@ Executable ghc-mod
, ghc , ghc
, ghc-mod , ghc-mod
Executable ghc-modi
Default-Language: Haskell2010
Main-Is: GHCModi.hs
Other-Modules: Paths_ghc_mod
GHC-Options: -Wall
HS-Source-Dirs: src
Build-Depends: base >= 4.0 && < 5
, containers
, directory
, filepath
, ghc
, ghc-mod
Test-Suite doctest Test-Suite doctest
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Default-Language: Haskell2010 Default-Language: Haskell2010

44
src/GHCModi.hs Normal file
View File

@ -0,0 +1,44 @@
module Main where
import System.IO
import Control.Monad
import CoreMonad (liftIO)
import Data.Set as S
import Exception (ghandle)
import GHC
import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Internal
main :: IO ()
main = do
cradle <- findCradle
void $ withGHCDummyFile $ do
(readLog,_) <- initializeFlagsWithCradle opt cradle ["-Wall"] True
loop readLog ls S.empty
return []
return ()
where
opt = defaultOptions
ls = lineSeparator opt
loop :: IO [String] -> LineSeparator -> Set FilePath -> Ghc ()
loop readLog ls set = do
file <- liftIO $ getLine
let add = not $ S.member file set
(errmsgs,ok) <- ghandle handler $ do
when add $ addTargetFiles [file]
void $ load LoadAllTargets
msgs <- liftIO $ readLog
return (msgs, True)
mapM_ (liftIO . putStrLn) errmsgs
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
handler err = do
errmsgs <- handleErrMsg ls err
return (errmsgs, False)