Gestione dell'eccezione UserInterrupt in Haskell

Question

Sto implementando un REPL per un interprete Scheme in Haskell e mi piacerebbe gestire alcuni eventi asincroni come UserInterrupt, StackOverflow, HeapOverflow, ecc ... In sostanza, mi piacerebbe fermare il calcolo corrente quando si verifica UserInterrupt e stampare un messaggio adatto quando si verificano StackOverflow e heap overflow, ecc ho implementato in questo modo:

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 

Esso funziona come previsto con una sola eccezione. Se comincio l'interprete e premere Ctrl-Z + Invio, ottengo:

>>> ^Z 

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

Questo è corretto. Ma se comincio l'interprete e premere Ctrl-C seguita da Ctrl-Z + Invio ottengo:

>>> 
    UserInterruption 
    >>> ^Z 

E si blocca e non posso più usare l'interprete. Tuttavia, se premo di nuovo Ctrl-C, REPL sblocca. Ho cercato molto e non riesco a capirne il motivo. Qualcuno può spiegarmi?

Grazie mille!

Answer 1

movimentazione Control-C non funziona con catch: possono essere correlati a GHC#2301: Proper handling of SIGINT/SIGQUIT

Ecco un TestCase di lavoro, con il evaluator rimosso:

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 

In Linux, Control-Z è non catturato come ha detto Sjoerd. Forse sei su Windows, dove Control-Z è usato per EOF. Siamo in grado di segnalare EOF su Linux con Control-D, che replica il comportamento che avete visto:

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

EOF è gestita dalla funzione handle/onAbort, e Control-C è gestita da catch/onUserInterrupt. Il problema qui è che la tua funzione repl prenderà solo il primo Control-C - il testcase può essere semplificato rimuovendo la funzione handle/onAbort. Come notato sopra, che la gestione di Control-C non funziona con catch potrebbe essere correlato a GHC#2301: Proper handling of SIGINT/SIGQUIT.

La seguente versione utilizza invece l'API Posix installare un gestore di segnale persistente 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 

che può gestire controllo-Cs premuto più volte:

>>> ^C 
keyboardSignal 

>>> ^C 
keyboardSignal 

>>> ^C 
keyboardSignal 

Altrimenti utilizzando l'API Posix, l'installazione di un gestore di segnale persistente su Windows richiede di sollevare nuovamente l'eccezione ogni volta che viene catturato, come descritto in http://suacommunity.com/dictionary/signals.php