summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/REPL/Pure.hs')
-rw-r--r--lambda-calcul/haskell/src/Minilang/REPL/Pure.hs42
1 files changed, 42 insertions, 0 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs b/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
new file mode 100644
index 0000000..23c45e1
--- /dev/null
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
@@ -0,0 +1,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