Better handling of interrupts in REPL
This commit is contained in:
parent
c6a7835a6f
commit
09eedfb609
@ -15,7 +15,7 @@ evalSingle env term
|
|||||||
Just existingValue
|
Just existingValue
|
||||||
| existingValue == evalAST env body -> env
|
| existingValue == evalAST env body -> env
|
||||||
| otherwise -> errorWithoutStackTrace $
|
| otherwise -> errorWithoutStackTrace $
|
||||||
"Unable to rebind immutable identifier: '" ++ name
|
"Unable to rebind immutable identifier: " ++ name
|
||||||
Nothing ->
|
Nothing ->
|
||||||
let res = evalAST env body
|
let res = evalAST env body
|
||||||
in Map.insert "!result" res (Map.insert name res env)
|
in Map.insert "!result" res (Map.insert name res env)
|
||||||
|
@ -59,7 +59,7 @@ main = do
|
|||||||
case args of
|
case args of
|
||||||
Repl -> do
|
Repl -> do
|
||||||
putStrLn "Welcome to the tricu REPL"
|
putStrLn "Welcome to the tricu REPL"
|
||||||
putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
|
putStrLn "You can exit with `CTRL+D` or the `!exit` command.`"
|
||||||
repl Map.empty
|
repl Map.empty
|
||||||
Evaluate { file = filePaths, form = form } -> do
|
Evaluate { file = filePaths, form = form } -> do
|
||||||
result <- case filePaths of
|
result <- case filePaths of
|
||||||
|
47
src/REPL.hs
47
src/REPL.hs
@ -8,6 +8,7 @@ import Research
|
|||||||
|
|
||||||
import Control.Exception (SomeException, catch)
|
import Control.Exception (SomeException, catch)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.Catch (handle, MonadCatch)
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace)
|
||||||
import Data.List (dropWhile, dropWhileEnd, intercalate)
|
import Data.List (dropWhile, dropWhileEnd, intercalate)
|
||||||
import System.Console.Haskeline
|
import System.Console.Haskeline
|
||||||
@ -15,33 +16,37 @@ import System.Console.Haskeline
|
|||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
repl :: Env -> IO ()
|
repl :: Env -> IO ()
|
||||||
repl env = runInputT defaultSettings (loop env)
|
repl env = runInputT defaultSettings (withInterrupt (loop env))
|
||||||
where
|
where
|
||||||
loop :: Env -> InputT IO ()
|
loop :: Env -> InputT IO ()
|
||||||
loop env = do
|
loop env = handle (interruptHandler env) $ do
|
||||||
minput <- getInputLine "tricu < "
|
minput <- getInputLine "tricu < "
|
||||||
if
|
case minput of
|
||||||
| Nothing <- minput -> outputStrLn "Exiting tricu"
|
Nothing -> outputStrLn "Exiting tricu"
|
||||||
| Just s <- minput, strip s == "!exit" -> outputStrLn "Exiting tricu"
|
Just s
|
||||||
| Just s <- minput, strip s == "" -> do
|
| strip s == "!exit" -> outputStrLn "Exiting tricu"
|
||||||
outputStrLn ""
|
| strip s == "" -> loop env
|
||||||
loop env
|
| strip s == "!import" -> do
|
||||||
| Just s <- minput, strip s == "!import" -> do
|
path <- getInputLine "File path to load < "
|
||||||
path <- getInputLine "File path to load < "
|
case path of
|
||||||
if
|
Nothing -> do
|
||||||
| Nothing <- path -> do
|
outputStrLn "No input received; stopping import."
|
||||||
outputStrLn "No input received; stopping import."
|
loop env
|
||||||
loop env
|
Just p -> do
|
||||||
| Just p <- path -> do
|
loadedEnv <- liftIO $ evaluateFileWithContext env
|
||||||
loadedEnv <- liftIO $ evaluateFileWithContext env (strip p) `catch` \e -> errorHandler env e
|
(strip p) `catch` \e -> errorHandler env e
|
||||||
loop $ Map.delete "!result" (Map.union loadedEnv env)
|
loop $ Map.delete "!result" (Map.union loadedEnv env)
|
||||||
| Just s <- minput -> do
|
| take 2 s == "--" -> loop env
|
||||||
if
|
| otherwise -> do
|
||||||
| take 2 s == "--" -> loop env
|
|
||||||
| otherwise -> do
|
|
||||||
newEnv <- liftIO $ processInput env s `catch` errorHandler env
|
newEnv <- liftIO $ processInput env s `catch` errorHandler env
|
||||||
loop newEnv
|
loop newEnv
|
||||||
|
|
||||||
|
interruptHandler :: Env -> Interrupt -> InputT IO ()
|
||||||
|
interruptHandler env _ = do
|
||||||
|
outputStrLn "Interrupted with CTRL+C\n\
|
||||||
|
\You can use the !exit command or CTRL+D to exit"
|
||||||
|
loop env
|
||||||
|
|
||||||
processInput :: Env -> String -> IO Env
|
processInput :: Env -> String -> IO Env
|
||||||
processInput env input = do
|
processInput env input = do
|
||||||
let asts = parseTricu input
|
let asts = parseTricu input
|
||||||
|
@ -26,6 +26,7 @@ executable tricu
|
|||||||
base >=4.7
|
base >=4.7
|
||||||
, cmdargs
|
, cmdargs
|
||||||
, containers
|
, containers
|
||||||
|
, exceptions
|
||||||
, haskeline
|
, haskeline
|
||||||
, megaparsec
|
, megaparsec
|
||||||
, mtl
|
, mtl
|
||||||
@ -52,6 +53,7 @@ test-suite tricu-tests
|
|||||||
base
|
base
|
||||||
, cmdargs
|
, cmdargs
|
||||||
, containers
|
, containers
|
||||||
|
, exceptions
|
||||||
, haskeline
|
, haskeline
|
||||||
, megaparsec
|
, megaparsec
|
||||||
, mtl
|
, mtl
|
||||||
|
Loading…
x
Reference in New Issue
Block a user