From 0a505172b4ea43bb424509056c9e23c4c31c2444 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 7 Feb 2025 18:25:11 -0600 Subject: [PATCH] Adds several new REPL utilities Also removes some broken list library functions --- README.md | 10 +++++ lib/list.tri | 9 ----- src/REPL.hs | 108 +++++++++++++++++++++++++++++++++++++++------------ tricu.cabal | 2 +- 4 files changed, 94 insertions(+), 35 deletions(-) diff --git a/README.md b/README.md index fddac64..20f495e 100644 --- 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 index d784a6b..4b9640f 100644 --- 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 index 11e7f97..76e5050 100644 --- 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) + 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 diff --git a/tricu.cabal b/tricu.cabal index bd01006..7c85a0f 100644 --- 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