{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}

module Context.Concurrent
  ( -- * Introduction
    -- $intro

    -- * Control.Concurrent wrappers
    forkIO
  , forkFinally
  , forkIOWithUnmask
  , forkOn
  , forkOnWithUnmask
  , forkOS
  , forkOSWithUnmask
  , runInBoundThread
  , runInUnboundThread

    -- * Control.Concurrent re-exports
  , ThreadId
  , myThreadId
  , killThread
  , throwTo
  , getNumCapabilities
  , setNumCapabilities
  , threadCapability
  , yield
  , threadDelay
  , threadWaitRead
  , threadWaitWrite
  , threadWaitReadSTM
  , threadWaitWriteSTM
  , rtsSupportsBoundThreads
  , isCurrentThreadBound
  , mkWeakThreadId
  , module Control.Concurrent.MVar
  , module Control.Concurrent.Chan
  , module Control.Concurrent.QSem
  , module Control.Concurrent.QSemN
  ) where

import Control.Concurrent
  ( ThreadId, getNumCapabilities, isCurrentThreadBound, killThread, mkWeakThreadId, myThreadId
  , rtsSupportsBoundThreads, setNumCapabilities, threadCapability, threadDelay, threadWaitRead
  , threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, throwTo, yield
  )
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Concurrent.QSem
import Control.Concurrent.QSemN
import Control.Exception (SomeException)
import Prelude
import qualified Context.Internal as Internal
import qualified Control.Concurrent as Concurrent
import qualified Control.Exception as Exception

-- | See 'Concurrent.forkIO'.
--
-- @since 0.1.0.0
forkIO :: IO () -> IO ThreadId
forkIO :: IO () -> IO ThreadId
forkIO IO ()
action = do
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    IO () -> IO ThreadId
Concurrent.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
propagate IO ()
action

-- | See 'Concurrent.forkFinally'.
--
-- @since 0.1.0.0
forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally :: forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally IO a
action Either SomeException a -> IO ()
and_then = do
  -- N.B. We re-implement forkFinally instead of delegating directly to the
  -- Control.Concurrent function. This enables us to propagate context a single
  -- time to make it available to both the thread's main action and terminating
  -- action.
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      IO () -> IO ThreadId
Concurrent.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
propagate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO a -> IO a
forall a. IO a -> IO a
restore IO a
action) IO (Either SomeException a)
-> (Either SomeException a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException a -> IO ()
and_then

-- | See 'Concurrent.forkIOWithUnmask'.
--
-- @since 0.1.0.0
forkIOWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask (forall a. IO a -> IO a) -> IO ()
io = do
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
Concurrent.forkIOWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      IO () -> IO ()
propagate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a) -> IO ()
io IO a -> IO a
forall a. IO a -> IO a
restore

-- | See 'Concurrent.forkOn'.
--
-- @since 0.1.0.0
forkOn :: Int -> IO () -> IO ThreadId
forkOn :: Int -> IO () -> IO ThreadId
forkOn Int
cpu IO ()
action = do
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    Int -> IO () -> IO ThreadId
Concurrent.forkOn Int
cpu (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
propagate IO ()
action

-- | See 'Concurrent.forkOnWithUnmask'.
--
-- @since 0.1.0.0
forkOnWithUnmask :: Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkOnWithUnmask :: Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkOnWithUnmask Int
cpu (forall a. IO a -> IO a) -> IO ()
io = do
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
Concurrent.forkOnWithUnmask Int
cpu (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      IO () -> IO ()
propagate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a) -> IO ()
io IO a -> IO a
forall a. IO a -> IO a
restore

-- | See 'Concurrent.forkOS'.
--
-- @since 0.1.0.0
forkOS :: IO () -> IO ThreadId
forkOS :: IO () -> IO ThreadId
forkOS IO ()
action = do
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    IO () -> IO ThreadId
Concurrent.forkOS (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
propagate IO ()
action

-- | See 'Concurrent.forkOSWithUnmask'.
--
-- @since 0.1.0.0
forkOSWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkOSWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkOSWithUnmask (forall a. IO a -> IO a) -> IO ()
io = do
  ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId)
-> ((IO () -> IO ()) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \IO () -> IO ()
propagate -> do
    ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
Concurrent.forkOSWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      IO () -> IO ()
propagate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> IO a) -> IO ()
io IO a -> IO a
forall a. IO a -> IO a
restore

-- | See 'Concurrent.runInBoundThread'.
--
-- @since 0.1.0.0
runInBoundThread :: IO a -> IO a
runInBoundThread :: forall a. IO a -> IO a
runInBoundThread IO a
action =
  ((IO a -> IO a) -> IO a) -> IO a
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO a -> IO a) -> IO a) -> IO a)
-> ((IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IO a -> IO a
propagate -> do
    IO a -> IO a
forall a. IO a -> IO a
Concurrent.runInBoundThread (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
propagate IO a
action

-- | See 'Concurrent.runInUnboundThread'.
--
-- @since 0.1.0.0
runInUnboundThread :: IO a -> IO a
runInUnboundThread :: forall a. IO a -> IO a
runInUnboundThread IO a
action =
  ((IO a -> IO a) -> IO a) -> IO a
forall a b. ((IO a -> IO a) -> IO b) -> IO b
Internal.withPropagator (((IO a -> IO a) -> IO a) -> IO a)
-> ((IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IO a -> IO a
propagate -> do
    IO a -> IO a
forall a. IO a -> IO a
Concurrent.runInUnboundThread (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
propagate IO a
action

-- $intro
--
-- This module provides a "Context"-compatible interface around
-- "Control.Concurrent". Depending on the 'Context.Storage.PropagationStrategy'
-- of the 'Context.Store', the @fork*@ and @run*@ functions in this module can
-- automatically propagate the calling thread's latest registered contexts, if
-- any, over so that they are also available to the thread being created.
--
-- This module is designed to be a drop-in replacement for "Control.Concurrent" so
-- that users only have to import this module instead of both this module and
-- "Control.Concurrent". It is also re-exported from "Context" for convenience.