{-# LANGUAGE CPP, NoImplicitPrelude, RankNTypes, ImpredicativeTypes #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Control.Concurrent.Thread
(
forkIO
, forkOS
, forkOn
, forkIOWithUnmask
, forkOnWithUnmask
, Result
, result
) where
import qualified Control.Concurrent ( forkOS
, forkIOWithUnmask
, forkOnWithUnmask
)
import Control.Concurrent ( ThreadId )
import Control.Concurrent.MVar ( newEmptyMVar, putMVar, readMVar )
import Control.Exception ( SomeException, try, throwIO, mask )
import Control.Monad ( return, (>>=) )
import Data.Either ( Either(..), either )
import Data.Function ( (.), ($) )
import Data.Int ( Int )
import System.IO ( IO )
import Control.Concurrent.Raw ( rawForkIO, rawForkOn )
forkIO :: IO a -> IO (ThreadId, IO (Result a))
forkIO :: IO a -> IO (ThreadId, IO (Result a))
forkIO = (IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
forall a.
(IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
fork IO () -> IO ThreadId
rawForkIO
forkOS :: IO a -> IO (ThreadId, IO (Result a))
forkOS :: IO a -> IO (ThreadId, IO (Result a))
forkOS = (IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
forall a.
(IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
fork IO () -> IO ThreadId
Control.Concurrent.forkOS
forkOn :: Int -> IO a -> IO (ThreadId, IO (Result a))
forkOn :: Int -> IO a -> IO (ThreadId, IO (Result a))
forkOn = (IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
forall a.
(IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
fork ((IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a)))
-> (Int -> IO () -> IO ThreadId)
-> Int
-> IO a
-> IO (ThreadId, IO (Result a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO () -> IO ThreadId
rawForkOn
forkIOWithUnmask
:: ((forall b. IO b -> IO b) -> IO a) -> IO (ThreadId, IO (Result a))
forkIOWithUnmask :: ((forall b. IO b -> IO b) -> IO a) -> IO (ThreadId, IO (Result a))
forkIOWithUnmask = (((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forall a.
(((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forkWithUnmask ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
Control.Concurrent.forkIOWithUnmask
forkOnWithUnmask
:: Int -> ((forall b. IO b -> IO b) -> IO a) -> IO (ThreadId, IO (Result a))
forkOnWithUnmask :: Int
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forkOnWithUnmask = (((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forall a.
(((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forkWithUnmask ((((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a)))
-> (Int -> ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> Int
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
Control.Concurrent.forkOnWithUnmask
fork :: (IO () -> IO ThreadId) -> (IO a -> IO (ThreadId, IO (Result a)))
fork :: (IO () -> IO ThreadId) -> IO a -> IO (ThreadId, IO (Result a))
fork IO () -> IO ThreadId
doFork = \IO a
a -> do
MVar (Result a)
res <- IO (MVar (Result a))
forall a. IO (MVar a)
newEmptyMVar
ThreadId
tid <- ((forall b. IO b -> IO b) -> IO ThreadId) -> IO ThreadId
forall b. ((forall b. IO b -> IO b) -> IO b) -> IO b
mask (((forall b. IO b -> IO b) -> IO ThreadId) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore -> IO () -> IO ThreadId
doFork (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Result a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO a
forall b. IO b -> IO b
restore IO a
a) IO (Result a) -> (Result a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Result a) -> Result a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Result a)
res
(ThreadId, IO (Result a)) -> IO (ThreadId, IO (Result a))
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId
tid, MVar (Result a) -> IO (Result a)
forall a. MVar a -> IO a
readMVar MVar (Result a)
res)
forkWithUnmask
:: (((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a) -> IO (ThreadId, IO (Result a))
forkWithUnmask :: (((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO a)
-> IO (ThreadId, IO (Result a))
forkWithUnmask ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
doForkWithUnmask = \(forall b. IO b -> IO b) -> IO a
f -> do
MVar (Result a)
res <- IO (MVar (Result a))
forall a. IO (MVar a)
newEmptyMVar
ThreadId
tid <- ((forall b. IO b -> IO b) -> IO ThreadId) -> IO ThreadId
forall b. ((forall b. IO b -> IO b) -> IO b) -> IO b
mask (((forall b. IO b -> IO b) -> IO ThreadId) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore ->
((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
doForkWithUnmask (((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId)
-> ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
unmask ->
IO a -> IO (Result a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO a
forall b. IO b -> IO b
restore (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (forall b. IO b -> IO b) -> IO a
f forall b. IO b -> IO b
unmask) IO (Result a) -> (Result a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Result a) -> Result a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Result a)
res
(ThreadId, IO (Result a)) -> IO (ThreadId, IO (Result a))
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId
tid, MVar (Result a) -> IO (Result a)
forall a. MVar a -> IO a
readMVar MVar (Result a)
res)
type Result a = Either SomeException a
result :: Result a -> IO a
result :: Result a -> IO a
result = (SomeException -> IO a) -> (a -> IO a) -> Result a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return