{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Control.Monad.Conc.Class
-- Copyright   : (c) 2016--2021 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : experimental
-- Portability : CPP, FlexibleContexts, PolyKinds, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies
--
-- This module captures in a typeclass the interface of concurrency
-- monads.
--
-- __Deviations:__ An instance of @MonadConc@ is not required to be an
-- instance of @MonadFix@, unlike @IO@. The @IORef@, @MVar@, and
-- @Ticket@ types are not required to be instances of @Show@ or @Eq@,
-- unlike their normal counterparts. The @threadCapability@,
-- @threadWaitRead@, @threadWaitWrite@, @threadWaitReadSTM@,
-- @threadWaitWriteSTM@, and @mkWeakThreadId@ functions are not
-- provided. The @threadDelay@ function is not required to delay the
-- thread, merely to yield it. The @BlockedIndefinitelyOnMVar@ (and
-- similar) exceptions are /not/ thrown during testing, so do not rely
-- on them at all.
module Control.Monad.Conc.Class
  ( MonadConc(..)

  -- * Threads
  , fork
  , forkOn
  , forkOS
  , forkFinally
  , spawn
  , killThread

  -- ** Bound threads

  -- | Support for multiple operating system threads and bound threads
  -- as described below is currently only available in the GHC runtime
  -- system if you use the -threaded option when linking.
  --
  -- Other Haskell systems do not currently support multiple operating
  -- system threads.
  --
  -- A bound thread is a haskell thread that is bound to an operating
  -- system thread. While the bound thread is still scheduled by the
  -- Haskell run-time system, the operating system thread takes care
  -- of all the foreign calls made by the bound thread.
  --
  -- To a foreign library, the bound thread will look exactly like an
  -- ordinary operating system thread created using OS functions like
  -- pthread_create or CreateThread.
  , rtsSupportsBoundThreads
  , runInBoundThread
  , runInUnboundThread

  -- ** Named Threads
  , forkN
  , forkOnN
  , forkOSN

  -- * Exceptions
  , throw
  , catch
  , mask
  , Ca.mask_
  , uninterruptibleMask
  , Ca.uninterruptibleMask_
  , interruptible

  -- * Mutable State
  , newMVar
  , newMVarN
  , cas
  , peekTicket

  -- * Utilities for type shenanigans
  , IsConc
  , toIsConc
  , fromIsConc

  -- * Utilities for instance writers
  , liftedF
  , liftedFork
  ) where

-- for the class and utilities
import           Control.Exception            (AsyncException(ThreadKilled),
                                               Exception, MaskingState(..),
                                               SomeException)
import           Control.Monad.Catch          (MonadCatch, MonadMask,
                                               MonadThrow)
import qualified Control.Monad.Catch          as Ca
import           Control.Monad.Fail           (MonadFail(..))
import           Control.Monad.STM.Class      (IsSTM, MonadSTM, TVar, fromIsSTM,
                                               newTVar, readTVar)
import           Control.Monad.Trans.Control  (MonadTransControl, StT, liftWith)
import           Data.Kind                    (Type)
import           Data.Proxy                   (Proxy(..))

-- for the 'IO' instance
import qualified Control.Concurrent           as IO
import qualified Control.Concurrent.STM.TVar  as IO
import qualified Control.Exception            as IO
import qualified Control.Monad.STM            as IO
import qualified Data.Atomics                 as IO
import qualified Data.IORef                   as IO
import qualified GHC.Conc                     as IO
import qualified GHC.IO                       as IO

-- for the transformer instances
import           Control.Monad.Reader         (ReaderT)
import qualified Control.Monad.RWS.Lazy       as RL
import qualified Control.Monad.RWS.Strict     as RS
import qualified Control.Monad.State.Lazy     as SL
import qualified Control.Monad.State.Strict   as SS
import           Control.Monad.Trans          (lift)
import           Control.Monad.Trans.Identity (IdentityT)
import qualified Control.Monad.Writer.Lazy    as WL
import qualified Control.Monad.Writer.Strict  as WS

-- | @MonadConc@ is an abstraction over GHC's typical concurrency
-- abstraction. It captures the interface of concurrency monads in
-- terms of how they can operate on shared state and in the presence
-- of exceptions.
--
-- Every @MonadConc@ has an associated 'MonadSTM', transactions of
-- which can be run atomically.
--
-- __Deriving instances:__ If you have a newtype wrapper around a type
-- with an existing @MonadConc@ instance, you should be able to derive
-- an instance for your type automatically, in simple cases.
--
-- For example:
--
-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- > {-# LANGUAGE StandaloneDeriving #-}
-- > {-# LANGUAGE UndecidableInstances #-}
-- >
-- > data Env = Env
-- >
-- > newtype MyMonad m a = MyMonad { runMyMonad :: ReaderT Env m a }
-- >   deriving (Functor, Applicative, Monad)
-- >
-- > deriving instance MonadThrow m => MonadThrow (MyMonad m)
-- > deriving instance MonadCatch m => MonadCatch (MyMonad m)
-- > deriving instance MonadMask  m => MonadMask  (MyMonad m)
-- >
-- > deriving instance MonadConc m => MonadConc (MyMonad m)
--
-- Do not be put off by the use of @UndecidableInstances@, it is safe
-- here.
--
-- @since 1.11.0.0
class ( Monad m
      , MonadCatch m, MonadThrow m, MonadMask m
      , MonadSTM (STM m)
      , Ord (ThreadId m), Show (ThreadId m)) => MonadConc m  where

  {-# MINIMAL
        (forkWithUnmask | forkWithUnmaskN)
      , (forkOnWithUnmask | forkOnWithUnmaskN)
      , (forkOSWithUnmask | forkOSWithUnmaskN)
      , supportsBoundThreads
      , isCurrentThreadBound
      , getNumCapabilities
      , setNumCapabilities
      , myThreadId
      , yield
      , (newEmptyMVar | newEmptyMVarN)
      , putMVar
      , tryPutMVar
      , readMVar
      , tryReadMVar
      , takeMVar
      , tryTakeMVar
      , (newIORef | newIORefN)
      , atomicModifyIORef
      , writeIORef
      , readForCAS
      , peekTicket'
      , casIORef
      , modifyIORefCAS
      , atomically
      , throwTo
      , getMaskingState
      , unsafeUnmask
    #-}

  -- | The associated 'MonadSTM' for this class.
  --
  -- @since 1.0.0.0
  type STM m :: Type -> Type

  -- | The mutable reference type, like 'MVar's. This may contain one
  -- value at a time, attempting to read or take from an \"empty\"
  -- @MVar@ will block until it is full, and attempting to put to a
  -- \"full\" @MVar@ will block until it is empty.
  --
  -- @since 1.0.0.0
  type MVar m :: Type -> Type

  -- | The mutable non-blocking reference type. These may suffer from
  -- relaxed memory effects if functions outside the set @newIORef@,
  -- @readIORef@, @atomicModifyIORef@, and @atomicWriteIORef@ are used.
  --
  -- @since 1.6.0.0
  type IORef m :: Type -> Type

  -- | When performing compare-and-swap operations on @IORef@s, a
  -- @Ticket@ is a proof that a thread observed a specific previous
  -- value.
  --
  -- @since 1.0.0.0
  type Ticket m :: Type -> Type

  -- | An abstract handle to a thread.
  --
  -- @since 1.0.0.0
  type ThreadId m :: Type

  -- | Like 'fork', but the child thread is passed a function that can
  -- be used to unmask asynchronous exceptions. This function should
  -- not be used within a 'mask' or 'uninterruptibleMask'.
  --
  -- > forkWithUnmask = forkWithUnmaskN ""
  --
  -- @since 1.0.0.0
  forkWithUnmask :: ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
  forkWithUnmask = forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmaskN String
""

  -- | Like 'forkWithUnmask', but the thread is given a name which may
  -- be used to present more useful debugging information.
  --
  -- > forkWithUnmaskN _ = forkWithUnmask
  --
  -- @since 1.0.0.0
  forkWithUnmaskN :: String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
  forkWithUnmaskN String
_ = forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmask

  -- | Like 'forkWithUnmask', but the child thread is pinned to the
  -- given CPU, as with 'forkOn'.
  --
  -- > forkOnWithUnmask = forkOnWithUnmaskN ""
  --
  -- @since 1.0.0.0
  forkOnWithUnmask :: Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
  forkOnWithUnmask = forall (m :: * -> *).
MonadConc m =>
String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmaskN String
""

  -- | Like 'forkWithUnmaskN', but the child thread is pinned to the
  -- given CPU, as with 'forkOn'.
  --
  -- > forkOnWithUnmaskN _ = forkOnWithUnmask
  --
  -- @since 1.0.0.0
  forkOnWithUnmaskN :: String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
  forkOnWithUnmaskN String
_ = forall (m :: * -> *).
MonadConc m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmask

  -- | Like 'forkOS', but the child thread is passed a function that
  -- can be used to unmask asynchronous exceptions. This function
  -- should not be used within a 'mask' or 'uninterruptibleMask'.
  --
  -- > forkOSWithUnmask = forkOSWithUnmaskN ""
  --
  -- @since 1.5.0.0
  forkOSWithUnmask :: ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
  forkOSWithUnmask = forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmaskN String
""

  -- | Like 'forkOSWithUnmask', but the thread is given a name which
  -- may be used to present more useful debugging information.
  --
  -- > forkOSWithUnmaskN _ = forkOSWithUnmask
  --
  -- @since 1.5.0.0
  forkOSWithUnmaskN :: String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
  forkOSWithUnmaskN String
_ = forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmask

  -- | Returns 'True' if bound threads can be forked.  If 'False',
  -- 'isCurrentThreadBound' will always return 'False' and both
  -- 'forkOS' and 'runInBoundThread' will fail.
  --
  -- @since 1.7.0.0
  supportsBoundThreads :: m Bool

  -- | Returns 'True' if the calling thread is bound, that is, if it
  -- is safe to use foreign libraries that rely on thread-local state
  -- from the calling thread.
  --
  -- This will always be false if your program is not compiled with
  -- the threaded runtime.
  --
  -- @since 1.3.0.0
  isCurrentThreadBound :: m Bool

  -- | Get the number of Haskell threads that can run simultaneously.
  --
  -- @since 1.0.0.0
  getNumCapabilities :: m Int

  -- | Set the number of Haskell threads that can run simultaneously.
  --
  -- @since 1.0.0.0
  setNumCapabilities :: Int -> m ()

  -- | Get the @ThreadId@ of the current thread.
  --
  -- @since 1.0.0.0
  myThreadId :: m (ThreadId m)

  -- | Allows a context-switch to any other unblocked thread (if any).
  --
  -- @since 1.0.0.0
  yield :: m ()

  -- | Yields the current thread, and optionally suspends the current
  -- thread for a given number of microseconds.
  --
  -- If suspended, there is no guarantee that the thread will be
  -- rescheduled promptly when the delay has expired, but the thread
  -- will never continue to run earlier than specified.
  --
  -- > threadDelay _ = yield
  --
  -- @since 1.0.0.0
  threadDelay :: Int -> m ()
  threadDelay Int
_ = forall (m :: * -> *). MonadConc m => m ()
yield

  -- | Create a new empty @MVar@.
  --
  -- > newEmptyMVar = newEmptyMVarN ""
  --
  -- @since 1.0.0.0
  newEmptyMVar :: m (MVar m a)
  newEmptyMVar = forall (m :: * -> *) a. MonadConc m => String -> m (MVar m a)
newEmptyMVarN String
""

  -- | Create a new empty @MVar@, but it is given a name which may be
  -- used to present more useful debugging information.
  --
  -- > newEmptyMVarN _ = newEmptyMVar
  --
  -- @since 1.0.0.0
  newEmptyMVarN :: String -> m (MVar m a)
  newEmptyMVarN String
_ = forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar

  -- | Put a value into a @MVar@. If there is already a value there,
  -- this will block until that value has been taken, at which point
  -- the value will be stored.
  --
  -- @since 1.0.0.0
  putMVar :: MVar m a -> a -> m ()

  -- | Attempt to put a value in a @MVar@ non-blockingly, returning
  -- 'True' (and filling the @MVar@) if there was nothing there,
  -- otherwise returning 'False'.
  --
  -- @since 1.0.0.0
  tryPutMVar :: MVar m a -> a -> m Bool

  -- | Block until a value is present in the @MVar@, and then return
  -- it. This does not \"remove\" the value, multiple reads are
  -- possible.
  --
  -- @since 1.0.0.0
  readMVar :: MVar m a -> m a

  -- | Attempt to read a value from a @MVar@ non-blockingly, returning
  -- a 'Just' if there is something there, otherwise returning
  -- 'Nothing'. As with 'readMVar', this does not \"remove\" the
  -- value.
  --
  -- @since 1.1.0.0
  tryReadMVar :: MVar m a -> m (Maybe a)

  -- | Take a value from a @MVar@. This \"empties\" the @MVar@,
  -- allowing a new value to be put in. This will block if there is no
  -- value in the @MVar@ already, until one has been put.
  --
  -- @since 1.0.0.0
  takeMVar :: MVar m a -> m a

  -- | Attempt to take a value from a @MVar@ non-blockingly, returning
  -- a 'Just' (and emptying the @MVar@) if there was something there,
  -- otherwise returning 'Nothing'.
  --
  -- @since 1.0.0.0
  tryTakeMVar :: MVar m a -> m (Maybe a)

  -- | Create a new reference.
  --
  -- > newIORef = newIORefN ""
  --
  -- @since 1.6.0.0
  newIORef :: a -> m (IORef m a)
  newIORef = forall (m :: * -> *) a. MonadConc m => String -> a -> m (IORef m a)
newIORefN String
""

  -- | Create a new reference, but it is given a name which may be
  -- used to present more useful debugging information.
  --
  -- > newIORefN _ = newIORef
  --
  -- @since 1.6.0.0
  newIORefN :: String -> a -> m (IORef m a)
  newIORefN String
_ = forall (m :: * -> *) a. MonadConc m => a -> m (IORef m a)
newIORef

  -- | Read the current value stored in a reference.
  --
  -- > readIORef ioref = readForCAS ioref >>= peekTicket
  --
  -- @since 1.6.0.0
  readIORef :: IORef m a -> m a
  readIORef IORef m a
ioref = forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
readForCAS IORef m a
ioref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadConc m => Ticket m a -> m a
peekTicket

  -- | Atomically modify the value stored in a reference. This imposes
  -- a full memory barrier.
  --
  -- @since 1.6.0.0
  atomicModifyIORef :: IORef m a -> (a -> (a, b)) -> m b

  -- | Write a new value into an @IORef@, without imposing a memory
  -- barrier. This means that relaxed memory effects can be observed.
  --
  -- @since 1.6.0.0
  writeIORef :: IORef m a -> a -> m ()

  -- | Replace the value stored in a reference, with the
  -- barrier-to-reordering property that 'atomicModifyIORef' has.
  --
  -- > atomicWriteIORef r a = atomicModifyIORef r $ const (a, ())
  --
  -- @since 1.6.0.0
  atomicWriteIORef :: IORef m a -> a -> m ()
  atomicWriteIORef IORef m a
r a
a = forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
atomicModifyIORef IORef m a
r forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (a
a, ())

  -- | Read the current value stored in a reference, returning a
  -- @Ticket@, for use in future compare-and-swap operations.
  --
  -- @since 1.6.0.0
  readForCAS :: IORef m a -> m (Ticket m a)

  -- | Extract the actual Haskell value from a @Ticket@.
  --
  -- The @Proxy m@ is to determine the @m@ in the @Ticket@ type.
  --
  -- @since 1.4.0.0
  peekTicket' :: Proxy m -> Ticket m a -> a

  -- | Perform a machine-level compare-and-swap (CAS) operation on a
  -- @IORef@. Returns an indication of success and a @Ticket@ for the
  -- most current value in the @IORef@.
  --
  -- This is strict in the \"new\" value argument.
  --
  -- @since 1.6.0.0
  casIORef :: IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)

  -- | A replacement for 'atomicModifyIORef' using a compare-and-swap.
  --
  -- This is strict in the \"new\" value argument.
  --
  -- @since 1.6.0.0
  modifyIORefCAS :: IORef m a -> (a -> (a, b)) -> m b

  -- | A variant of 'modifyIORefCAS' which doesn't return a result.
  --
  -- > modifyIORefCAS_ ioref f = modifyIORefCAS ioref (\a -> (f a, ()))
  --
  -- @since 1.6.0.0
  modifyIORefCAS_ :: IORef m a -> (a -> a) -> m ()
  modifyIORefCAS_ IORef m a
ioref a -> a
f = forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
modifyIORefCAS IORef m a
ioref (\a
a -> (a -> a
f a
a, ()))

  -- | Perform an STM transaction atomically.
  --
  -- @since 1.0.0.0
  atomically :: STM m a -> m a

  -- | Create a @TVar@. This may be implemented differently for speed.
  --
  -- > newTVarConc = atomically . newTVar
  --
  -- @since 1.8.1.0
  newTVarConc :: a -> m (TVar (STM m) a)
  newTVarConc = forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar

  -- | Read the current value stored in a @TVar@. This may be
  -- implemented differently for speed.
  --
  -- > readTVarConc = atomically . readTVar
  --
  -- @since 1.0.0.0
  readTVarConc :: TVar (STM m) a -> m a
  readTVarConc = forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar

  -- | Throw an exception to the target thread. This blocks until the
  -- exception is delivered, and it is just as if the target thread
  -- had raised it with 'throw'. This can interrupt a blocked action.
  --
  -- @since 1.0.0.0
  throwTo :: Exception e => ThreadId m -> e -> m ()

  -- | Return the 'MaskingState' for the current thread.
  --
  -- @since 1.10.0.0
  getMaskingState :: m MaskingState

  -- | Set the 'MaskingState' for the current thread to 'MaskedUninterruptible'.
  --
  -- @since 1.11.0.0
  unsafeUnmask :: m a -> m a

-------------------------------------------------------------------------------
-- Utilities

-- Threads

-- | Fork a computation to happen concurrently. Communication may
-- happen over @MVar@s.
--
-- @since 1.5.0.0
fork :: MonadConc m => m () -> m (ThreadId m)
fork :: forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork m ()
ma = forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmask (\forall a. m a -> m a
_ -> m ()
ma)

-- | Fork a computation to happen on a specific processor. The
-- specified int is the /capability number/, typically capabilities
-- correspond to physical processors or cores but this is
-- implementation dependent. The int is interpreted modulo to the
-- total number of capabilities as returned by 'getNumCapabilities'.
--
-- @since 1.5.0.0
forkOn :: MonadConc m => Int -> m () -> m (ThreadId m)
forkOn :: forall (m :: * -> *). MonadConc m => Int -> m () -> m (ThreadId m)
forkOn Int
c m ()
ma = forall (m :: * -> *).
MonadConc m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmask Int
c (\forall a. m a -> m a
_ -> m ()
ma)

-- | Fork a computation to happen in a /bound thread/, which is
-- necessary if you need to call foreign (non-Haskell) libraries
-- that make use of thread-local state, such as OpenGL.
--
-- @since 1.5.0.0
forkOS :: MonadConc m => m () -> m (ThreadId m)
forkOS :: forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
forkOS m ()
ma = forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmask (\forall a. m a -> m a
_ -> m ()
ma)

-- | Fork a thread and call the supplied function when the thread is
-- about to terminate, with an exception or a returned value. The
-- function is called with asynchronous exceptions masked.
--
-- This function is useful for informing the parent when a child
-- terminates, for example.
--
-- @since 1.0.0.0
forkFinally :: MonadConc m => m a -> (Either SomeException a -> m ()) -> m (ThreadId m)
forkFinally :: forall (m :: * -> *) a.
MonadConc m =>
m a -> (Either SomeException a -> m ()) -> m (ThreadId m)
forkFinally m a
action Either SomeException a -> m ()
and_then =
  forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore ->
    forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ca.try (forall a. m a -> m a
restore m a
action) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException a -> m ()
and_then

-- | Create a concurrent computation for the provided action, and
-- return a @MVar@ which can be used to query the result.
--
-- @since 1.0.0.0
spawn :: MonadConc m => m a -> m (MVar m a)
spawn :: forall (m :: * -> *) a. MonadConc m => m a -> m (MVar m a)
spawn m a
ma = do
  MVar m a
cvar <- forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  ThreadId m
_ <- forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork forall a b. (a -> b) -> a -> b
$ m a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MVar m a
cvar

-- | Raise the 'ThreadKilled' exception in the target thread. Note
-- that if the thread is prepared to catch this exception, it won't
-- actually kill it.
--
-- @since 1.0.0.0
killThread :: MonadConc m => ThreadId m -> m ()
killThread :: forall (m :: * -> *). MonadConc m => ThreadId m -> m ()
killThread ThreadId m
tid = forall (m :: * -> *) e.
(MonadConc m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
tid AsyncException
ThreadKilled

-- | Like 'fork', but the thread is given a name which may be used to
-- present more useful debugging information.
--
-- @since 1.0.0.0
forkN :: MonadConc m => String -> m () -> m (ThreadId m)
forkN :: forall (m :: * -> *).
MonadConc m =>
String -> m () -> m (ThreadId m)
forkN String
name m ()
ma = forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmaskN String
name (\forall a. m a -> m a
_ -> m ()
ma)

-- | Like 'forkOn', but the thread is given a name which may be used
-- to present more useful debugging information.
--
-- @since 1.0.0.0
forkOnN :: MonadConc m => String -> Int -> m () -> m (ThreadId m)
forkOnN :: forall (m :: * -> *).
MonadConc m =>
String -> Int -> m () -> m (ThreadId m)
forkOnN String
name Int
i m ()
ma = forall (m :: * -> *).
MonadConc m =>
String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmaskN String
name Int
i (\forall a. m a -> m a
_ -> m ()
ma)

-- | Like 'forkOS', but the thread is given a name which may be used
-- to present more useful debugging information.
--
-- @since 1.5.0.0
forkOSN :: MonadConc m => String -> m () -> m (ThreadId m)
forkOSN :: forall (m :: * -> *).
MonadConc m =>
String -> m () -> m (ThreadId m)
forkOSN String
name m ()
ma = forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmaskN String
name (\forall a. m a -> m a
_ -> m ()
ma)

-- | 'True' if bound threads are supported.  If
-- 'rtsSupportsBoundThreads' is 'False', 'isCurrentThreadBound' will
-- always return 'False' and both 'forkOS' and 'runInBoundThread' will
-- fail.
--
-- Use 'supportsBoundThreads' in 'MonadConc' instead.
--
-- @since 1.3.0.0
{-# DEPRECATED rtsSupportsBoundThreads "Use 'supportsBoundThreads' instead" #-}
rtsSupportsBoundThreads :: Bool
rtsSupportsBoundThreads :: Bool
rtsSupportsBoundThreads = Bool
IO.rtsSupportsBoundThreads

-- | Run the computation passed as the first argument.  If the calling
-- thread is not /bound/, a bound thread is created temporarily.
-- @runInBoundThread@ doesn't finish until the inner computation
-- finishes.
--
-- You can wrap a series of foreign function calls that rely on
-- thread-local state with @runInBoundThread@ so that you can use them
-- without knowing whether the current thread is /bound/.
--
-- @since 1.3.0.0
runInBoundThread :: MonadConc m => m a -> m a
runInBoundThread :: forall (m :: * -> *) a. MonadConc m => m a -> m a
runInBoundThread =
  forall (m :: * -> *) a.
MonadConc m =>
m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
runInThread (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadConc m => m Bool
isCurrentThreadBound) (forall (m :: * -> *).
MonadConc m =>
String -> m () -> m (ThreadId m)
forkOSN String
"runInBoundThread")

-- | Run the computation passed as the first argument. If the calling
-- thread is /bound/, an unbound thread is created temporarily using
-- @fork@.  @runInBoundThread@ doesn't finish until the inner
-- computation finishes.
--
-- Use this function /only/ in the rare case that you have actually
-- observed a performance loss due to the use of bound threads. A
-- program that doesn't need its main thread to be bound and makes
-- /heavy/ use of concurrency (e.g. a web server), might want to wrap
-- its @main@ action in @runInUnboundThread@.
--
-- Note that exceptions which are thrown to the current thread are
-- thrown in turn to the thread that is executing the given
-- computation. This ensures there's always a way of killing the
-- forked thread.
--
-- @since 1.3.0.0
runInUnboundThread :: MonadConc m => m a -> m a
runInUnboundThread :: forall (m :: * -> *) a. MonadConc m => m a -> m a
runInUnboundThread =
  forall (m :: * -> *) a.
MonadConc m =>
m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
runInThread forall (m :: * -> *). MonadConc m => m Bool
isCurrentThreadBound (forall (m :: * -> *).
MonadConc m =>
String -> m () -> m (ThreadId m)
forkN String
"runInUnboundThread")

-- | Helper for 'runInBoundThread' and 'runInUnboundThread'
runInThread :: MonadConc m => m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
runInThread :: forall (m :: * -> *) a.
MonadConc m =>
m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
runInThread m Bool
check m () -> m (ThreadId m)
dofork m a
action = do
  Bool
flag <- m Bool
check
  if Bool
flag
    then do
      MVar m (Either SomeException a)
mv <- forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
      forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
        ThreadId m
tid <- m () -> m (ThreadId m)
dofork forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ca.try (forall a. m a -> m a
restore m a
action) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m (Either SomeException a)
mv
        let wait :: m (Either SomeException a)
wait = forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m (Either SomeException a)
mv forall (m :: * -> *) e a.
(MonadConc m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
e :: SomeException) -> forall (m :: * -> *) e.
(MonadConc m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
tid SomeException
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Either SomeException a)
wait
        m (Either SomeException a)
wait forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(SomeException
e :: SomeException) -> forall (m :: * -> *) e a. (MonadConc m, Exception e) => e -> m a
throw SomeException
e) forall (f :: * -> *) a. Applicative f => a -> f a
pure
    else m a
action

-- Exceptions

-- | Throw an exception. This will \"bubble up\" looking for an
-- exception handler capable of dealing with it and, if one is not
-- found, the thread is killed.
--
-- @since 1.0.0.0
throw :: (MonadConc m, Exception e) => e -> m a
throw :: forall (m :: * -> *) e a. (MonadConc m, Exception e) => e -> m a
throw = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Ca.throwM

-- | Catch an exception. This is only required to be able to catch
-- exceptions raised by 'throw', unlike the more general
-- Control.Exception.catch function. If you need to be able to catch
-- /all/ errors, you will have to use 'IO'.
--
-- @since 1.0.0.0
catch :: (MonadConc m, Exception e) => m a -> (e -> m a) -> m a
catch :: forall (m :: * -> *) e a.
(MonadConc m, Exception e) =>
m a -> (e -> m a) -> m a
catch = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Ca.catch

-- | Executes a computation with asynchronous exceptions
-- /masked/. That is, any thread which attempts to raise an exception
-- in the current thread with 'throwTo' will be blocked until
-- asynchronous exceptions are unmasked again.
--
-- The argument passed to mask is a function that takes as its
-- argument another function, which can be used to restore the
-- prevailing masking state within the context of the masked
-- computation. This function should not be used within an
-- 'uninterruptibleMask'.
--
-- @since 1.0.0.0
mask :: MonadConc m => ((forall a. m a -> m a) -> m b) -> m b
mask :: forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
Ca.mask

-- | Like 'mask', but the masked computation is not
-- interruptible. THIS SHOULD BE USED WITH GREAT CARE, because if a
-- thread executing in 'uninterruptibleMask' blocks for any reason,
-- then the thread (and possibly the program, if this is the main
-- thread) will be unresponsive and unkillable. This function should
-- only be necessary if you need to mask exceptions around an
-- interruptible operation, and you can guarantee that the
-- interruptible operation will only block for a short period of
-- time. The supplied unmasking function should not be used within a
-- 'mask'.
--
-- @since 1.0.0.0
uninterruptibleMask :: MonadConc m => ((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask :: forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
Ca.uninterruptibleMask

-- | Allow asynchronous exceptions to be raised even inside 'mask',
-- making the operation interruptible.
--
-- When called outside 'mask', or inside 'uninterruptibleMask', this
-- function has no effect.
--
-- @since 1.11.0.0
interruptible :: MonadConc m => m a -> m a
interruptible :: forall (m :: * -> *) a. MonadConc m => m a -> m a
interruptible m a
act = do
  MaskingState
st <- forall (m :: * -> *). MonadConc m => m MaskingState
getMaskingState
  case MaskingState
st of
    MaskingState
Unmasked              -> m a
act
    MaskingState
MaskedInterruptible   -> forall (m :: * -> *) a. MonadConc m => m a -> m a
unsafeUnmask m a
act
    MaskingState
MaskedUninterruptible -> m a
act

-- Mutable Variables

-- | Create a new @MVar@ containing a value.
--
-- @since 1.0.0.0
newMVar :: MonadConc m => a -> m (MVar m a)
newMVar :: forall (m :: * -> *) a. MonadConc m => a -> m (MVar m a)
newMVar a
a = do
  MVar m a
cvar <- forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
a
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MVar m a
cvar

-- | Create a new @MVar@ containing a value, but it is given a name
-- which may be used to present more useful debugging information.
--
-- @since 1.0.0.0
newMVarN :: MonadConc m => String -> a -> m (MVar m a)
newMVarN :: forall (m :: * -> *) a. MonadConc m => String -> a -> m (MVar m a)
newMVarN String
n a
a = do
  MVar m a
cvar <- forall (m :: * -> *) a. MonadConc m => String -> m (MVar m a)
newEmptyMVarN String
n
  forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
a
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MVar m a
cvar

-- | Extract the actual Haskell value from a @Ticket@.
--
-- This doesn't do do any monadic computation, the @m@ appears in the
-- result type to determine the @m@ in the @Ticket@ type.
--
-- @since 1.0.0.0
peekTicket :: forall m a. MonadConc m => Ticket m a -> m a
peekTicket :: forall (m :: * -> *) a. MonadConc m => Ticket m a -> m a
peekTicket Ticket m a
t = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadConc m => Proxy m -> Ticket m a -> a
peekTicket' (forall {k} (t :: k). Proxy t
Proxy :: Proxy m) (Ticket m a
t :: Ticket m a)

-- | Compare-and-swap a value in a @IORef@, returning an indication of
-- success and the new value.
--
-- @since 1.6.0.0
cas :: MonadConc m => IORef m a -> a -> m (Bool, a)
cas :: forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> a -> m (Bool, a)
cas IORef m a
ioref a
a = do
  Ticket m a
tick         <- forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
readForCAS IORef m a
ioref
  (Bool
suc, Ticket m a
tick') <- forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
casIORef IORef m a
ioref Ticket m a
tick a
a
  a
a'           <- forall (m :: * -> *) a. MonadConc m => Ticket m a -> m a
peekTicket Ticket m a
tick'

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
suc, a
a')

-------------------------------------------------------------------------------
-- Concrete instances

-- | @since 1.0.0.0
instance MonadConc IO where
  type STM      IO = IO.STM
  type MVar     IO = IO.MVar
  type IORef    IO = IO.IORef
  type Ticket   IO = IO.Ticket
  type ThreadId IO = IO.ThreadId

  forkWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkWithUnmask   = ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
IO.forkIOWithUnmask
  forkOnWithUnmask :: Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkOnWithUnmask = Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
IO.forkOnWithUnmask
  forkOSWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkOSWithUnmask = ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
IO.forkOSWithUnmask

  forkWithUnmaskN :: String -> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkWithUnmaskN String
n (forall a. IO a -> IO a) -> IO ()
ma = forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
umask -> do
    String -> IO ()
labelMe String
n
    (forall a. IO a -> IO a) -> IO ()
ma forall a. IO a -> IO a
umask

  forkOnWithUnmaskN :: String
-> Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkOnWithUnmaskN String
n Int
i (forall a. IO a -> IO a) -> IO ()
ma = forall (m :: * -> *).
MonadConc m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmask Int
i forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
umask -> do
    String -> IO ()
labelMe String
n
    (forall a. IO a -> IO a) -> IO ()
ma forall a. IO a -> IO a
umask

  forkOSWithUnmaskN :: String -> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkOSWithUnmaskN String
n (forall a. IO a -> IO a) -> IO ()
ma = forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
umask -> do
    String -> IO ()
labelMe String
n
    (forall a. IO a -> IO a) -> IO ()
ma forall a. IO a -> IO a
umask

  supportsBoundThreads :: IO Bool
supportsBoundThreads = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
IO.rtsSupportsBoundThreads
  isCurrentThreadBound :: IO Bool
isCurrentThreadBound = IO Bool
IO.isCurrentThreadBound

  getNumCapabilities :: IO Int
getNumCapabilities  = IO Int
IO.getNumCapabilities
  setNumCapabilities :: Int -> IO ()
setNumCapabilities  = Int -> IO ()
IO.setNumCapabilities
  readMVar :: forall a. MVar IO a -> IO a
readMVar            = forall a. MVar a -> IO a
IO.readMVar
  tryReadMVar :: forall a. MVar IO a -> IO (Maybe a)
tryReadMVar         = forall a. MVar a -> IO (Maybe a)
IO.tryReadMVar
  myThreadId :: IO (ThreadId IO)
myThreadId          = IO ThreadId
IO.myThreadId
  yield :: IO ()
yield               = IO ()
IO.yield
  threadDelay :: Int -> IO ()
threadDelay         = Int -> IO ()
IO.threadDelay
  throwTo :: forall e. Exception e => ThreadId IO -> e -> IO ()
throwTo             = forall e. Exception e => ThreadId -> e -> IO ()
IO.throwTo
  newEmptyMVar :: forall a. IO (MVar IO a)
newEmptyMVar        = forall a. IO (MVar a)
IO.newEmptyMVar
  putMVar :: forall a. MVar IO a -> a -> IO ()
putMVar             = forall a. MVar a -> a -> IO ()
IO.putMVar
  tryPutMVar :: forall a. MVar IO a -> a -> IO Bool
tryPutMVar          = forall a. MVar a -> a -> IO Bool
IO.tryPutMVar
  takeMVar :: forall a. MVar IO a -> IO a
takeMVar            = forall a. MVar a -> IO a
IO.takeMVar
  tryTakeMVar :: forall a. MVar IO a -> IO (Maybe a)
tryTakeMVar         = forall a. MVar a -> IO (Maybe a)
IO.tryTakeMVar
  newIORef :: forall a. a -> IO (IORef IO a)
newIORef            = forall a. a -> IO (IORef a)
IO.newIORef
  readIORef :: forall a. IORef IO a -> IO a
readIORef           = forall a. IORef a -> IO a
IO.readIORef
  atomicModifyIORef :: forall a b. IORef IO a -> (a -> (a, b)) -> IO b
atomicModifyIORef   = forall a b. IORef a -> (a -> (a, b)) -> IO b
IO.atomicModifyIORef
  writeIORef :: forall a. IORef IO a -> a -> IO ()
writeIORef          = forall a. IORef a -> a -> IO ()
IO.writeIORef
  atomicWriteIORef :: forall a. IORef IO a -> a -> IO ()
atomicWriteIORef    = forall a. IORef a -> a -> IO ()
IO.atomicWriteIORef
  readForCAS :: forall a. IORef IO a -> IO (Ticket IO a)
readForCAS          = forall a. IORef a -> IO (Ticket a)
IO.readForCAS
  peekTicket' :: forall a. Proxy IO -> Ticket IO a -> a
peekTicket' Proxy IO
_       = forall a. Ticket a -> a
IO.peekTicket
  casIORef :: forall a. IORef IO a -> Ticket IO a -> a -> IO (Bool, Ticket IO a)
casIORef            = forall a. IORef a -> Ticket a -> a -> IO (Bool, Ticket a)
IO.casIORef
  modifyIORefCAS :: forall a b. IORef IO a -> (a -> (a, b)) -> IO b
modifyIORefCAS      = forall a b. IORef a -> (a -> (a, b)) -> IO b
IO.atomicModifyIORefCAS
  atomically :: forall a. STM IO a -> IO a
atomically          = forall a. STM a -> IO a
IO.atomically
  newTVarConc :: forall a. a -> IO (TVar (STM IO) a)
newTVarConc         = forall a. a -> IO (TVar a)
IO.newTVarIO
  readTVarConc :: forall a. TVar (STM IO) a -> IO a
readTVarConc        = forall a. TVar a -> IO a
IO.readTVarIO
  getMaskingState :: IO MaskingState
getMaskingState     = IO MaskingState
IO.getMaskingState
  unsafeUnmask :: forall a. IO a -> IO a
unsafeUnmask        = forall a. IO a -> IO a
IO.unsafeUnmask

-- | Label the current thread, if the given label is nonempty.
labelMe :: String -> IO ()
labelMe :: String -> IO ()
labelMe String
"" = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
labelMe String
n  = do
  ThreadId
tid <- forall (m :: * -> *). MonadConc m => m (ThreadId m)
myThreadId
  ThreadId -> String -> IO ()
IO.labelThread ThreadId
tid String
n

-------------------------------------------------------------------------------
-- Type shenanigans

-- | A value of type @IsConc m a@ can only be constructed if @m@ has a
-- @MonadConc@ instance.
--
-- @since 1.2.2.0
newtype IsConc m a = IsConc { forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc :: m a }
  deriving (forall a b. a -> IsConc m b -> IsConc m a
forall a b. (a -> b) -> IsConc m a -> IsConc m b
forall (m :: * -> *) a b.
Functor m =>
a -> IsConc m b -> IsConc m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> IsConc m a -> IsConc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> IsConc m b -> IsConc m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> IsConc m b -> IsConc m a
fmap :: forall a b. (a -> b) -> IsConc m a -> IsConc m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> IsConc m a -> IsConc m b
Functor, forall a. a -> IsConc m a
forall a b. IsConc m a -> IsConc m b -> IsConc m a
forall a b. IsConc m a -> IsConc m b -> IsConc m b
forall a b. IsConc m (a -> b) -> IsConc m a -> IsConc m b
forall a b c.
(a -> b -> c) -> IsConc m a -> IsConc m b -> IsConc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (IsConc m)
forall (m :: * -> *) a. Applicative m => a -> IsConc m a
forall (m :: * -> *) a b.
Applicative m =>
IsConc m a -> IsConc m b -> IsConc m a
forall (m :: * -> *) a b.
Applicative m =>
IsConc m a -> IsConc m b -> IsConc m b
forall (m :: * -> *) a b.
Applicative m =>
IsConc m (a -> b) -> IsConc m a -> IsConc m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> IsConc m a -> IsConc m b -> IsConc m c
<* :: forall a b. IsConc m a -> IsConc m b -> IsConc m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
IsConc m a -> IsConc m b -> IsConc m a
*> :: forall a b. IsConc m a -> IsConc m b -> IsConc m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
IsConc m a -> IsConc m b -> IsConc m b
liftA2 :: forall a b c.
(a -> b -> c) -> IsConc m a -> IsConc m b -> IsConc m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> IsConc m a -> IsConc m b -> IsConc m c
<*> :: forall a b. IsConc m (a -> b) -> IsConc m a -> IsConc m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
IsConc m (a -> b) -> IsConc m a -> IsConc m b
pure :: forall a. a -> IsConc m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> IsConc m a
Applicative, forall a. a -> IsConc m a
forall a b. IsConc m a -> IsConc m b -> IsConc m b
forall a b. IsConc m a -> (a -> IsConc m b) -> IsConc m b
forall {m :: * -> *}. Monad m => Applicative (IsConc m)
forall (m :: * -> *) a. Monad m => a -> IsConc m a
forall (m :: * -> *) a b.
Monad m =>
IsConc m a -> IsConc m b -> IsConc m b
forall (m :: * -> *) a b.
Monad m =>
IsConc m a -> (a -> IsConc m b) -> IsConc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> IsConc m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> IsConc m a
>> :: forall a b. IsConc m a -> IsConc m b -> IsConc m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
IsConc m a -> IsConc m b -> IsConc m b
>>= :: forall a b. IsConc m a -> (a -> IsConc m b) -> IsConc m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
IsConc m a -> (a -> IsConc m b) -> IsConc m b
Monad, forall e a. Exception e => e -> IsConc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (IsConc m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> IsConc m a
throwM :: forall e a. Exception e => e -> IsConc m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> IsConc m a
MonadThrow, forall e a.
Exception e =>
IsConc m a -> (e -> IsConc m a) -> IsConc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (IsConc m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
IsConc m a -> (e -> IsConc m a) -> IsConc m a
catch :: forall e a.
Exception e =>
IsConc m a -> (e -> IsConc m a) -> IsConc m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
IsConc m a -> (e -> IsConc m a) -> IsConc m a
MonadCatch, forall b.
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
forall a b c.
IsConc m a
-> (a -> ExitCase b -> IsConc m c)
-> (a -> IsConc m b)
-> IsConc m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (IsConc m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
forall (m :: * -> *) a b c.
MonadMask m =>
IsConc m a
-> (a -> ExitCase b -> IsConc m c)
-> (a -> IsConc m b)
-> IsConc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
IsConc m a
-> (a -> ExitCase b -> IsConc m c)
-> (a -> IsConc m b)
-> IsConc m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
IsConc m a
-> (a -> ExitCase b -> IsConc m c)
-> (a -> IsConc m b)
-> IsConc m (b, c)
uninterruptibleMask :: forall b.
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
mask :: forall b.
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
MonadMask)

-- | @since 1.8.0.0
deriving instance MonadFail m => MonadFail (IsConc m)

-- | Wrap an @m a@ value inside an @IsConc@ if @m@ has a @MonadConc@
-- instance.
--
-- @since 1.2.2.0
toIsConc :: MonadConc m => m a -> IsConc m a
toIsConc :: forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc = forall {k} (m :: k -> *) (a :: k). m a -> IsConc m a
IsConc

-- | Unwrap an @IsConc@ value.
--
-- @since 1.2.2.0
fromIsConc :: MonadConc m => IsConc m a -> m a
fromIsConc :: forall (m :: * -> *) a. MonadConc m => IsConc m a -> m a
fromIsConc = forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc

instance MonadConc m => MonadConc (IsConc m) where
  type STM      (IsConc m) = IsSTM (STM m)
  type MVar     (IsConc m) = MVar     m
  type IORef    (IsConc m) = IORef    m
  type Ticket   (IsConc m) = Ticket   m
  type ThreadId (IsConc m) = ThreadId m

  forkWithUnmask :: ((forall a. IsConc m a -> IsConc m a) -> IsConc m ())
-> IsConc m (ThreadId (IsConc m))
forkWithUnmask        (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmask        (\forall a. m a -> m a
umask -> forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall a. m a -> m a
umask forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  forkWithUnmaskN :: String
-> ((forall a. IsConc m a -> IsConc m a) -> IsConc m ())
-> IsConc m (ThreadId (IsConc m))
forkWithUnmaskN   String
n   (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmaskN   String
n   (\forall a. m a -> m a
umask -> forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall a. m a -> m a
umask forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  forkOnWithUnmask :: Int
-> ((forall a. IsConc m a -> IsConc m a) -> IsConc m ())
-> IsConc m (ThreadId (IsConc m))
forkOnWithUnmask    Int
i (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *).
MonadConc m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmask    Int
i (\forall a. m a -> m a
umask -> forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall a. m a -> m a
umask forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  forkOnWithUnmaskN :: String
-> Int
-> ((forall a. IsConc m a -> IsConc m a) -> IsConc m ())
-> IsConc m (ThreadId (IsConc m))
forkOnWithUnmaskN String
n Int
i (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *).
MonadConc m =>
String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmaskN String
n Int
i (\forall a. m a -> m a
umask -> forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall a. m a -> m a
umask forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  forkOSWithUnmask :: ((forall a. IsConc m a -> IsConc m a) -> IsConc m ())
-> IsConc m (ThreadId (IsConc m))
forkOSWithUnmask      (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmask      (\forall a. m a -> m a
umask -> forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall a. m a -> m a
umask forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  forkOSWithUnmaskN :: String
-> ((forall a. IsConc m a -> IsConc m a) -> IsConc m ())
-> IsConc m (ThreadId (IsConc m))
forkOSWithUnmaskN String
n   (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmaskN String
n   (\forall a. m a -> m a
umask -> forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall a. m a -> m a
umask forall a b. (a -> b) -> a -> b
$ forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  unsafeUnmask :: forall a. IsConc m a -> IsConc m a
unsafeUnmask          IsConc m a
ma = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (forall (m :: * -> *) a. MonadConc m => m a -> m a
unsafeUnmask (forall {k} (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
ma))

  supportsBoundThreads :: IsConc m Bool
supportsBoundThreads = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *). MonadConc m => m Bool
supportsBoundThreads
  isCurrentThreadBound :: IsConc m Bool
isCurrentThreadBound = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *). MonadConc m => m Bool
isCurrentThreadBound

  getNumCapabilities :: IsConc m Int
getNumCapabilities  = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *). MonadConc m => m Int
getNumCapabilities
  setNumCapabilities :: Int -> IsConc m ()
setNumCapabilities  = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadConc m => Int -> m ()
setNumCapabilities
  myThreadId :: IsConc m (ThreadId (IsConc m))
myThreadId          = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *). MonadConc m => m (ThreadId m)
myThreadId
  yield :: IsConc m ()
yield               = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *). MonadConc m => m ()
yield
  threadDelay :: Int -> IsConc m ()
threadDelay         = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadConc m => Int -> m ()
threadDelay
  throwTo :: forall e. Exception e => ThreadId (IsConc m) -> e -> IsConc m ()
throwTo ThreadId (IsConc m)
t           = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e.
(MonadConc m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId (IsConc m)
t
  newEmptyMVar :: forall a. IsConc m (MVar (IsConc m) a)
newEmptyMVar        = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  newEmptyMVarN :: forall a. String -> IsConc m (MVar (IsConc m) a)
newEmptyMVarN       = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => String -> m (MVar m a)
newEmptyMVarN
  readMVar :: forall a. MVar (IsConc m) a -> IsConc m a
readMVar            = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
readMVar
  tryReadMVar :: forall a. MVar (IsConc m) a -> IsConc m (Maybe a)
tryReadMVar         = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
tryReadMVar
  putMVar :: forall a. MVar (IsConc m) a -> a -> IsConc m ()
putMVar MVar (IsConc m) a
v           = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar (IsConc m) a
v
  tryPutMVar :: forall a. MVar (IsConc m) a -> a -> IsConc m Bool
tryPutMVar MVar (IsConc m) a
v        = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m Bool
tryPutMVar MVar (IsConc m) a
v
  takeMVar :: forall a. MVar (IsConc m) a -> IsConc m a
takeMVar            = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar
  tryTakeMVar :: forall a. MVar (IsConc m) a -> IsConc m (Maybe a)
tryTakeMVar         = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
tryTakeMVar
  newIORef :: forall a. a -> IsConc m (IORef (IsConc m) a)
newIORef            = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => a -> m (IORef m a)
newIORef
  newIORefN :: forall a. String -> a -> IsConc m (IORef (IsConc m) a)
newIORefN String
n         = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => String -> a -> m (IORef m a)
newIORefN String
n
  readIORef :: forall a. IORef (IsConc m) a -> IsConc m a
readIORef           = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => IORef m a -> m a
readIORef
  atomicModifyIORef :: forall a b. IORef (IsConc m) a -> (a -> (a, b)) -> IsConc m b
atomicModifyIORef IORef (IsConc m) a
r = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
atomicModifyIORef IORef (IsConc m) a
r
  writeIORef :: forall a. IORef (IsConc m) a -> a -> IsConc m ()
writeIORef IORef (IsConc m) a
r        = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => IORef m a -> a -> m ()
writeIORef IORef (IsConc m) a
r
  atomicWriteIORef :: forall a. IORef (IsConc m) a -> a -> IsConc m ()
atomicWriteIORef IORef (IsConc m) a
r  = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => IORef m a -> a -> m ()
atomicWriteIORef IORef (IsConc m) a
r
  readForCAS :: forall a. IORef (IsConc m) a -> IsConc m (Ticket (IsConc m) a)
readForCAS          = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
readForCAS
  peekTicket' :: forall a. Proxy (IsConc m) -> Ticket (IsConc m) a -> a
peekTicket' Proxy (IsConc m)
_       = forall (m :: * -> *) a. MonadConc m => Proxy m -> Ticket m a -> a
peekTicket' (forall {k} (t :: k). Proxy t
Proxy :: Proxy m)
  casIORef :: forall a.
IORef (IsConc m) a
-> Ticket (IsConc m) a -> a -> IsConc m (Bool, Ticket (IsConc m) a)
casIORef IORef (IsConc m) a
r Ticket (IsConc m) a
t        = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
casIORef IORef (IsConc m) a
r Ticket (IsConc m) a
t
  modifyIORefCAS :: forall a b. IORef (IsConc m) a -> (a -> (a, b)) -> IsConc m b
modifyIORefCAS IORef (IsConc m) a
r    = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
modifyIORefCAS IORef (IsConc m) a
r
  modifyIORefCAS_ :: forall a. IORef (IsConc m) a -> (a -> a) -> IsConc m ()
modifyIORefCAS_ IORef (IsConc m) a
r   = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> (a -> a) -> m ()
modifyIORefCAS_ IORef (IsConc m) a
r
  atomically :: forall a. STM (IsConc m) a -> IsConc m a
atomically          = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadSTM m => IsSTM m a -> m a
fromIsSTM
  newTVarConc :: forall a. a -> IsConc m (TVar (STM (IsConc m)) a)
newTVarConc         = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => a -> m (TVar (STM m) a)
newTVarConc
  readTVarConc :: forall a. TVar (STM (IsConc m)) a -> IsConc m a
readTVarConc        = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConc m => TVar (STM m) a -> m a
readTVarConc
  getMaskingState :: IsConc m MaskingState
getMaskingState     = forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc forall (m :: * -> *). MonadConc m => m MaskingState
getMaskingState

-------------------------------------------------------------------------------
-- Transformer instances

#define INSTANCE(T,C,F)                                          \
instance C => MonadConc (T m) where                            { \
  type STM      (T m) = STM m                                  ; \
  type MVar     (T m) = MVar m                                 ; \
  type IORef    (T m) = IORef m                                ; \
  type Ticket   (T m) = Ticket m                               ; \
  type ThreadId (T m) = ThreadId m                             ; \
                                                                 \
  forkWithUnmask        = liftedFork F forkWithUnmask          ; \
  forkWithUnmaskN   n   = liftedFork F (forkWithUnmaskN   n  ) ; \
  forkOnWithUnmask    i = liftedFork F (forkOnWithUnmask    i) ; \
  forkOnWithUnmaskN n i = liftedFork F (forkOnWithUnmaskN n i) ; \
  forkOSWithUnmask      = liftedFork F forkOSWithUnmask        ; \
  forkOSWithUnmaskN n   = liftedFork F (forkOSWithUnmaskN n  ) ; \
                                                                 \
  supportsBoundThreads = lift supportsBoundThreads             ; \
  isCurrentThreadBound = lift isCurrentThreadBound             ; \
                                                                 \
  getNumCapabilities  = lift getNumCapabilities                ; \
  setNumCapabilities  = lift . setNumCapabilities              ; \
  myThreadId          = lift myThreadId                        ; \
  yield               = lift yield                             ; \
  threadDelay         = lift . threadDelay                     ; \
  throwTo t           = lift . throwTo t                       ; \
  newEmptyMVar        = lift newEmptyMVar                      ; \
  newEmptyMVarN       = lift . newEmptyMVarN                   ; \
  readMVar            = lift . readMVar                        ; \
  tryReadMVar         = lift . tryReadMVar                     ; \
  putMVar v           = lift . putMVar v                       ; \
  tryPutMVar v        = lift . tryPutMVar v                    ; \
  takeMVar            = lift . takeMVar                        ; \
  tryTakeMVar         = lift . tryTakeMVar                     ; \
  newIORef            = lift . newIORef                        ; \
  newIORefN n         = lift . newIORefN n                     ; \
  readIORef           = lift . readIORef                       ; \
  atomicModifyIORef r = lift . atomicModifyIORef r             ; \
  writeIORef r        = lift . writeIORef r                    ; \
  atomicWriteIORef r  = lift . atomicWriteIORef r              ; \
  readForCAS          = lift . readForCAS                      ; \
  peekTicket' _       = peekTicket' (Proxy :: Proxy m)         ; \
  casIORef r t        = lift . casIORef r t                    ; \
  modifyIORefCAS r    = lift . modifyIORefCAS r                ; \
  modifyIORefCAS_ r   = lift . modifyIORefCAS_ r               ; \
  atomically          = lift . atomically                      ; \
  newTVarConc         = lift . newTVarConc                     ; \
  readTVarConc        = lift . readTVarConc                    ; \
  getMaskingState     = lift getMaskingState                   ; \
  unsafeUnmask        = liftedF F unsafeUnmask                 }

-- | New threads inherit the reader state of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(ReaderT r, MonadConc m, id)

-- | @since 1.0.0.0
INSTANCE(IdentityT, MonadConc m, id)

-- | New threads inherit the writer state of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(WL.WriterT w, (MonadConc m, Monoid w), fst)

-- | New threads inherit the writer state of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(WS.WriterT w, (MonadConc m, Monoid w), fst)

-- | New threads inherit the state of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(SL.StateT s, MonadConc m, fst)

-- | New threads inherit the state of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(SS.StateT s, MonadConc m, fst)

-- | New threads inherit the states of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(RL.RWST r w s, (MonadConc m, Monoid w), (\(a,_,_) -> a))

-- | New threads inherit the states of their parent, but do not
-- communicate results back.
--
-- @since 1.0.0.0
INSTANCE(RS.RWST r w s, (MonadConc m, Monoid w), (\(a,_,_) -> a))

#undef INSTANCE

-------------------------------------------------------------------------------

-- | Given a function to remove the transformer-specific state, lift
-- a function invocation.
--
-- @since 1.0.0.0
liftedF :: (MonadTransControl t, MonadConc m)
  => (forall x. StT t x -> x)
  -> (m a -> m b)
  -> t m a
  -> t m b
liftedF :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTransControl t, MonadConc m) =>
(forall x. StT t x -> x) -> (m a -> m b) -> t m a -> t m b
liftedF forall x. StT t x -> x
unst m a -> m b
f t m a
ma = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run t
run -> m a -> m b
f (forall x. StT t x -> x
unst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Run t
run t m a
ma)

-- | Given a function to remove the transformer-specific state, lift
-- a @fork(on)WithUnmask@ invocation.
--
-- @since 1.0.0.0
liftedFork :: (MonadTransControl t, MonadConc m)
  => (forall x. StT t x -> x)
  -> (((forall x. m x -> m x) -> m a) -> m b)
  -> ((forall x. t m x -> t m x) -> t m a)
  -> t m b
liftedFork :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTransControl t, MonadConc m) =>
(forall x. StT t x -> x)
-> (((forall x. m x -> m x) -> m a) -> m b)
-> ((forall x. t m x -> t m x) -> t m a)
-> t m b
liftedFork forall x. StT t x -> x
unst ((forall x. m x -> m x) -> m a) -> m b
f (forall x. t m x -> t m x) -> t m a
ma = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run t
run ->
  ((forall x. m x -> m x) -> m a) -> m b
f (\forall x. m x -> m x
unmask -> forall x. StT t x -> x
unst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Run t
run ((forall x. t m x -> t m x) -> t m a
ma forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTransControl t, MonadConc m) =>
(forall x. StT t x -> x) -> (m a -> m b) -> t m a -> t m b
liftedF forall x. StT t x -> x
unst forall x. m x -> m x
unmask))