{-# OPTIONS -cpp #-}
module GF.System.UseSignal where
import Control.Concurrent (myThreadId, killThread)
import Control.Exception (SomeException,catch)
import Prelude hiding (catch)
#ifdef mingw32_HOST_OS
import GHC.ConsoleHandler
myInstallHandler handler = installHandler handler
myCatch = Catch . const
myIgnore = Ignore
#else
import System.Posix.Signals
myInstallHandler :: Handler -> IO Handler
myInstallHandler Handler
handler = Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigINT Handler
handler Maybe SignalSet
forall a. Maybe a
Nothing
myCatch :: IO () -> Handler
myCatch = IO () -> Handler
Catch
myIgnore :: Handler
myIgnore = Handler
Ignore
#endif
{-# NOINLINE runInterruptibly #-}
runInterruptibly :: IO a -> IO (Either SomeException a)
runInterruptibly :: IO a -> IO (Either SomeException a)
runInterruptibly IO a
a =
do ThreadId
t <- IO ThreadId
myThreadId
Handler
oldH <- Handler -> IO Handler
myInstallHandler (IO () -> Handler
myCatch (ThreadId -> IO ()
killThread ThreadId
t))
Either SomeException a
x <- IO (Either SomeException a)
forall a. IO (Either a a)
p IO (Either SomeException a)
-> (SomeException -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO (Either SomeException a)
forall (m :: * -> *) a b. Monad m => a -> m (Either a b)
h
Handler -> IO Handler
myInstallHandler Handler
oldH
Either SomeException a -> IO (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either SomeException a
x
where p :: IO (Either a a)
p = IO a
a IO a -> (a -> IO (Either a a)) -> IO (Either a a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Either a a -> IO (Either a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a a -> IO (Either a a)) -> Either a a -> IO (Either a a)
forall a b. (a -> b) -> a -> b
$! a -> Either a a
forall a b. b -> Either a b
Right (a -> Either a a) -> a -> Either a a
forall a b. (a -> b) -> a -> b
$! a
x
h :: a -> m (Either a b)
h a
e = Either a b -> m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m (Either a b)) -> Either a b -> m (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
e
runInterruptibly_ :: IO () -> IO ()
runInterruptibly_ :: IO () -> IO ()
runInterruptibly_ = (Either SomeException () -> ())
-> IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeException -> ())
-> (() -> ()) -> Either SomeException () -> ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (() -> SomeException -> ()
forall a b. a -> b -> a
const ()) () -> ()
forall a. a -> a
id) (IO (Either SomeException ()) -> IO ())
-> (IO () -> IO (Either SomeException ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either SomeException ())
forall a. IO a -> IO (Either SomeException a)
runInterruptibly
blockInterrupt :: IO a -> IO a
blockInterrupt :: IO a -> IO a
blockInterrupt IO a
a =
do Handler
oldH <- Handler -> IO Handler
myInstallHandler Handler
myIgnore
a
x <- IO a
a
Handler -> IO Handler
myInstallHandler Handler
oldH
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x