Adds several new REPL utilities
Also removes some broken list library functions
This commit is contained in:
		
							
								
								
									
										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) | ||||
|  | ||||
							
								
								
									
										108
									
								
								src/REPL.hs
									
									
									
									
									
								
							
							
						
						
									
										108
									
								
								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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
		Reference in New Issue
	
	Block a user