blob: 23c45e174d3e33e2888f53b5397b22644e835bbd (
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
38
39
40
41
42
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
module Minilang.REPL.Pure where
import Control.Exception (throw)
import Control.Monad.Catch
import Control.Monad.Catch.Pure (CatchT (..))
import Control.Monad.State
import Data.Text hiding (replicate)
import Minilang.REPL.Types
data PureEnv = PureEnv
{ inputText :: [Text],
outputText :: [Text],
pureREPL :: REPLEnv
}
newtype PureREPL a = PureREPL {runPure :: CatchT (State PureEnv) a}
deriving (Functor, Applicative, Monad, MonadState PureEnv, MonadCatch)
instance MonadREPL PureREPL where
input = do
ins <- inputText <$> get
case ins of
[] -> pure EOF
(t : ts) -> modify (\e -> e {inputText = ts}) >> pure (interpret t)
output t = modify $ \e -> e {outputText = render t : outputText e}
prompt = pure ()
getEnv = get >>= pure . pureREPL
setEnv e' = modify $ \e -> e {pureREPL = e'}
load f = pure $ Left $ REPLError $ "cannot load file " <> f <> " in Pure interpreter"
render :: Out -> Text
render = \case
Msg t -> t
Bye -> "Bye!"
other -> pack (show other)
instance MonadThrow PureREPL where
throwM = throw
|
