Adds several new REPL utilities

Also removes some broken list library functions

src/REPL.hs

@@ -6,16 +6,21 @@ import Lexer
 import Parser
 import Research
 
-import Control.Exception         (SomeException, catch)
+import Control.Exception         (IOException, SomeException, catch, displayException)
+import Control.Monad             (forM_)
 import Control.Monad.IO.Class    (liftIO)
 import Control.Monad.Catch       (handle, MonadCatch)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Data.Char                 (isSpace)
+import Data.Char                 (isSpace, isUpper)
 import Data.List                 ( dropWhile
                                  , dropWhileEnd
                                  , isPrefixOf)
 import System.Console.Haskeline
+import Paths_tricu (version)
+import Data.Version (showVersion)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
 
 import qualified Data.Map as Map
 
@@ -25,7 +30,7 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
     settings :: Settings IO
     settings = Settings
       { complete = completeWord Nothing " \t" completeCommands
-      , historyFile = Just ".tricu_history"
+      , historyFile = Just "~/.local/state/tricu/history"
       , autoAddHistory = True
       }
 
@@ -33,7 +38,15 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
     completeCommands str = return $ map simpleCompletion $
       filter (str `isPrefixOf`) commands
       where
-        commands = ["!exit", "!output", "!definitions", "!import"]
+        commands = [ "!exit"
+                   , "!output"
+                   , "!definitions"
+                   , "!import"
+                   , "!clear"
+                   , "!save"
+                   , "!reset"
+                   , "!version"
+                   ]
 
     loop :: Env -> EvaluatedForm -> InputT IO ()
     loop env form = handle (interruptHandler env form) $ do
@@ -43,6 +56,16 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
         Just s
           | strip s == "" -> loop env form
           | strip s == "!exit" -> outputStrLn "Exiting tricu"
+          | strip s == "!clear" -> do
+              liftIO $ putStr "\ESC[2J\ESC[H"
+              loop env form
+          | strip s == "!reset" -> do
+              outputStrLn "Environment reset to initial state"
+              loop Map.empty form
+          | strip s == "!version" -> do
+              outputStrLn $ "tricu version " ++ showVersion version
+              loop env form
+          | "!save" `isPrefixOf` strip s -> handleSave env form
           | strip s == "!output" -> handleOutput env form
           | strip s == "!definitions" -> do
               let defs = Map.keys $ Map.delete "!result" env
@@ -82,31 +105,41 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
 
     handleImport :: Env -> EvaluatedForm -> InputT IO ()
     handleImport env form = do
-      result <- runMaybeT $ do
-        let fileSettings = setComplete completeFilename defaultSettings
-        path <- MaybeT $ runInputT fileSettings $
+      res <- runMaybeT $ do
+        let fset = setComplete completeFilename defaultSettings
+        path <- MaybeT $ runInputT fset $
           getInputLineWithInitial "File path to load < " ("", "")
 
-        contents <- liftIO $ readFile (strip path)
+        text <- MaybeT $ liftIO $ handle (\e -> do
+            putStrLn $ "Error reading file: " ++ displayException (e :: IOException)
+            return Nothing
+          ) $ Just <$> readFile (strip path)
 
-        if | Left err <- parseProgram (lexTricu contents) -> do
-               lift $ outputStrLn $ "Parse error: " ++ handleParseError err
-               MaybeT $ return Nothing
-           | Right ast <- parseProgram (lexTricu contents) -> do
-               ns <- MaybeT $ runInputT defaultSettings $
-                 getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
+        case parseProgram (lexTricu text) of
+          Left err -> do
+            lift $ outputStrLn $ "Parse error: " ++ handleParseError err
+            MaybeT $ return Nothing
+          Right ast -> do
+            ns <- MaybeT $ runInputT defaultSettings $
+              getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
 
-               processedAst <- liftIO $ preprocessFile (strip path)
-               let namespacedAst | strip ns == "!Local" = processedAst
-                                | otherwise = nsDefinitions (strip ns) processedAst
-                   loadedEnv = evalTricu env namespacedAst
-               return loadedEnv
-
-      if | Nothing <- result -> do
-             outputStrLn "Import cancelled."
-             loop env form
-         | Just loadedEnv <- result ->
-             loop (Map.delete "!result" loadedEnv) form
+            let name = strip ns
+            if (name /= "!Local" && (null name || not (isUpper (head name)))) then do
+                lift $ outputStrLn "Namespace must start with an uppercase letter"
+                MaybeT $ return Nothing
+            else do
+                prog <- liftIO $ preprocessFile (strip path)
+                let code = case name of
+                      "!Local" -> prog
+                      _ -> nsDefinitions name prog
+                    env' = evalTricu env code
+                return env'
+      case res of
+        Nothing -> do
+          outputStrLn "Import cancelled"
+          loop env form
+        Just env' ->
+          loop (Map.delete "!result" env') form
 
     interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO ()
     interruptHandler env form _ = do
@@ -131,3 +164,28 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
 
     strip :: String -> String
     strip = dropWhileEnd isSpace . dropWhile isSpace
+
+    handleSave :: Env -> EvaluatedForm -> InputT IO ()
+    handleSave env form = do
+      let fset = setComplete completeFilename defaultSettings
+      path <- runInputT fset $
+        getInputLineWithInitial "File to save < " ("", "")
+
+      case path of
+        Nothing -> do
+          outputStrLn "Save cancelled"
+          loop env form
+        Just p -> do
+          let definitions = Map.toList $ Map.delete "!result" env
+              filepath = strip p
+
+          outputStrLn "Starting save..."
+          liftIO $ writeFile filepath ""
+          outputStrLn "File created..."
+          forM_ definitions $ \(name, value) -> do
+            let content = name ++ " = " ++ formatResult TreeCalculus value ++ "\n"
+            outputStrLn $ "Writing definition: " ++ name ++ " with length " ++ show (length content)
+            liftIO $ appendFile filepath content
+          outputStrLn $ "Saved " ++ show (length definitions) ++ " definitions to " ++ p
+
+          loop env form