module Language.Haskell.Ghcid
( T.Ghci
, T.GhciError (..)
, T.Severity (..)
, T.Load (..)
, startGhci
, showModules
, reload
, exec
, stopGhci
)
where
import System.IO
import System.IO.Error
import System.Process
import Control.Concurrent
import Control.Exception.Extra
import Control.Monad
import Data.Function
import Data.List
import Control.Applicative
import System.Console.CmdArgs.Verbosity
import Language.Haskell.Ghcid.Parser
import Language.Haskell.Ghcid.Types as T
import Language.Haskell.Ghcid.Util
import Prelude
startGhci :: String -> Maybe FilePath -> IO (Ghci, [Load])
startGhci cmd directory = do
(Just inp, Just out, Just err, _) <-
createProcess (shell cmd){std_in=CreatePipe, std_out=CreatePipe, std_err=CreatePipe, cwd = directory}
hSetBuffering out LineBuffering
hSetBuffering err LineBuffering
hSetBuffering inp LineBuffering
lock <- newMVar ()
let prefix = "#~GHCID-START~#"
let finish = "#~GHCID-FINISH~#"
hPutStrLn inp $ ":set prompt " ++ prefix
let consume h name = do
result <- newEmptyMVar
buffer <- newMVar []
forkIO $ fix $ \rec -> do
el <- tryBool isEOFError $ hGetLine h
case el of
Left _ -> putMVar result Nothing
Right l -> do
whenLoud $ outStrLn $ "%" ++ name ++ ": " ++ l
if finish `isInfixOf` l
then do
buf <- modifyMVar buffer $ \old -> return ([], reverse old)
putMVar result $ Just buf
else
modifyMVar_ buffer $ return . (dropPrefixRepeatedly prefix l:)
rec
return result
outs <- consume out "GHCOUT"
errs <- consume err "GHCERR"
let f s = withMVar lock $ const $ do
whenLoud $ outStrLn $ "%GHCINP: " ++ s
hPutStrLn inp $ s ++ "\nPrelude.putStrLn " ++ show finish ++ "\nPrelude.error " ++ show finish
outC <- takeMVar outs
errC <- takeMVar errs
case liftM2 (++) outC errC of
Nothing -> throwIO $ UnexpectedExit cmd s
Just msg -> return msg
r <- parseLoad <$> f ""
return (Ghci f,r)
showModules :: Ghci -> IO [(String,FilePath)]
showModules ghci = parseShowModules <$> exec ghci ":show modules"
reload :: Ghci -> IO [Load]
reload ghci = parseLoad <$> exec ghci ":reload"
stopGhci :: Ghci -> IO ()
stopGhci ghci = handle (\UnexpectedExit{} -> return ()) $ void $ exec ghci ":quit"
exec :: Ghci -> String -> IO [String]
exec (Ghci x) = x