on master help sign in
on Ctrl-C (SIGINT) in tutd, just cancel the current line and read another

restore :quit functionality resolves #156

commit3fc7481b787d2f8146fbdbe4e00a06f91357a96f authorAgentM <agentm@themactionfaction.com> dateThu 28 Sep 2017, 16:56 (9 years ago) parent70f1317
1 file changed+16−3
src/bin/TutorialD/Interpreter.hs+16−3
src/bin/TutorialD/Interpreter.hs+16−3
@@ -33,6 +33,7 @@ import System.IO (hPutStrLn, stderr)
3333import Data.Monoid
3434import Data.List (isPrefixOf)
3535import Control.Exception
36+import System.Exit
3637
3738{-
3839context ops are read-only operations which only operate on the database context (relvars and constraints)
@@ -97,8 +98,14 @@ evalTutorialDInteractive :: C.SessionId -> C.Connection -> SafeEvaluationFlag ->
9798evalTutorialDInteractive sessionId conn safe interactive expr = case expr of
9899 --this does not pass through the ProjectM36.Client library because the operations
99100 --are specific to the interpreter, though some operations may be of general use in the future
100− (RODatabaseContextOp execOp) ->
101− evalRODatabaseContextOp sessionId conn execOp
101+ (RODatabaseContextOp execOp) -> do
102+ res <- evalRODatabaseContextOp sessionId conn execOp
103+ case res of
104+ QuitResult -> if safe == UnsafeEvaluation && interactive then
105+ putStrLn "Goodbye." >> exitSuccess
106+ else
107+ pure res
108+ _ -> pure res
102109
103110 (DatabaseContextExprOp execOp) ->
104111 eHandler $ C.executeDatabaseContextExpr sessionId conn execOp
@@ -237,12 +244,18 @@ reprLoop config sessionId conn = do
237244 eHeadName <- C.headName sessionId conn
238245 eSchemaName <- C.currentSchemaName sessionId conn
239246 let prompt = promptText eHeadName eSchemaName
240− maybeLine <- runInputT settings $ getInputLine (T.unpack prompt)
247+ catchInterrupt = handleJust (\exc -> case exc of
248+ UserInterrupt -> Just Nothing
249+ _ -> Nothing) (\_ -> do
250+ hPutStrLn stderr "Statement cancelled. Use \":quit\" to exit tutd."
251+ pure (Just ""))
252+ maybeLine <- catchInterrupt $ runInputT settings $ getInputLine (T.unpack prompt)
241253 case maybeLine of
242254 Nothing -> return ()
243255 Just line -> do
244256 runTutorialD sessionId conn (T.pack line)
245257 reprLoop config sessionId conn
258+
246259
247260runTutorialD :: C.SessionId -> C.Connection -> T.Text -> IO ()
248261runTutorialD sessionId conn tutd =