Adds several new REPL utilities

Also removes some broken list library functions
This commit is contained in:
James Eversole 2025-02-07 18:25:11 -06:00
parent e6e18239a7
commit 0a505172b4
4 changed files with 94 additions and 35 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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