Catching Control-C Ausnahme in GHC (Haskell)

Question

Ich habe eine wirklich einfache Lese-Eval-Print-Schleife in Haskell, die Control-C (UserInterrupt) fängt. Jedes Mal, wenn ich dieses Programm kompiliere und ausführe, fängt es immer das erste Control-C ab und bricht immer auf dem zweiten Control-C mit dem Exit-Code 130 ab. Es spielt keine Rolle, wie viele Zeilen des Inputs ich vor und zwischen den beiden gebe Control-Cs, es passiert immer so. Ich weiß, dass ich etwas Einfaches vermissen muss ... bitte helfen, danke!

Hinweis: Dies ist mit Base-4-Ausnahmen, also Control.Exception und nicht Control.OldException.

import Control.Exception as E 
import System.IO 

main :: IO() 
main = do hSetBuffering stdout NoBuffering 
      hSetBuffering stdin NoBuffering 
      repLoop 

repLoop :: IO() 
repLoop 
    = do putStr "> " 
     line <- interruptible "<interrupted>" getLine 
     if line == "exit" 
      then putStrLn "goodbye" 
      else do putStrLn $ "input was: " ++ line 
        repLoop 

interruptible :: a -> IO a -> IO a 
interruptible a m 
    = E.handleJust f return m 
    where 
    f UserInterrupt 
     = Just a 
    f _ 
     = Nothing 

Answer 1

Disclaimer: Ich mit GHC Interna nicht vertraut bin und meine Antwort auf greppen den Quellcode basiert, die Kommentare zu lesen und Vermutungen zu machen.

Die main Funktion Sie ist in der Tat durch runMainIO in GHC.TopHandler definiert gewickelt definieren (dies wird weiter bestätigt durch bei TcRnDriver.lhs suchen):

-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is 
-- called in the program). It catches otherwise uncaught exceptions, 
-- and also flushes stdout\/stderr before exiting. 
runMainIO :: IO a -> IO a 
runMainIO main = 
    do 
     main_thread_id <- myThreadId 
     weak_tid <- mkWeakThreadId main_thread_id 
     install_interrupt_handler $ do 
      m <- deRefWeak weak_tid 
      case m of 
       Nothing -> return() 
       Just tid -> throwTo tid (toException UserInterrupt) 
     a <- main 
     cleanUp 
     return a 
    `catch` 
     topHandler 

Und install_interrupt_handler ist definiert als:

install_interrupt_handler :: IO() -> IO() 
#ifdef mingw32_HOST_OS 
install_interrupt_handler handler = do 
    _ <- GHC.ConsoleHandler.installHandler $ 
    Catch $ \event -> 
     case event of 
      ControlC -> handler 
      Break -> handler 
      Close -> handler 
      _ -> return() 
    return() 
#else 
#include "rts/Signals.h" 
-- specialised version of System.Posix.Signals.installHandler, which 
-- isn't available here. 
install_interrupt_handler handler = do 
    let sig = CONST_SIGINT :: CInt 
    _ <- setHandler sig (Just (const handler, toDyn handler)) 
    _ <- stg_sig_install sig STG_SIG_RST nullPtr 
    -- STG_SIG_RST: the second ^C kills us for real, just in case the 
    -- RTS or program is unresponsive. 
    return() 

Unter Linux ist stg_sig_install eine C-Funktion, die zu sigaction aufruft. Der Parameter STG_SIG_RST wird in SA_RESETHAND übersetzt. Unter Windows werden Dinge anders gemacht, was wahrscheinlich die Beobachtung von ja erklärt.

Answer 2

Die zuverlässigste Lösung für mich (zumindest unter Linux) war es, einen Signal-Handler mit System.Posix.Signals zu installieren. Ich habe auf eine Lösung gehofft, die das nicht erfordert, aber der wahre Grund, warum ich die Frage gestellt habe, war, dass ich wissen wollte, warum GHC sich so verhielt wie er. Wie auf #haskell erklärt, besteht eine wahrscheinliche Erklärung darin, dass sich GHC auf diese Weise verhält, so dass der Benutzer immer eine Anwendung steuern kann, wenn sie hängen bleibt. Dennoch wäre es schön, wenn GHC eine Möglichkeit bieten würde, dieses Verhalten zu beeinflussen, ohne die etwas niedrigere Methode, auf die wir zurückgegriffen haben :).

Answer 3

Wei Hu ist korrekt; Das Haskell-Laufzeitsystem bricht das Programm absichtlich ab, wenn ein zweites Control-C gedrückt wird. Um das Verhalten zu erhalten, das man erwarten darf:

import Control.Exception as E 
import Control.Concurrent 
import System.Posix.Signals 

main = do 
    tid <- myThreadId 
    installHandler keyboardSignal (Catch (throwTo tid UserInterrupt)) Nothing 
    ... -- rest of program