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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC "-fno-warn-orphans" #-}
module Minilang.REPL where
import Control.Monad.Catch.Pure (CatchT (..), SomeException)
import Control.Monad.State
import Data.Text hiding (replicate)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Minilang.Lambda (loadProgram)
import Minilang.Lambda.Eval (Term, newEnv)
import Minilang.Lambda.Infer (newContext)
import Minilang.Lambda.Parser (parseProgram, pretty, resugar)
import Minilang.Lambda.Unify (Type)
import qualified Minilang.Lambda.Unify as Unify
import Minilang.REPL.Haskeline
import Minilang.REPL.IO
import Minilang.REPL.Pure
import Minilang.REPL.Purer
import Minilang.REPL.Run
import Minilang.REPL.Types
import System.Console.Haskeline
( defaultBehavior,
defaultSettings,
historyFile,
runInputTBehavior,
setComplete,
)
import System.IO (Handle)
-- * Haskeline REPL
withTerminal :: IO ()
withTerminal =
runInputTBehavior defaultBehavior settings $ evalStateT (runHaskeline runREPL) initialREPL
where
settings = setComplete completion $ defaultSettings {historyFile = Just "~/.minilang.history"}
-- * Other REPLs
-- | Pure IO REPL
-- Used for testing purposes
withHandles ::
Handle -> Handle -> IO ()
withHandles hin hout =
evalStateT (runConsole runREPL) (IOEnv hin hout initialREPL)
-- | Simple IO REPL, used to evaluate programs from stdin or file loading
withIO :: Handle -> Handle -> IO ()
withIO hin hout = do
programText <- parseProgram <$> Text.hGetContents hin
case programText of
Left err -> Text.hPutStrLn hout (Text.pack (show err))
Right prog -> case loadProgram Untyped newEnv newContext prog of
Right (results, _, _) -> mapM_ (Text.hPutStrLn hout . render) results
Left err -> Text.hPutStrLn hout (Text.pack $ show err)
where
render :: (Term, Type) -> Text
render (term, _typ) = pretty (resugar term) -- TODO: handle types <> " : " <> Unify.pretty typ
-- * Pure REPL
withInput ::
[Text] -> [Text]
withInput stream =
outputText $ execState (runCatchT (runPure runREPL)) (PureEnv stream [] initialREPL)
-- * Purer REPL
-- This useful for rehydrating and environment from a sequence of inputs
withInputs ::
REPLEnv -> [In] -> PurerEnv
withInputs initEnv stream =
execState (runCatchT (runPurer runREPL)) (PurerEnv stream [] initEnv)
runProgram :: PurerREPL a -> PurerEnv
runProgram prog =
execState (runCatchT (runPurer prog)) (PurerEnv [] [] initialREPL)
|
