wip: port REPL from minilang

1 files changed, 36 insertions, 0 deletions

diff --git a/lambda-calcul/haskell/src/Minilang/REPL/IO.hs b/lambda-calcul/haskell/src/Minilang/REPL/IO.hs
new file mode 100644
index 0000000..90b1e5d
--- /dev/null
+++ b/lambda-calcul/haskell/src/Minilang/REPL/IO.hs
@@ -0,0 +1,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)