blob: 90b1e5d7f71aa9d1baf93e15b064539573034a49 (
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
|
{-# 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)
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 (pack $ show 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)
|
