在 Haskell 中处理 UserInterrupt 异常答案

【问题标题】：Handling UserInterrupt exception in Haskell在 Haskell 中处理 UserInterrupt 异常
【发布时间】：2011-10-30 05:34:36
【问题描述】：

我正在为 Haskell 中的 Scheme 解释器实现 REPL，我想处理一些异步事件，如 UserInterrupt、StackOverflow、HeapOverflow 等...基本上，我想在 UserInterrupt 发生时停止当前计算并在发生 StackOverflow 和 HeapOverflow 等时打印合适的消息。我实现如下：

    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

它按预期工作，但有一个例外。如果我启动解释器并按 Ctrl-Z + Enter，我会得到：

    >>> ^Z

    Aborted: <stdin>: hGetLine: end of file
    Exiting...

没错。但是如果我启动解释器并按 Ctrl-C 然后按 Ctrl-Z + Enter 我得到：

    >>>
    UserInterruption
    >>> ^Z

它挂了，我不能再使用解释器了。但是，如果我再次按 Ctrl-C，REPL 就会解除阻塞。我搜索了很多，我无法弄清楚它的原因。谁能解释一下？

非常感谢！

【问题讨论】：

我从未见过 Ctrl-Z 被抓到。第一个 Ctrl-C 被捕获，但第二个没有。这大概是同一个问题。你能在一个完整的工作测试用例中改变你的代码吗？ F.e. 'return' 而不是 'interpreter "stdin"' 并添加了正确的导入。

标签： exception haskell exception-handling read-eval-print-loop interruption

【解决方案1】：

Control-C 处理不适用于catch：可能与GHC #2301: Proper handling of SIGINT/SIGQUIT 有关

这是一个有效的测试用例，删除了evaluator：

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

在 Linux 上，Control-Z 没有像 Sjoerd 提到的那样被捕获。也许您在 Windows 上，其中 Control-Z 用于 EOF。我们可以在 Linux 上使用 Control-D 发出 EOF 信号，这会复制您看到的行为：

>>> ^D
Aborted: <stdin>: hGetLine: end of file
Exiting...

EOF 由 handle/onAbort 函数处理，Control-C 由 catch/onUserInterrupt 处理。这里的问题是您的 repl 函数只会捕获第一个 Control-C —— 可以通过删除 handle/onAbort 函数来简化测试用例。如上所述，Control-C 处理不适用于catch 可能与GHC #2301: Proper handling of SIGINT/SIGQUIT 有关。

以下版本改为使用 Posix API 为 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

它可以处理多次按下的Control-C：

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

如果不使用 Posix API，在 Windows 上安装持久信号处理程序需要在每次捕获异常时重新引发异常，如 http://suacommunity.com/dictionary/signals.php 中所述

【讨论】：