-- |
-- Module      : Streamly.Internal.Control.ForkLifted
-- Copyright   : (c) 2017 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

module Streamly.Internal.Control.ForkLifted
    (
      doFork
    , fork
    , forkManaged
    )
where

import Control.Concurrent (ThreadId, forkIO)
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)

-- | Fork a thread to run the given computation, installing the provided
-- exception handler. Lifted to any monad with 'MonadRunInIO m'
-- capability.
--
-- TODO: the RunInIO argument can be removed, we can directly pass the action
-- as "mrun action" instead.
{-# 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 m ()
action (RunInIO forall b. m b -> IO (StM m b)
mrun) SomeException -> IO ()
exHandler =
    forall (m :: * -> *) b.
MonadRunInIO m =>
((forall a. m a -> IO (StM m a)) -> IO (StM m b)) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall b. m b -> IO (StM m b)
run ->
        forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
                ThreadId
tid <- IO () -> IO ThreadId
rawForkIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall b. m b -> IO (StM m b)
mrun m ()
action)
                                         SomeException -> IO ()
exHandler
                forall b. m b -> IO (StM m b)
run (forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
tid)

-- | 'fork' lifted to any monad with 'MonadBaseControl IO m' capability.
--
{-# INLINABLE fork #-}
fork :: MonadRunInIO m => m () -> m ThreadId
fork :: forall (m :: * -> *). MonadRunInIO m => m () -> m ThreadId
fork m ()
m = forall (m :: * -> *) b.
MonadRunInIO m =>
((forall a. m a -> IO (StM m a)) -> IO b) -> m b
withRunInIONoRestore forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO (StM m a)
run -> IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO (StM m a)
run m ()
m

-- | Fork a thread that is automatically killed as soon as the reference to the
-- returned threadId is garbage collected.
--
{-# INLINABLE forkManaged #-}
forkManaged :: MonadRunInIO m => m () -> m ThreadId
forkManaged :: forall (m :: * -> *). MonadRunInIO m => m () -> m ThreadId
forkManaged = forall (m :: * -> *).
MonadIO m =>
(m () -> m ThreadId) -> m () -> m ThreadId
forkManagedWith forall (m :: * -> *). MonadRunInIO m => m () -> m ThreadId
fork