Adds several new REPL utilities
Also removes some broken list library functions
This commit is contained in:
parent
e6e18239a7
commit
0a505172b4
10
README.md
10
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
|
||||
|
@ -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)
|
||||
|
98
src/REPL.hs
98
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
|
||||
case parseProgram (lexTricu text) of
|
||||
Left err -> do
|
||||
lift $ outputStrLn $ "Parse error: " ++ handleParseError err
|
||||
MaybeT $ return Nothing
|
||||
| Right ast <- parseProgram (lexTricu contents) -> do
|
||||
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."
|
||||
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 loadedEnv <- result ->
|
||||
loop (Map.delete "!result" loadedEnv) 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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user