module REPL where import Eval import FileEval import Lexer import Parser import Research import Control.Exception (SomeException, catch) import Control.Monad.IO.Class (liftIO) import Control.Monad.Catch (handle, MonadCatch) import Data.Char (isSpace) import Data.List ( dropWhile , dropWhileEnd , intercalate , isPrefixOf) import System.Console.Haskeline import qualified Data.Map as Map repl :: Env -> IO () repl env = runInputT defaultSettings (withInterrupt (loop env True)) where loop :: Env -> Bool -> InputT IO () loop env decode = handle (interruptHandler env decode) $ do minput <- getInputLine "tricu < " case minput of Nothing -> outputStrLn "Exiting tricu" Just s | strip s == "" -> loop env decode | strip s == "!exit" -> outputStrLn "Exiting tricu" | strip s == "!decode" -> do outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled") loop env (not decode) | "!import" `isPrefixOf` strip s -> do let afterImport = dropWhile (== ' ') $ drop (length ("!import" :: String)) (strip s) if not (null afterImport) then outputStrLn "Warning: REPL imports are interactive; \ \additional arguments are ignored." else pure () path <- getInputLine "File path to load < " case path of Nothing -> do outputStrLn "No input received; stopping import." loop env decode Just p -> do loadedEnv <- liftIO $ evaluateFileWithContext env (strip p) `catch` \e -> errorHandler env e loop (Map.delete "!result" (Map.union loadedEnv env)) decode | take 2 s == "--" -> loop env decode | otherwise -> do newEnv <- liftIO $ processInput env s decode `catch` errorHandler env loop newEnv decode interruptHandler :: Env -> Bool -> Interrupt -> InputT IO () interruptHandler env decode _ = do outputStrLn "Interrupted with CTRL+C\n\ \You can use the !exit command or CTRL+D to exit" loop env decode processInput :: Env -> String -> Bool -> IO Env processInput env input decode = do let asts = parseTricu input newEnv = evalTricu env asts case Map.lookup "!result" newEnv of Just r -> do putStrLn $ "tricu > " ++ if decode then decodeResult r else show r Nothing -> pure () return newEnv errorHandler :: Env -> SomeException -> IO (Env) errorHandler env e = do putStrLn $ "Error: " ++ show e return env strip :: String -> String strip = dropWhileEnd isSpace . dropWhile isSpace