{-# LANGUAGE CPP #-}
module Distribution.Client.Signal
  ( installTerminationHandler
  , Terminated(..)
  )
where

import qualified Control.Exception as Exception

#ifndef mingw32_HOST_OS
import Control.Concurrent (myThreadId)
import Control.Monad (void)
import qualified System.Posix.Signals as Signals
#endif

-- | Terminated is an asynchronous exception, thrown when
-- SIGTERM is received. It's to 'kill' what 'UserInterrupt'
-- is to Ctrl-C.
data Terminated = Terminated

instance Exception.Exception Terminated where
  toException :: Terminated -> SomeException
toException = forall e. Exception e => e -> SomeException
Exception.asyncExceptionToException
  fromException :: SomeException -> Maybe Terminated
fromException = forall e. Exception e => SomeException -> Maybe e
Exception.asyncExceptionFromException

instance Show Terminated where
  show :: Terminated -> String
show Terminated
Terminated = String
"terminated"

-- | Install a signal handler that initiates a controlled shutdown on receiving
-- SIGTERM by throwing an asynchronous exception at the main thread. Must be
-- called from the main thread.
--
-- It is a noop on Windows.
--
installTerminationHandler :: IO ()

#ifdef mingw32_HOST_OS

installTerminationHandler = return ()

#else

installTerminationHandler :: IO ()
installTerminationHandler = do
  ThreadId
mainThreadId <- IO ThreadId
myThreadId
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Signal -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler
    Signal
Signals.sigTERM
    (IO () -> Handler
Signals.CatchOnce forall a b. (a -> b) -> a -> b
$ forall e. Exception e => ThreadId -> e -> IO ()
Exception.throwTo ThreadId
mainThreadId Terminated
Terminated)
    forall a. Maybe a
Nothing

#endif