module Language.Haskell.Interpreter.Server (
ServerHandle,
start, stop, runIn, asyncRunIn, flush
) where
import Control.Concurrent.MVar
import Control.Monad.Error
import Control.Monad.Loops
import Control.Concurrent.Process
import Language.Haskell.Interpreter
newtype ServerHandle = SH {handle :: Handle (Either Stop (InterpreterT IO ()))}
data Stop = Stop
instance MonadInterpreter m => MonadInterpreter (ReceiverT r m) where
fromSession = lift . fromSession
modifySessionRef a = lift . (modifySessionRef a)
runGhc = lift . runGhc
start :: IO ServerHandle
start = (spawn $ makeProcess runInterpreter interpreter) >>= return . SH
where interpreter =
do
setImports ["Prelude"]
iterateWhile id $ do
v <- recv
case v of
Left Stop ->
return False
Right acc ->
lift acc >> return True
asyncRunIn :: ServerHandle
-> InterpreterT IO a
-> IO (MVar (Either InterpreterError a))
asyncRunIn server action = do
resVar <- liftIO newEmptyMVar
sendTo (handle server) $ Right $ try action >>= liftIO . putMVar resVar
return resVar
runIn :: ServerHandle
-> InterpreterT IO a
-> IO (Either InterpreterError a)
runIn server action = runHere $ do
me <- self
sendTo (handle server) $ Right $ try action >>= sendTo me
recv
flush :: ServerHandle
-> IO (Either InterpreterError ())
flush server = runIn server $ return ()
try :: InterpreterT IO b -> InterpreterT IO (Either InterpreterError b)
try a = (a >>= return . Right) `catchError` (return . Left)
stop :: ServerHandle -> IO ()
stop server = sendTo (handle server) $ Left Stop