Catching Control-C исключение в GHC (Haskell)

Я построил очень простой цикл read-eval-print в Haskell, который ловит Control-C (UserInterrupt). Однако всякий раз, когда я компилирую и запускаю эту программу, она всегда захватывает первый Control-C и всегда прерывает второй Control-C с кодом выхода 130. Неважно, сколько строк ввода я даю ему до и между двумя Control-Cs, так всегда бывает. Я знаю, что я должен пропустить что-то простое... пожалуйста, помогите, спасибо!

Примечание: это с исключениями base-4, поэтому Control.Exception и не 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

Ответ 1

Вэй Ху правильно; система времени исполнения Haskell преднамеренно прерывает программу при нажатии второго элемента управления-C. Чтобы получить такое поведение, можно ожидать:

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

Ответ 2

Отказ от ответственности: я не знаком с внутренними компонентами GHC, и мой ответ основан на grepping исходном коде, чтении комментариев и угадывании.

Определяемая вами функция main фактически обернута runMainIO, определенной в GHC.TopHandler (это подтверждается, посмотрев TcRnDriver.lhs):

-- | '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

И install_interrupt_handler определяется как:

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 ()

В Linux stg_sig_install - это функция C, вызывающая sigaction. Параметр STG_SIG_RST переводится на SA_RESETHAND. В Windows все делается по-другому, что, вероятно, объясняет ja наблюдение.

Ответ 3

Самое надежное решение для меня (по крайней мере, в Linux) заключалось в установке обработчика сигналов с использованием System.Posix.Signals. Я надеялся на решение, которое не требовало бы этого, но настоящая причина, по которой я поставил вопрос, заключалась в том, что я хотел знать, почему GHC вел себя так, как это делал. Как объясняется в #haskell, вероятным объяснением является то, что GHC ведет себя таким образом, чтобы пользователь всегда мог контролировать приложение C, если оно зависает. Тем не менее, было бы неплохо, если бы GHC обеспечил способ повлиять на это поведение без метода с более низким уровнем, к которому мы прибегали:).