{-# LANGUAGE RecordWildCards #-}
module Language.Haskell.Ghcid(
Ghci, GhciError(..), Stream(..),
Load(..), Severity(..),
startGhci, startGhciProcess, stopGhci, interrupt, process,
execStream, showModules, showPaths, reload, exec, quit
) where
import System.IO
import System.IO.Error
import System.Process
import System.Time.Extra
import Control.Concurrent.Extra
import Control.Exception.Extra
import Control.Monad.Extra
import Data.Function
import Data.List.Extra
import Data.Maybe
import Data.IORef
import Control.Applicative
import Data.Unique
import System.Console.CmdArgs.Verbosity
import Language.Haskell.Ghcid.Parser
import Language.Haskell.Ghcid.Types as T
import Language.Haskell.Ghcid.Util
import Prelude
data Ghci = Ghci
{Ghci -> ProcessHandle
ghciProcess :: ProcessHandle
,Ghci -> IO ()
ghciInterrupt :: IO ()
,Ghci -> String -> (Stream -> String -> IO ()) -> IO ()
ghciExec :: String -> (Stream -> String -> IO ()) -> IO ()
,Ghci -> Unique
ghciUnique :: Unique
}
instance Eq Ghci where
Ghci
a == :: Ghci -> Ghci -> Bool
== Ghci
b = Ghci -> Unique
ghciUnique Ghci
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Ghci -> Unique
ghciUnique Ghci
b
withCreateProc :: CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO c)
-> IO c
withCreateProc CreateProcess
proc Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO c
f = do
let undo :: (a, b, c, ProcessHandle) -> IO ()
undo (a
_, b
_, c
_, ProcessHandle
proc) = IO () -> IO ()
ignored (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
terminateProcess ProcessHandle
proc
IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO c)
-> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
proc) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
forall {a} {b} {c}. (a, b, c, ProcessHandle) -> IO ()
undo (((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO c)
-> IO c)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO c)
-> IO c
forall a b. (a -> b) -> a -> b
$ \(Maybe Handle
a,Maybe Handle
b,Maybe Handle
c,ProcessHandle
d) -> Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO c
f Maybe Handle
a Maybe Handle
b Maybe Handle
c ProcessHandle
d
startGhciProcess :: CreateProcess -> (Stream -> String -> IO ()) -> IO (Ghci, [Load])
startGhciProcess :: CreateProcess -> (Stream -> String -> IO ()) -> IO (Ghci, [Load])
startGhciProcess CreateProcess
process Stream -> String -> IO ()
echo0 = do
let proc :: CreateProcess
proc = CreateProcess
process{std_in :: StdStream
std_in=StdStream
CreatePipe, std_out :: StdStream
std_out=StdStream
CreatePipe, std_err :: StdStream
std_err=StdStream
CreatePipe, create_group :: Bool
create_group=Bool
True}
CreateProcess
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (Ghci, [Load]))
-> IO (Ghci, [Load])
forall {c}.
CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO c)
-> IO c
withCreateProc CreateProcess
proc ((Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (Ghci, [Load]))
-> IO (Ghci, [Load]))
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (Ghci, [Load]))
-> IO (Ghci, [Load])
forall a b. (a -> b) -> a -> b
$ \(Just Handle
inp) (Just Handle
out) (Just Handle
err) ProcessHandle
ghciProcess -> do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
out BufferMode
LineBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
err BufferMode
LineBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
inp BufferMode
LineBuffering
let writeInp :: String -> IO ()
writeInp String
x = do
IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"%STDIN: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
Handle -> String -> IO ()
hPutStrLn Handle
inp String
x
Handle -> String -> IO ()
hPutStrLn Handle
inp String
""
let ghcid_prefix :: String
ghcid_prefix = String
"#~GHCID-START~#"
let removePrefix :: String -> String
removePrefix = String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
dropPrefixRepeatedly String
ghcid_prefix
Var Integer
syncCount <- Integer -> IO (Var Integer)
forall a. a -> IO (Var a)
newVar Integer
0
let syncReplay :: IO (String -> Bool)
syncReplay = do
Integer
i <- Var Integer -> IO Integer
forall a. Var a -> IO a
readVar Var Integer
syncCount
let showStr :: [a] -> String
showStr [a]
xs = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
let msg :: String
msg = String
"#~GHCID-FINISH-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~#"
String -> IO ()
writeInp (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nINTERNAL_GHCID.putStrLn " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall {a}. Show a => [a] -> String
showStr String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"INTERNAL_GHCID.hPutStrLn INTERNAL_GHCID.stderr " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall {a}. Show a => [a] -> String
showStr String
msg
(String -> Bool) -> IO (String -> Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String -> Bool) -> IO (String -> Bool))
-> (String -> Bool) -> IO (String -> Bool)
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
msg
let syncFresh :: IO (String -> Bool)
syncFresh = do
Var Integer -> (Integer -> IO Integer) -> IO ()
forall a. Var a -> (a -> IO a) -> IO ()
modifyVar_ Var Integer
syncCount ((Integer -> IO Integer) -> IO ())
-> (Integer -> IO Integer) -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> IO Integer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> IO Integer)
-> (Integer -> Integer) -> Integer -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Enum a => a -> a
succ
IO (String -> Bool)
syncReplay
let consume :: Stream -> (String -> IO (Maybe a)) -> IO (Either (Maybe String) a)
consume :: forall a.
Stream -> (String -> IO (Maybe a)) -> IO (Either (Maybe String) a)
consume Stream
name String -> IO (Maybe a)
finish = do
let h :: Handle
h = if Stream
name Stream -> Stream -> Bool
forall a. Eq a => a -> a -> Bool
== Stream
Stdout then Handle
out else Handle
err
(((Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a))
-> Maybe String
-> ((Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a))
-> IO (Either (Maybe String) a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a)
forall a. (a -> a) -> a
fix Maybe String
forall a. Maybe a
Nothing (((Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a))
-> IO (Either (Maybe String) a))
-> ((Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a))
-> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ \Maybe String -> IO (Either (Maybe String) a)
rec Maybe String
oldMsg -> do
Either IOError String
el <- (IOError -> Bool) -> IO String -> IO (Either IOError String)
forall e a. Exception e => (e -> Bool) -> IO a -> IO (Either e a)
tryBool IOError -> Bool
isEOFError (IO String -> IO (Either IOError String))
-> IO String -> IO (Either IOError String)
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
hGetLine Handle
h
case Either IOError String
el of
Left IOError
_ -> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Either (Maybe String) a
forall a b. a -> Either a b
Left Maybe String
oldMsg
Right String
l -> do
IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"%" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
upper (Stream -> String
forall a. Show a => a -> String
show Stream
name) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l
let msg :: String
msg = String -> String
removePrefix String
l
Maybe a
res <- String -> IO (Maybe a)
finish String
msg
case Maybe a
res of
Maybe a
Nothing -> Maybe String -> IO (Either (Maybe String) a)
rec (Maybe String -> IO (Either (Maybe String) a))
-> Maybe String -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
msg
Just a
a -> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (Maybe String) a
forall a b. b -> Either a b
Right a
a
let consume2 :: String -> (Stream -> String -> IO (Maybe a)) -> IO (a,a)
consume2 :: forall a. String -> (Stream -> String -> IO (Maybe a)) -> IO (a, a)
consume2 String
msg Stream -> String -> IO (Maybe a)
finish = do
IO (Either (Maybe String) a)
res1 <- IO (Either (Maybe String) a) -> IO (IO (Either (Maybe String) a))
forall a. IO a -> IO (IO a)
onceFork (IO (Either (Maybe String) a) -> IO (IO (Either (Maybe String) a)))
-> IO (Either (Maybe String) a)
-> IO (IO (Either (Maybe String) a))
forall a b. (a -> b) -> a -> b
$ Stream -> (String -> IO (Maybe a)) -> IO (Either (Maybe String) a)
forall a.
Stream -> (String -> IO (Maybe a)) -> IO (Either (Maybe String) a)
consume Stream
Stdout (Stream -> String -> IO (Maybe a)
finish Stream
Stdout)
IO (Either (Maybe String) a)
res2 <- IO (Either (Maybe String) a) -> IO (IO (Either (Maybe String) a))
forall a. IO a -> IO (IO a)
onceFork (IO (Either (Maybe String) a) -> IO (IO (Either (Maybe String) a)))
-> IO (Either (Maybe String) a)
-> IO (IO (Either (Maybe String) a))
forall a b. (a -> b) -> a -> b
$ Stream -> (String -> IO (Maybe a)) -> IO (Either (Maybe String) a)
forall a.
Stream -> (String -> IO (Maybe a)) -> IO (Either (Maybe String) a)
consume Stream
Stderr (Stream -> String -> IO (Maybe a)
finish Stream
Stderr)
Either (Maybe String) a
res1 <- IO (Either (Maybe String) a)
res1
Either (Maybe String) a
res2 <- IO (Either (Maybe String) a)
res2
let raise :: String -> Maybe String -> IO a
raise String
msg Maybe String
err = GhciError -> IO a
forall e a. Exception e => e -> IO a
throwIO (GhciError -> IO a) -> GhciError -> IO a
forall a b. (a -> b) -> a -> b
$ case CreateProcess -> CmdSpec
cmdspec CreateProcess
process of
ShellCommand String
cmd -> String -> String -> Maybe String -> GhciError
UnexpectedExit String
cmd String
msg Maybe String
err
RawCommand String
exe [String]
args -> String -> String -> Maybe String -> GhciError
UnexpectedExit ([String] -> String
unwords (String
exeString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args)) String
msg Maybe String
err
case (Either (Maybe String) a
res1, Either (Maybe String) a
res2) of
(Right a
v1, Right a
v2) -> (a, a) -> IO (a, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v1, a
v2)
(Either (Maybe String) a
_, Left Maybe String
err) -> String -> Maybe String -> IO (a, a)
forall {a}. String -> Maybe String -> IO a
raise String
msg Maybe String
err
(Either (Maybe String) a
_, Right a
_) -> String -> Maybe String -> IO (a, a)
forall {a}. String -> Maybe String -> IO a
raise String
msg Maybe String
forall a. Maybe a
Nothing
Lock
isInterrupting <- IO Lock
newLock
Lock
isRunning <- IO Lock
newLock
let ghciExec :: String -> (Stream -> String -> IO a) -> IO ()
ghciExec String
command Stream -> String -> IO a
echo = do
Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
isInterrupting (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe ()
res <- Lock -> IO () -> IO (Maybe ())
forall a. Lock -> IO a -> IO (Maybe a)
withLockTry Lock
isRunning (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
writeInp String
command
String -> Bool
stop <- IO (String -> Bool)
syncFresh
IO ((), ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), ()) -> IO ()) -> IO ((), ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (Stream -> String -> IO (Maybe ())) -> IO ((), ())
forall a. String -> (Stream -> String -> IO (Maybe a)) -> IO (a, a)
consume2 String
command ((Stream -> String -> IO (Maybe ())) -> IO ((), ()))
-> (Stream -> String -> IO (Maybe ())) -> IO ((), ())
forall a b. (a -> b) -> a -> b
$ \Stream
strm String
s ->
if String -> Bool
stop String
s then Maybe () -> IO (Maybe ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe () -> IO (Maybe ())) -> Maybe () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just () else do Stream -> String -> IO a
echo Stream
strm String
s; Maybe () -> IO (Maybe ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ()
forall a. Maybe a
Nothing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ()
res) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Ghcid.exec, computation is already running, must be used single-threaded"
let ghciInterrupt :: IO ()
ghciInterrupt = Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
isInterrupting (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Maybe () -> Bool) -> IO (Maybe ()) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing (IO (Maybe ()) -> IO Bool) -> IO (Maybe ()) -> IO Bool
forall a b. (a -> b) -> a -> b
$ Lock -> IO () -> IO (Maybe ())
forall a. Lock -> IO a -> IO (Maybe a)
withLockTry Lock
isRunning (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
outStrLn String
"%INTERRUPT"
ProcessHandle -> IO ()
interruptProcessGroupOf ProcessHandle
ghciProcess
IO (String -> Bool)
syncReplay
Lock -> IO () -> IO ()
forall a. Lock -> IO a -> IO a
withLock Lock
isRunning (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
String -> Bool
stop <- IO (String -> Bool)
syncFresh
IO ((), ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), ()) -> IO ()) -> IO ((), ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (Stream -> String -> IO (Maybe ())) -> IO ((), ())
forall a. String -> (Stream -> String -> IO (Maybe a)) -> IO (a, a)
consume2 String
"Interrupt" ((Stream -> String -> IO (Maybe ())) -> IO ((), ()))
-> (Stream -> String -> IO (Maybe ())) -> IO ((), ())
forall a b. (a -> b) -> a -> b
$ \Stream
_ String
s -> Maybe () -> IO (Maybe ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe () -> IO (Maybe ())) -> Maybe () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ if String -> Bool
stop String
s then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing
Unique
ghciUnique <- IO Unique
newUnique
let ghci :: Ghci
ghci = Ghci{IO ()
Unique
ProcessHandle
String -> (Stream -> String -> IO ()) -> IO ()
forall {a}. String -> (Stream -> String -> IO a) -> IO ()
ghciProcess :: ProcessHandle
ghciInterrupt :: IO ()
ghciExec :: String -> (Stream -> String -> IO ()) -> IO ()
ghciUnique :: Unique
ghciProcess :: ProcessHandle
ghciExec :: forall {a}. String -> (Stream -> String -> IO a) -> IO ()
ghciInterrupt :: IO ()
ghciUnique :: Unique
..}
IORef [String]
stdout <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
IORef [String]
stderr <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
IORef (String -> Bool)
sync <- (String -> Bool) -> IO (IORef (String -> Bool))
forall a. a -> IO (IORef a)
newIORef ((String -> Bool) -> IO (IORef (String -> Bool)))
-> (String -> Bool) -> IO (IORef (String -> Bool))
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False
String -> (Stream -> String -> IO (Maybe ())) -> IO ((), ())
forall a. String -> (Stream -> String -> IO (Maybe a)) -> IO (a, a)
consume2 String
"" ((Stream -> String -> IO (Maybe ())) -> IO ((), ()))
-> (Stream -> String -> IO (Maybe ())) -> IO ((), ())
forall a b. (a -> b) -> a -> b
$ \Stream
strm String
s -> do
String -> Bool
stop <- IORef (String -> Bool) -> IO (String -> Bool)
forall a. IORef a -> IO a
readIORef IORef (String -> Bool)
sync
if String -> Bool
stop String
s then
Maybe () -> IO (Maybe ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe () -> IO (Maybe ())) -> Maybe () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
else do
String
s <- String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
-> ((String, String) -> String) -> Maybe (String, String) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
s (String -> String
removePrefix (String -> String)
-> ((String, String) -> String) -> (String, String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd) (Maybe (String, String) -> String)
-> Maybe (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe (String, String)
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix String
ghcid_prefix String
s
IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"%STDOUT2: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
IORef [String] -> ([String] -> [String]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (if Stream
strm Stream -> Stream -> Bool
forall a. Eq a => a -> a -> Bool
== Stream
Stdout then IORef [String]
stdout else IORef [String]
stderr) (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s) [ String
"GHCi, version "
, String
"GHCJSi, version "
, String
"Clashi, version " ]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IORef [String] -> [String] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [String]
stdout []
IORef [String] -> [String] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [String]
stderr []
String -> IO ()
writeInp String
"import qualified System.IO as INTERNAL_GHCID"
String -> IO ()
writeInp String
":unset +t +s"
String -> IO ()
writeInp (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
":set prompt " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcid_prefix
String -> IO ()
writeInp (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
":set prompt-cont " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcid_prefix
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([String]
ghciFlagsRequired [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ghciFlagsRequiredVersioned) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
flag ->
String -> IO ()
writeInp (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
":set " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flag
IORef (String -> Bool) -> (String -> Bool) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (String -> Bool)
sync ((String -> Bool) -> IO ()) -> IO (String -> Bool) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (String -> Bool)
syncFresh
Stream -> String -> IO ()
echo0 Stream
strm String
s
Maybe () -> IO (Maybe ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ()
forall a. Maybe a
Nothing
[Load]
r1 <- [String] -> [Load]
parseLoad ([String] -> [Load])
-> ([String] -> [String]) -> [String] -> [Load]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [Load]) -> IO [String] -> IO [Load]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String] -> [String])
-> IO [String] -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
stderr IO ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
stdout)
[Load]
r2 <- if (Load -> Bool) -> [Load] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Load -> Bool
isLoading [Load]
r1 then [Load] -> IO [Load]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else ((String, String) -> Load) -> [(String, String)] -> [Load]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Load) -> (String, String) -> Load
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Load
Loading) ([(String, String)] -> [Load])
-> IO [(String, String)] -> IO [Load]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghci -> IO [(String, String)]
showModules Ghci
ghci
Ghci -> String -> (Stream -> String -> IO ()) -> IO ()
execStream Ghci
ghci String
"" Stream -> String -> IO ()
echo0
(Ghci, [Load]) -> IO (Ghci, [Load])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ghci
ghci, [Load]
r1 [Load] -> [Load] -> [Load]
forall a. [a] -> [a] -> [a]
++ [Load]
r2)
startGhci
:: String
-> Maybe FilePath
-> (Stream -> String -> IO ())
-> IO (Ghci, [Load])
startGhci :: String
-> Maybe String -> (Stream -> String -> IO ()) -> IO (Ghci, [Load])
startGhci String
cmd Maybe String
directory = CreateProcess -> (Stream -> String -> IO ()) -> IO (Ghci, [Load])
startGhciProcess (String -> CreateProcess
shell String
cmd){cwd :: Maybe String
cwd=Maybe String
directory}
execStream :: Ghci -> String -> (Stream -> String -> IO ()) -> IO ()
execStream :: Ghci -> String -> (Stream -> String -> IO ()) -> IO ()
execStream = Ghci -> String -> (Stream -> String -> IO ()) -> IO ()
ghciExec
interrupt :: Ghci -> IO ()
interrupt :: Ghci -> IO ()
interrupt = Ghci -> IO ()
ghciInterrupt
process :: Ghci -> ProcessHandle
process :: Ghci -> ProcessHandle
process = Ghci -> ProcessHandle
ghciProcess
execBuffer :: Ghci -> String -> (Stream -> String -> IO ()) -> IO [String]
execBuffer :: Ghci -> String -> (Stream -> String -> IO ()) -> IO [String]
execBuffer Ghci
ghci String
cmd Stream -> String -> IO ()
echo = do
IORef [String]
stdout <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
IORef [String]
stderr <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
Ghci -> String -> (Stream -> String -> IO ()) -> IO ()
execStream Ghci
ghci String
cmd ((Stream -> String -> IO ()) -> IO ())
-> (Stream -> String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Stream
strm String
s -> do
IORef [String] -> ([String] -> [String]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (if Stream
strm Stream -> Stream -> Bool
forall a. Eq a => a -> a -> Bool
== Stream
Stdout then IORef [String]
stdout else IORef [String]
stderr) (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
Stream -> String -> IO ()
echo Stream
strm String
s
[String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String] -> [String])
-> IO [String] -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
stderr IO ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
stdout)
exec :: Ghci -> String -> IO [String]
exec :: Ghci -> String -> IO [String]
exec Ghci
ghci String
cmd = Ghci -> String -> (Stream -> String -> IO ()) -> IO [String]
execBuffer Ghci
ghci String
cmd ((Stream -> String -> IO ()) -> IO [String])
-> (Stream -> String -> IO ()) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Stream
_ String
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
showModules :: Ghci -> IO [(String,FilePath)]
showModules :: Ghci -> IO [(String, String)]
showModules Ghci
ghci = [String] -> [(String, String)]
parseShowModules ([String] -> [(String, String)])
-> IO [String] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghci -> String -> IO [String]
exec Ghci
ghci String
":show modules"
showPaths :: Ghci -> IO (FilePath, [FilePath])
showPaths :: Ghci -> IO (String, [String])
showPaths Ghci
ghci = [String] -> (String, [String])
parseShowPaths ([String] -> (String, [String]))
-> IO [String] -> IO (String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghci -> String -> IO [String]
exec Ghci
ghci String
":show paths"
reload :: Ghci -> IO [Load]
reload :: Ghci -> IO [Load]
reload Ghci
ghci = [String] -> [Load]
parseLoad ([String] -> [Load]) -> IO [String] -> IO [Load]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghci -> String -> IO [String]
exec Ghci
ghci String
":reload"
quit :: Ghci -> IO ()
quit :: Ghci -> IO ()
quit Ghci
ghci = do
Ghci -> IO ()
interrupt Ghci
ghci
(GhciError -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\UnexpectedExit{} -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO [String] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [String] -> IO ()) -> IO [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ Ghci -> String -> IO [String]
exec Ghci
ghci String
":quit"
IO () -> IO ()
ignored (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess (ProcessHandle -> IO ExitCode) -> ProcessHandle -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Ghci -> ProcessHandle
process Ghci
ghci
stopGhci :: Ghci -> IO ()
stopGhci :: Ghci -> IO ()
stopGhci Ghci
ghci = do
IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
Seconds -> IO ()
sleep Seconds
5
ProcessHandle -> IO ()
terminateProcess (ProcessHandle -> IO ()) -> ProcessHandle -> IO ()
forall a b. (a -> b) -> a -> b
$ Ghci -> ProcessHandle
process Ghci
ghci
Ghci -> IO ()
quit Ghci
ghci