blob: ad6d52b8d21ceb943d7ed1533e05e383c34d281e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}
module Minilang.REPL.IO where
import Control.Monad.Catch
import Control.Monad.Reader
import Control.Monad.State
import Data.Text (unpack, pack)
import Data.Text.IO as Text
import Minilang.REPL.Types
import System.IO (Handle, hFlush)
import System.IO.Error (isEOFError)
import Minilang.REPL.Pure (render)
data IOEnv = IOEnv
{ inputHandle :: Handle,
outputHandle :: Handle,
repl :: REPLEnv
}
newtype CONSOLE m a = CONSOLE {runConsole :: StateT IOEnv m a}
deriving (Functor, Applicative, Monad, MonadTrans, MonadState IOEnv)
instance MonadREPL (CONSOLE IO) where
input = get >>= lift . (\h -> (interpret <$> hGetLine h) `catch` \(isEOFError -> True) -> pure EOF) . inputHandle
output a = get >>= lift . flip hPutStrLn (render a) . outputHandle
prompt = get >>= lift . (\h -> hPutStr h "λΠ> " >> hFlush h) . outputHandle
getEnv = get >>= pure . repl
setEnv e' = modify $ \e -> e {repl = e'}
load = lift . try . Text.readFile . unpack
instance (MonadThrow m) => MonadThrow (CONSOLE m) where
throwM = lift . throwM
instance (MonadCatch m) => MonadCatch (CONSOLE m) where
CONSOLE m `catch` f = CONSOLE $ m `catch` \e -> runConsole (f e)
|
