Handling UserInterrupt exception in Haskell - haskell

Question

I'm implementing a REPL for a Scheme interpreter in Haskell and I'd like to handle some async events like UserInterrupt, StackOverflow, HeapOverflow, etc... Basically, I'd like to stop the current computation when UserInterrupt occurs and print a suitable message when StackOverflow and HeapOverflow occur, etc. I implemented this as follows:
repl evaluator = forever $ (do
putStr ">>> " >> hFlush stdout
out <- getLine >>= evaluator
if null out
then return ()
else putStrLn out)
`catch`
onUserInterrupt
onUserInterrupt UserInterrupt = putStrLn "\nUserInterruption"
onUserInterrupt e = throw e
main = do
interpreter <- getMyLispInterpreter
handle onAbort (repl $ interpreter "stdin")
putStrLn "Exiting..."
onAbort e = do
let x = show (e :: SomeException)
putStrLn $ "\nAborted: " ++ x
It works as expected with one exception. If I start the interpreter and press Ctrl-Z + Enter, I get:
>>> ^Z
Aborted: <stdin>: hGetLine: end of file
Exiting...
That's correct. But if I start the interpreter and press Ctrl-C followed by Ctrl-Z + Enter I get:
>>>
UserInterruption
>>> ^Z
And it hangs and I can't use the interpreter anymore. However, if I press Ctrl-C again, the REPL unblocks. I searched a lot and I can't figure out the reason of it. Can anyone explain me?
Many thanks!

Answer 1

Control-C handling does not work with catch: may be related to GHC #2301: Proper handling of SIGINT/SIGQUIT
Here is a working testcase, with the evaluator removed:
module Main where
import Prelude hiding (catch)
import Control.Exception ( SomeException(..),
AsyncException(..)
, catch, handle, throw)
import Control.Monad (forever)
import System.IO
repl :: IO ()
repl = forever $ (do
putStr ">>> " >> hFlush stdout
out <- getLine
if null out
then return ()
else putStrLn out)
`catch`
onUserInterrupt
onUserInterrupt UserInterrupt = putStrLn "\nUserInterruption"
onUserInterrupt e = throw e
main = do
handle onAbort repl
putStrLn "Exiting..."
onAbort e = do
let x = show (e :: SomeException)
putStrLn $ "\nAborted: " ++ x
On Linux, Control-Z is not caught as Sjoerd mentioned. Perhaps you are on Windows, where Control-Z is used for EOF. We can signal EOF on Linux with Control-D, which replicates the behavior you saw:
>>> ^D
Aborted: <stdin>: hGetLine: end of file
Exiting...
EOF is handled by your handle/onAbort function, and Control-C is handled by catch/onUserInterrupt. The issue here is that your repl function will only catch the first Control-C -- the testcase can be simplified by removing the handle/onAbort function. As noted above, that Control-C handling does not work with catch may be related to GHC #2301: Proper handling of SIGINT/SIGQUIT.
The following version instead uses the Posix API to install a persistent signal handler for Control-C:
module Main where
import Prelude hiding (catch)
import Control.Exception ( SomeException(..),
AsyncException(..)
, catch, handle, throw)
import Control.Monad (forever)
import System.IO
import System.Posix.Signals
repl :: IO ()
repl = forever $ do
putStr ">>> " >> hFlush stdout
out <- getLine
if null out
then return ()
else putStrLn out
reportSignal :: IO ()
reportSignal = putStrLn "\nkeyboardSignal"
main = do
_ <- installHandler keyboardSignal (Catch reportSignal) Nothing
handle onAbort repl
putStrLn "Exiting..."
onAbort e = do
let x = show (e :: SomeException)
putStrLn $ "\nAborted: " ++ x
which can handle Control-Cs being pressed multiple times:
>>> ^C
keyboardSignal
>>> ^C
keyboardSignal
>>> ^C
keyboardSignal
If not using the Posix API, installing a persistent signal handler on Windows requires re-raising the exception each time it is caught, as described in http://suacommunity.com/dictionary/signals.php