diff options
Diffstat (limited to 'bin')
-rw-r--r-- | bin/Main.hs | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/bin/Main.hs b/bin/Main.hs index 54ed6b2..56ad0cd 100644 --- a/bin/Main.hs +++ b/bin/Main.hs | |||
@@ -1,7 +1,8 @@ | |||
1 | module Main where | 1 | module Main where |
2 | 2 | ||
3 | import Control.Monad (liftM) | 3 | import Control.Monad (liftM) |
4 | import Control.Monad.Except (throwError) | 4 | import Control.Monad.Except (liftIO, runExceptT, throwError) |
5 | import Environment | ||
5 | import Error.Base (LispError (..), LispResult (..), | 6 | import Error.Base (LispError (..), LispResult (..), |
6 | unwrap) | 7 | unwrap) |
7 | import Error.Pretty (defaults, showError) | 8 | import Error.Pretty (defaults, showError) |
@@ -17,25 +18,31 @@ readExpr inp = | |||
17 | Left err -> throwError $ Parse err | 18 | Left err -> throwError $ Parse err |
18 | Right val -> return val | 19 | Right val -> return val |
19 | 20 | ||
21 | evalExpr :: Env -> String -> IO (LispResult String) | ||
22 | evalExpr env inp = runExceptT $ fmap show $ | ||
23 | (liftLispResult $ readExpr inp) >>= eval env | ||
20 | 24 | ||
21 | repl :: IO () | 25 | repl :: Env -> IO () |
22 | repl = do | 26 | repl env = do |
23 | -- \u2020 † - obelisk | 27 | let pp = showError defaults "(lisk-repl)" |
24 | inp <- readline "† " | 28 | inp <- readline "† " |
25 | case inp of | 29 | case inp of |
26 | Nothing -> return () | 30 | Nothing -> return () |
27 | Just ",q" -> return () | 31 | Just ",q" -> return () |
28 | Just line -> do | 32 | Just i -> do |
29 | addHistory line | 33 | out <- evalExpr env i |
30 | let pp = showError defaults | 34 | either (putStrLn . pp) putStrLn out |
31 | either (putStrLn . pp line) print $ readExpr line >>= eval | 35 | repl env |
32 | repl | 36 | |
33 | 37 | ||
34 | main :: IO () | 38 | main :: IO () |
35 | main = do | 39 | main = do |
36 | args <- getArgs | 40 | args <- getArgs |
41 | initEnv <- newEnv | ||
37 | if null args | 42 | if null args |
38 | then do | 43 | then do |
39 | putStrLn ";;; Entering lisk repl ..." | 44 | putStrLn ";;; Entering lisk repl ..." |
40 | repl | 45 | repl initEnv |
41 | else print $ eval =<< readExpr (head args) | 46 | else do |
47 | let pp = showError defaults "(lisk-repl)" | ||
48 | evalExpr initEnv (head args) >>= (either (putStrLn . pp) print) | ||