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 < -- or calculate its size (/demos/size.tri)
|
||||||
tricu < size not?
|
tricu < size not?
|
||||||
tricu > 12
|
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
|
## Installation and Use
|
||||||
|
@ -65,13 +65,4 @@ any? = y (\self pred : matchList
|
|||||||
false
|
false
|
||||||
(\h z : or? (pred h) (self pred z)))
|
(\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
|
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 Parser
|
||||||
import Research
|
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.IO.Class (liftIO)
|
||||||
import Control.Monad.Catch (handle, MonadCatch)
|
import Control.Monad.Catch (handle, MonadCatch)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
|
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace, isUpper)
|
||||||
import Data.List ( dropWhile
|
import Data.List ( dropWhile
|
||||||
, dropWhileEnd
|
, dropWhileEnd
|
||||||
, isPrefixOf)
|
, isPrefixOf)
|
||||||
import System.Console.Haskeline
|
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
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
@ -25,7 +30,7 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
|
|||||||
settings :: Settings IO
|
settings :: Settings IO
|
||||||
settings = Settings
|
settings = Settings
|
||||||
{ complete = completeWord Nothing " \t" completeCommands
|
{ complete = completeWord Nothing " \t" completeCommands
|
||||||
, historyFile = Just ".tricu_history"
|
, historyFile = Just "~/.local/state/tricu/history"
|
||||||
, autoAddHistory = True
|
, autoAddHistory = True
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -33,7 +38,15 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
|
|||||||
completeCommands str = return $ map simpleCompletion $
|
completeCommands str = return $ map simpleCompletion $
|
||||||
filter (str `isPrefixOf`) commands
|
filter (str `isPrefixOf`) commands
|
||||||
where
|
where
|
||||||
commands = ["!exit", "!output", "!definitions", "!import"]
|
commands = [ "!exit"
|
||||||
|
, "!output"
|
||||||
|
, "!definitions"
|
||||||
|
, "!import"
|
||||||
|
, "!clear"
|
||||||
|
, "!save"
|
||||||
|
, "!reset"
|
||||||
|
, "!version"
|
||||||
|
]
|
||||||
|
|
||||||
loop :: Env -> EvaluatedForm -> InputT IO ()
|
loop :: Env -> EvaluatedForm -> InputT IO ()
|
||||||
loop env form = handle (interruptHandler env form) $ do
|
loop env form = handle (interruptHandler env form) $ do
|
||||||
@ -43,6 +56,16 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
|
|||||||
Just s
|
Just s
|
||||||
| strip s == "" -> loop env form
|
| strip s == "" -> loop env form
|
||||||
| strip s == "!exit" -> outputStrLn "Exiting tricu"
|
| 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 == "!output" -> handleOutput env form
|
||||||
| strip s == "!definitions" -> do
|
| strip s == "!definitions" -> do
|
||||||
let defs = Map.keys $ Map.delete "!result" env
|
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 -> EvaluatedForm -> InputT IO ()
|
||||||
handleImport env form = do
|
handleImport env form = do
|
||||||
result <- runMaybeT $ do
|
res <- runMaybeT $ do
|
||||||
let fileSettings = setComplete completeFilename defaultSettings
|
let fset = setComplete completeFilename defaultSettings
|
||||||
path <- MaybeT $ runInputT fileSettings $
|
path <- MaybeT $ runInputT fset $
|
||||||
getInputLineWithInitial "File path to load < " ("", "")
|
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
|
lift $ outputStrLn $ "Parse error: " ++ handleParseError err
|
||||||
MaybeT $ return Nothing
|
MaybeT $ return Nothing
|
||||||
| Right ast <- parseProgram (lexTricu contents) -> do
|
Right ast -> do
|
||||||
ns <- MaybeT $ runInputT defaultSettings $
|
ns <- MaybeT $ runInputT defaultSettings $
|
||||||
getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
|
getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
|
||||||
|
|
||||||
processedAst <- liftIO $ preprocessFile (strip path)
|
let name = strip ns
|
||||||
let namespacedAst | strip ns == "!Local" = processedAst
|
if (name /= "!Local" && (null name || not (isUpper (head name)))) then do
|
||||||
| otherwise = nsDefinitions (strip ns) processedAst
|
lift $ outputStrLn "Namespace must start with an uppercase letter"
|
||||||
loadedEnv = evalTricu env namespacedAst
|
MaybeT $ return Nothing
|
||||||
return loadedEnv
|
else do
|
||||||
|
prog <- liftIO $ preprocessFile (strip path)
|
||||||
if | Nothing <- result -> do
|
let code = case name of
|
||||||
outputStrLn "Import cancelled."
|
"!Local" -> prog
|
||||||
|
_ -> nsDefinitions name prog
|
||||||
|
env' = evalTricu env code
|
||||||
|
return env'
|
||||||
|
case res of
|
||||||
|
Nothing -> do
|
||||||
|
outputStrLn "Import cancelled"
|
||||||
loop env form
|
loop env form
|
||||||
| Just loadedEnv <- result ->
|
Just env' ->
|
||||||
loop (Map.delete "!result" loadedEnv) form
|
loop (Map.delete "!result" env') form
|
||||||
|
|
||||||
interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO ()
|
interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO ()
|
||||||
interruptHandler env form _ = do
|
interruptHandler env form _ = do
|
||||||
@ -131,3 +164,28 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
|
|||||||
|
|
||||||
strip :: String -> String
|
strip :: String -> String
|
||||||
strip = dropWhileEnd isSpace . dropWhile isSpace
|
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
|
cabal-version: 1.12
|
||||||
|
|
||||||
name: tricu
|
name: tricu
|
||||||
version: 0.17.0
|
version: 0.18.0
|
||||||
description: A micro-language for exploring Tree Calculus
|
description: A micro-language for exploring Tree Calculus
|
||||||
author: James Eversole
|
author: James Eversole
|
||||||
maintainer: james@eversole.co
|
maintainer: james@eversole.co
|
||||||
|
Loading…
x
Reference in New Issue
Block a user