{-# LANGUAGE CPP #-}
module Events.Spawn(
spawn
) where
import Control.Concurrent
import Control.Exception
spawn :: IO () -> IO (IO ())
spawn :: IO () -> IO (IO ())
spawn IO ()
action =
do
let quietAction :: IO ()
quietAction = IO () -> IO ()
goesQuietly IO ()
action
ThreadId
threadId <- IO () -> IO ThreadId
forkIO IO ()
quietAction
IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId -> IO ()
killThread ThreadId
threadId)
goesQuietly :: IO () -> IO ()
goesQuietly :: IO () -> IO ()
goesQuietly IO ()
action =
do
Either () ()
result <-
(SomeException -> Maybe ()) -> IO () -> IO (Either () ())
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust
(\ SomeException
exception -> case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exception of
Just AsyncException
ThreadKilled -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
Maybe AsyncException
_ -> case SomeException -> Maybe BlockedIndefinitelyOnMVar
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exception of
#if __GLASGOW_HASKELL__ >= 612
Just BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
#else
Just BlockedOnDeadMVar -> Just ()
#endif
Maybe BlockedIndefinitelyOnMVar
_ -> Maybe ()
forall a. Maybe a
Nothing
)
IO ()
action
case Either () ()
result of
Left () -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right () -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()