commit 2451fdb1e3eaee323efe9619d8073cd90e72063c
parent b1e03b32cbbe64adcf8c76af88ae49c1a26fb963
Author: James Eversole <james@eversole.co>
Date: Fri, 7 Feb 2025 18:25:11 -0600
Adds several new REPL utilities
Diffstat:
4 files changed, 96 insertions(+), 37 deletions(-)
diff --git a/README.md b/README.md
@@ -41,6 +41,16 @@ tricu > "(t (t (t t) (t t t)) (t t (t t t)))"
tricu < -- or calculate its size (/demos/size.tri)
tricu < size not?
tricu > 12
+
+tricu < -- REPL Commands:
+tricu < !definitions -- Lists all available definitions
+tricu < !output -- Change output format (Tree, FSL, AST, etc.)
+tricu < !import -- Import definitions from a file
+tricu < !exit -- Exit the REPL
+tricu < !clear -- ANSI screen clear
+tricu < !save -- Save all REPL definitions to a file that you can !import
+tricu < !reset -- Clear all REPL definitions
+tricu < !version -- Print tricu version
```
## Installation and Use
diff --git a/lib/list.tri b/lib/list.tri
@@ -65,13 +65,4 @@ any? = y (\self pred : matchList
false
(\h z : or? (pred h) (self pred z)))
-unique_ = y (\self seen : matchList
- t
- (\head rest : matchBool
- (self seen rest)
- (pair head (self (pair head seen) rest))
- (lExist? head seen)))
-unique = \xs : unique_ t xs
-
intersect = \xs ys : filter (\x : lExist? x ys) xs
-union = \xs ys : unique (append xs ys)
diff --git a/src/REPL.hs b/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)
-
- 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) < " ("", "")
-
- 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
+ text <- MaybeT $ liftIO $ handle (\e -> do
+ putStrLn $ "Error reading file: " ++ displayException (e :: IOException)
+ return Nothing
+ ) $ Just <$> readFile (strip path)
+
+ 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) < " ("", "")
+
+ 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
diff --git a/tricu.cabal b/tricu.cabal
@@ -1,7 +1,7 @@
cabal-version: 1.12
name: tricu
-version: 0.17.0
+version: 0.18.0
description: A micro-language for exploring Tree Calculus
author: James Eversole
maintainer: james@eversole.co
