{-# LANGUAGE CPP #-}
module GHCi.Signals (installSignalHandlers) where

import Prelude -- See note [Why do we import Prelude here?]
import Control.Concurrent
import Control.Exception
import System.Mem.Weak  ( deRefWeak )

#if !defined(mingw32_HOST_OS)
import System.Posix.Signals
#endif

#if defined(mingw32_HOST_OS)
import GHC.ConsoleHandler
#endif

-- | Install standard signal handlers for catching ^C, which just throw an
--   exception in the target thread.  The current target thread is the
--   thread at the head of the list in the MVar passed to
--   installSignalHandlers.
installSignalHandlers :: IO ()
installSignalHandlers :: IO ()
installSignalHandlers = do
  ThreadId
main_thread <- IO ThreadId
myThreadId
  Weak ThreadId
wtid <- ThreadId -> IO (Weak ThreadId)
mkWeakThreadId ThreadId
main_thread

  let interrupt :: IO ()
interrupt = do
        Maybe ThreadId
r <- Weak ThreadId -> IO (Maybe ThreadId)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak ThreadId
wtid
        case Maybe ThreadId
r of
          Maybe ThreadId
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just ThreadId
t  -> ThreadId -> AsyncException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
t AsyncException
UserInterrupt

#if !defined(mingw32_HOST_OS)
  Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigQUIT  (IO () -> Handler
Catch IO ()
interrupt) Maybe SignalSet
forall a. Maybe a
Nothing
  Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigINT   (IO () -> Handler
Catch IO ()
interrupt) Maybe SignalSet
forall a. Maybe a
Nothing
#else
  -- GHC 6.3+ has support for console events on Windows
  -- NOTE: running GHCi under a bash shell for some reason requires
  -- you to press Ctrl-Break rather than Ctrl-C to provoke
  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
  -- why --SDM 17/12/2004
  let sig_handler ControlC = interrupt
      sig_handler Break    = interrupt
      sig_handler _        = return ()

  _ <- installHandler (Catch sig_handler)
#endif
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()