diff --git a/ghc-mod.cabal b/ghc-mod.cabal index eb85e86..c37d1aa 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -92,6 +92,19 @@ Executable ghc-mod , ghc , 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 Type: exitcode-stdio-1.0 Default-Language: Haskell2010 diff --git a/src/GHCModi.hs b/src/GHCModi.hs new file mode 100644 index 0000000..7e3c0a3 --- /dev/null +++ b/src/GHCModi.hs @@ -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) +