%  Copyright (C) 2003 David Roundy
%
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  GNU General Public License for more details.
%
%  You should have received a copy of the GNU General Public License
%  along with this program; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

\begin{code}
module SignalHandler ( withSignalsHandled, catchSignal, throwSignal,
                     ) where

import System.Exit ( exitWith, ExitCode ( ExitFailure ) )
import Control.Concurrent ( myThreadId )
import Control.Exception ( catchDyn, throwDyn, throwDynTo )
import Data.Dynamic ( Typeable )
import Posix ( installHandler, Handler(..), Signal,
               sigINT, sigHUP, sigABRT, sigALRM, sigTERM,
             )
\end{code}

\begin{code}
newtype SignalException = SignalException Signal deriving (Typeable)

withSignalsHandled :: IO a -> IO a
withSignalsHandled job = do
    id <- myThreadId
    sequence_ $ map (ih id) [sigINT, sigHUP, sigABRT, sigALRM, sigTERM]
    job `catchSignal` defaults
    where defaults s | s == sigINT = ew "Interrupted!"
                     | s ==  sigHUP = ew "HUP"
                     | s ==  sigABRT = ew "ABRT"
                     | s ==  sigALRM = ew "ALRM"
                     | s ==  sigTERM = ew "TERM"
                     | otherwise = ew "Unhandled signal!"
          ew s = do putStrLn s
                    exitWith $ ExitFailure $ -1

ih id s = installHandler s (Catch $ throwDynTo id $ SignalException s) Nothing

catchSignal :: IO a -> (Signal -> IO a) -> IO a
catchSignal job handler =
    job `Control.Exception.catchDyn` (\(SignalException sig) -> handler sig)

throwSignal :: Signal -> IO a
throwSignal s = Control.Exception.throwDyn (SignalException s)
\end{code}