module Streamly.Internal.Control.ForkLifted
(
doFork
, doForkWith
, fork
, forkManaged
)
where
import Control.Concurrent (ThreadId, forkIO, forkOS)
import Control.Exception (SomeException(..), catch, mask)
import Data.Functor (void)
import Streamly.Internal.Control.Concurrent (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore)
import Streamly.Internal.Control.ForkIO (rawForkIO, forkManagedWith)
{-# INLINE doFork #-}
doFork :: MonadRunInIO m
=> m ()
-> RunInIO m
-> (SomeException -> IO ())
-> m ThreadId
doFork :: forall (m :: * -> *).
MonadRunInIO m =>
m () -> RunInIO m -> (SomeException -> IO ()) -> m ThreadId
doFork = Bool -> m () -> RunInIO m -> (SomeException -> IO ()) -> m ThreadId
forall (m :: * -> *).
MonadRunInIO m =>
Bool -> m () -> RunInIO m -> (SomeException -> IO ()) -> m ThreadId
doForkWith Bool
False
{-# INLINE doForkWith #-}
doForkWith :: MonadRunInIO m
=> Bool
-> m ()
-> RunInIO m
-> (SomeException -> IO ())
-> m ThreadId
doForkWith :: forall (m :: * -> *).
MonadRunInIO m =>
Bool -> m () -> RunInIO m -> (SomeException -> IO ()) -> m ThreadId
doForkWith Bool
bound m ()
action (RunInIO forall b. m b -> IO (StM m b)
mrun) SomeException -> IO ()
exHandler =
((forall b. m b -> IO (StM m b)) -> IO (StM m ThreadId))
-> m ThreadId
forall (m :: * -> *) b.
MonadRunInIO m =>
((forall a. m a -> IO (StM m a)) -> IO (StM m b)) -> m b
withRunInIO (((forall b. m b -> IO (StM m b)) -> IO (StM m ThreadId))
-> m ThreadId)
-> ((forall b. m b -> IO (StM m b)) -> IO (StM m ThreadId))
-> m ThreadId
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> IO (StM m b)
run ->
((forall a. IO a -> IO a) -> IO (StM m ThreadId))
-> IO (StM m ThreadId)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (StM m ThreadId))
-> IO (StM m ThreadId))
-> ((forall a. IO a -> IO a) -> IO (StM m ThreadId))
-> IO (StM m ThreadId)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
ThreadId
tid <- (if Bool
bound then IO () -> IO ThreadId
forkOS else IO () -> IO ThreadId
rawForkIO) (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO (StM m ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (StM m ()) -> IO ()) -> IO (StM m ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ m () -> IO (StM m ())
forall b. m b -> IO (StM m b)
mrun m ()
action)
SomeException -> IO ()
exHandler
m ThreadId -> IO (StM m ThreadId)
forall b. m b -> IO (StM m b)
run (ThreadId -> m ThreadId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
tid)
{-# INLINABLE fork #-}
fork :: MonadRunInIO m => m () -> m ThreadId
fork :: forall (m :: * -> *). MonadRunInIO m => m () -> m ThreadId
fork m ()
m = ((forall a. m a -> IO (StM m a)) -> IO ThreadId) -> m ThreadId
forall (m :: * -> *) b.
MonadRunInIO m =>
((forall a. m a -> IO (StM m a)) -> IO b) -> m b
withRunInIONoRestore (((forall a. m a -> IO (StM m a)) -> IO ThreadId) -> m ThreadId)
-> ((forall a. m a -> IO (StM m a)) -> IO ThreadId) -> m ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO (StM m a)
run -> IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO (StM m ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (StM m ()) -> IO ()) -> IO (StM m ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ m () -> IO (StM m ())
forall a. m a -> IO (StM m a)
run m ()
m
{-# INLINABLE forkManaged #-}
forkManaged :: MonadRunInIO m => m () -> m ThreadId
forkManaged :: forall (m :: * -> *). MonadRunInIO m => m () -> m ThreadId
forkManaged = (m () -> m ThreadId) -> m () -> m ThreadId
forall (m :: * -> *).
MonadIO m =>
(m () -> m ThreadId) -> m () -> m ThreadId
forkManagedWith m () -> m ThreadId
forall (m :: * -> *). MonadRunInIO m => m () -> m ThreadId
fork