Added print environment command, prompt editing and history with haskeline

1 files changed, 32 insertions, 28 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 1f99b39..f54cf7a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,55 +1,48 @@
 import           Data.Char
-import qualified Data.Map         as M
-import           System.IO
+import qualified Data.Map                 as M
+import           System.Console.Haskeline
 
-import           Expr             as E
+import           Expr                     as E
 import           Parser.Core
 import           Parser.Statement
 
 
 main :: IO ()
-main = promptLoop (Context M.empty M.empty)
+main = runInputT defaultSettings $ promptLoop (Context M.empty M.empty)
 
-promptLoop :: Context -> IO ()
+promptLoop :: Context -> InputT IO ()
 promptLoop context = do
-    putStr "> "
-    hFlush stdout
-    eof <- isEOF
-    if eof
-        then return ()
-        else do line <- getLine
-                if line /= "exit"
-                   then loop line context >>= promptLoop
-                   else return ()
+    minput <- getInputLine "> "
+    case minput of
+        Nothing     -> return ()
+        Just "exit" -> return ()
+        Just "env"  -> putEnv context >>= promptLoop
 
-loop :: String -> Context -> IO Context
-loop input context =
-    do
-        case runParserStrict statementP (filter (not . isSpace) input) of
-            Left err -> putStrLn ("Error parsing: " ++ err) >> return context
-            Right s  -> Main.eval s context
+        Just input  -> do
+            case runParserStrict statementP (filter (not . isSpace) input) of
+                 Left err -> outputStrLn ("Error parsing: " ++ err) >> promptLoop context
+                 Right s  -> Main.eval s context >>= promptLoop
 
 
-
-eval :: Statement -> Context -> IO Context
+eval :: Statement -> Context -> InputT IO Context
 
 eval (Evaluation e) c = do case E.eval e c of
-                             Just evaluated -> putStrLn $ show evaluated
-                             Nothing        -> putStrLn "Error: couldn't evaluate expression"
+                             Just evaluated -> outputStrLn $ show evaluated
+                             Nothing        -> outputStrLn "Error: couldn't evaluate expression"
                            return c
 
 eval (VariableDeclaration name value) (Context vars funcs) =
     case E.eval value context of
-        Just e  -> do putStrLn $ show e
+        Just e  -> do outputStrLn $ show e
                       return $ Context (M.insert name e vars) funcs
-        Nothing -> putStrLn "Error: couldn't evaluate expression" >> return context
+        Nothing -> outputStrLn "Error: couldn't evaluate expression" >> return context
     where context = Context vars funcs
 
 eval (FunctionDeclaration name argName e) (Context vars funcs) =
     -- case evalIgnore e context argName of
-    --     Just e  -> do putStrLn $ show e
+    --     Just e  -> do outputStrLn $ show e
     --                   return $ Context vars (M.insert name (argName, e) funcs)
-    --     Nothing -> putStrLn "Error: couldn't evaluate expression" >> return context
+    --     Nothing -> outputStrLn "Error: couldn't evaluate expression" >> return context
     --
     -- where context = Context vars funcs
     return $ Context vars (M.insert name (argName, e) funcs)
@@ -59,3 +52,14 @@ eval _ c = return c
 --                                            r <- eval right
 
 
+
+putEnv :: Context -> InputT IO Context
+putEnv (Context vars funcs) = do
+    outputStrLn "Variables:"
+    outputStr $ M.foldrWithKey (foldFunc fmtVariable) "" vars
+    outputStrLn "Functions:"
+    outputStr $ M.foldrWithKey (foldFunc fmtFunction) "" funcs
+    return (Context vars funcs)
+    where foldFunc fmt k v acc   = acc ++ fmt k v ++ "\n"
+          fmtVariable k v        = k ++ " = " ++ show v
+          fmtFunction k (arg, v) = k ++ "(" ++ arg ++ ") = " ++ show v