Обработка исключения UserInterrupt в Haskell

Я использую REPL для интерпретатора схем в Haskell, и я бы хотел обработать некоторые асинхронные события, такие как 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 разблокируется. Я много искал, и я не могу понять причину этого. Может ли кто-нибудь объяснить мне?

Большое спасибо!

ОТВЕТЫ

Ответ 1

Обработка Control-C не работает с catch: может быть связана с GHС# 2301: правильная обработка 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. Мы можем сигнализировать EOF на Linux с помощью Control-D, который воспроизводит поведение, которое вы видели:

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

EOF обрабатывается вашей функцией handle/onAbort, а Control-C обрабатывается catch/onUserInterrupt. Проблема здесь в том, что ваша функция repl будет захватывать только первый Control-C - тестовый тест можно упростить, удалив функцию handle/onAbort. Как отмечалось выше, обработка Control-C не работает с catch может быть связана с GHС# 2301: правильная обработка 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-Cs несколько раз:

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

Если не использовать Posix API, установка стойкого обработчика сигналов в Windows требует повторного воссоздания исключения каждый раз, когда он пойман, как описано в http://suacommunity.com/dictionary/signals.php