tricu

commit 08ea3900244f7ef66d59448b4771f4ec3d954e84
parent ae11bd9714bdd6774f231b0a852037e34ebbfc26
Author: James Eversole <james@eversole.co>
Date:   Mon, 27 Jan 2025 16:46:41 -0600

Better handling of interrupts in REPL

Diffstat:
M
src/Eval.hs
 | 
2
+-
M
src/Main.hs
 | 
2
+-
M
src/REPL.hs
 | 
47
++++++++++++++++++++++++++---------------------
M
tricu.cabal
 | 
2
++

4 files changed, 30 insertions(+), 23 deletions(-)
diff --git a/src/Eval.hs b/src/Eval.hs
@@ -15,7 +15,7 @@ evalSingle env term
       Just existingValue
         | existingValue == evalAST env body -> env
         | otherwise -> errorWithoutStackTrace $
-            "Unable to rebind immutable identifier: '" ++ name
+            "Unable to rebind immutable identifier: " ++ name
       Nothing ->
         let res = evalAST env body
         in Map.insert "!result" res (Map.insert name res env)
diff --git a/src/Main.hs b/src/Main.hs
@@ -59,7 +59,7 @@ main = do
   case args of
     Repl -> do
       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
     Evaluate { file = filePaths, form = form } -> do
       result <- case filePaths of
diff --git a/src/REPL.hs b/src/REPL.hs
@@ -8,6 +8,7 @@ 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)
 import System.Console.Haskeline
@@ -15,33 +16,37 @@ import System.Console.Haskeline
 import qualified Data.Map as Map
 
 repl :: Env -> IO ()
-repl env = runInputT defaultSettings (loop env)
+repl env = runInputT defaultSettings (withInterrupt (loop env))
   where
     loop :: Env -> InputT IO ()
-    loop env = do
+    loop env = handle (interruptHandler env) $ do
       minput <- getInputLine "tricu < "
-      if
-        | Nothing <- minput                     -> outputStrLn "Exiting tricu"
-        | Just s  <- minput, strip s == "!exit" -> outputStrLn "Exiting tricu"
-        | Just s  <- minput, strip s == ""      -> do
-          outputStrLn ""
-          loop env
-        | Just s  <- minput, strip s == "!import" -> do
-          path <- getInputLine "File path to load < "
-          if
-            | Nothing <- path -> do
-              outputStrLn "No input received; stopping import."
-              loop env
-            | Just p  <- path -> do
-              loadedEnv <- liftIO $ evaluateFileWithContext env (strip p) `catch` \e -> errorHandler env e
-              loop $ Map.delete "!result" (Map.union loadedEnv env)
-        | Just s <- minput -> do
-          if
-            | take 2 s == "--" -> loop env
-            | otherwise -> do
+      case minput of
+        Nothing -> outputStrLn "Exiting tricu"
+        Just s
+          | strip s == "!exit" -> outputStrLn "Exiting tricu"
+          | strip s == "" -> loop env
+          | strip s == "!import" -> do
+              path <- getInputLine "File path to load < "
+              case path of
+                Nothing -> do
+                  outputStrLn "No input received; stopping import."
+                  loop env
+                Just p -> do
+                  loadedEnv <- liftIO $ evaluateFileWithContext env 
+                    (strip p) `catch` \e -> errorHandler env e
+                  loop $ Map.delete "!result" (Map.union loadedEnv env)
+          | take 2 s == "--" -> loop env
+          | otherwise -> do
               newEnv <- liftIO $ processInput env s `catch` errorHandler env
               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 input = do
       let asts   = parseTricu input
diff --git a/tricu.cabal b/tricu.cabal
@@ -26,6 +26,7 @@ executable tricu
     base >=4.7
     , cmdargs
     , containers
+    , exceptions
     , haskeline
     , megaparsec
     , mtl
@@ -52,6 +53,7 @@ test-suite tricu-tests
     base
     , cmdargs
     , containers
+    , exceptions
     , haskeline
     , megaparsec
     , mtl