diff options
| author | bringert <unknown> | 2005-11-11 10:12:49 +0000 |
|---|---|---|
| committer | bringert <unknown> | 2005-11-11 10:12:49 +0000 |
| commit | ac4ce06a21ddb9034855b3839176c83f0b9783f0 (patch) | |
| tree | 906d2cea7f9a9e4e9a1203822d87ef6c0eac7517 /src/GF/System | |
| parent | 136728e336d66349723f882fcd87a2eb8d42903c (diff) | |
Allow disabling signal support in configure.
Diffstat (limited to 'src/GF/System')
| -rw-r--r-- | src/GF/System/NoSignal.hs | 21 | ||||
| -rw-r--r-- | src/GF/System/Signal.hs | 47 | ||||
| -rw-r--r-- | src/GF/System/UseSignal.hs | 50 |
3 files changed, 84 insertions, 34 deletions
diff --git a/src/GF/System/NoSignal.hs b/src/GF/System/NoSignal.hs new file mode 100644 index 000000000..3c2fc6e29 --- /dev/null +++ b/src/GF/System/NoSignal.hs @@ -0,0 +1,21 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.NoSignal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Dummy implementation of signal handling. +----------------------------------------------------------------------------- + +module GF.System.NoSignal where + +import Control.Exception (Exception) + +{-# NOINLINE runInterruptibly #-} +runInterruptibly :: IO a -> IO (Either Exception a) +runInterruptibly = fmap Right diff --git a/src/GF/System/Signal.hs b/src/GF/System/Signal.hs index cd5032100..3d9e6ef40 100644 --- a/src/GF/System/Signal.hs +++ b/src/GF/System/Signal.hs @@ -1,3 +1,5 @@ +{-# OPTIONS -cpp #-} + ---------------------------------------------------------------------- -- | -- Module : GF.System.Signal @@ -5,44 +7,21 @@ -- Stability : (stability) -- Portability : (portability) -- --- > CVS $Date: 2005/11/07 22:27:13 $ +-- > CVS $Date: 2005/11/11 11:12:50 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ +-- > CVS $Revision: 1.3 $ -- --- Allows SIGINT (Ctrl-C) to interrupt computations. +-- Import the right singal handling module. ----------------------------------------------------------------------------- -module GF.System.Signal where +module GF.System.Signal (runInterruptibly) where + +#ifdef USE_INTERRUPT + +import GF.System.UseSignal (runInterruptibly) -import Control.Concurrent (myThreadId, killThread) -import Control.Exception (Exception,catch) -import Prelude hiding (catch) -import System.IO -import System.Posix.Signals +#else --- | Run an IO action, and allow it to be interrupted --- by a SIGINT to the current process. Returns --- an exception if the process did not complete --- normally. --- NOTES: --- * This will replace any existing SIGINT --- handler during the action. After the computation --- has completed the existing handler will be restored. --- * If the IO action is lazy (e.g. using readFile, --- unsafeInterleaveIO etc.) the lazy computation will --- not be interruptible, as it will be performed --- after the signal handler has been removed. -runInterruptibly :: IO a -> IO (Either Exception a) -runInterruptibly a = - do t <- myThreadId - oldH <- installHandler sigINT (Catch (killThread t)) Nothing - x <- p `catch` h - installHandler sigINT oldH Nothing - return x - where p = a >>= \x -> return $! Right $! x - h e = return $ Left e +import GF.System.NoSignal (runInterruptibly) --- | Like 'runInterruptibly', but always returns (), whether --- the computation fails or not. -runInterruptibly_ :: IO () -> IO () -runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly +#endif diff --git a/src/GF/System/UseSignal.hs b/src/GF/System/UseSignal.hs new file mode 100644 index 000000000..8f3874711 --- /dev/null +++ b/src/GF/System/UseSignal.hs @@ -0,0 +1,50 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.UseSignal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Allows SIGINT (Ctrl-C) to interrupt computations. +----------------------------------------------------------------------------- + +module GF.System.UseSignal where + +import Control.Concurrent (myThreadId, killThread) +import Control.Exception (Exception,catch) +import Prelude hiding (catch) +import System.IO +import System.Posix.Signals + +{-# NOINLINE runInterruptibly #-} + +-- | Run an IO action, and allow it to be interrupted +-- by a SIGINT to the current process. Returns +-- an exception if the process did not complete +-- normally. +-- NOTES: +-- * This will replace any existing SIGINT +-- handler during the action. After the computation +-- has completed the existing handler will be restored. +-- * If the IO action is lazy (e.g. using readFile, +-- unsafeInterleaveIO etc.) the lazy computation will +-- not be interruptible, as it will be performed +-- after the signal handler has been removed. +runInterruptibly :: IO a -> IO (Either Exception a) +runInterruptibly a = + do t <- myThreadId + oldH <- installHandler sigINT (Catch (killThread t)) Nothing + x <- p `catch` h + installHandler sigINT oldH Nothing + return x + where p = a >>= \x -> return $! Right $! x + h e = return $ Left e + +-- | Like 'runInterruptibly', but always returns (), whether +-- the computation fails or not. +runInterruptibly_ :: IO () -> IO () +runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly |
