msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Restore old signal handler after each computation.

Browse Source
This commit is contained in:
bringert
2005-11-07 21:27:13 +00:00
parent abf9823601
commit 71cd8efe27
1 changed files with 10 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
src/GF/System/Signal.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stability) -- Stability : (stability)
-- Portability : (portability) -- Portability : (portability)
-- --
-- > CVS $Date: 2005/11/07 20:15:05 $ -- > CVS $Date: 2005/11/07 22:27:13 $
-- > CVS $Author: bringert $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.1 $ -- > CVS $Revision: 1.2 $
-- --
-- Allows SIGINT (Ctrl-C) to interrupt computations. -- Allows SIGINT (Ctrl-C) to interrupt computations.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -26,18 +26,19 @@ import System.Posix.Signals
-- normally. -- normally.
-- NOTES: -- NOTES:
-- * This will replace any existing SIGINT -- * This will replace any existing SIGINT
-- handlers, and after the computation has completed -- handler during the action. After the computation
-- the default handler will be installed for SIGINT. -- has completed the existing handler will be restored.
-- * If the IO action is lazy (e.g. using readFile, -- * If the IO action is lazy (e.g. using readFile,
-- unsafeInterleaveIO etc.) the lazy computation will -- unsafeInterleaveIO etc.) the lazy computation will
-- not be interruptible, as it will be performed -- not be interruptible, as it will be performed
-- after the signal handler has been removed. -- after the signal handler has been removed.
runInterruptibly :: IO a -> IO (Either Exception a) runInterruptibly :: IO a -> IO (Either Exception a)
runInterruptibly a = do t <- myThreadId runInterruptibly a =
installHandler sigINT (Catch (killThread t)) Nothing do t <- myThreadId
x <- p `catch` h oldH <- installHandler sigINT (Catch (killThread t)) Nothing
installHandler sigINT Default Nothing x <- p `catch` h
return x installHandler sigINT oldH Nothing
return x
where p = a >>= \x -> return $! Right $! x where p = a >>= \x -> return $! Right $! x
h e = return $ Left e h e = return $ Left e