{-# 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 = String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 a. m a -> m a) -> m ()) -> m (ThreadId m)
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 = String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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
_ = Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 = String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 a. m a -> m a) -> m ()) -> m (ThreadId m)
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
_ = m ()
forall (m :: * -> *). MonadConc m => m ()
yield

  -- | Create a new empty @MVar@.
  --
  -- > newEmptyMVar = newEmptyMVarN ""
  --
  -- @since 1.0.0.0
  newEmptyMVar :: m (MVar m a)
  newEmptyMVar = String -> m (MVar m a)
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
_ = m (MVar m a)
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 = String -> a -> m (IORef m a)
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
_ = a -> m (IORef m a)
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 = IORef m a -> m (Ticket m a)
forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
readForCAS IORef m a
ioref m (Ticket m a) -> (Ticket m a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ticket m a -> m a
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 = IORef m a -> (a -> (a, ())) -> m ()
forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
atomicModifyIORef IORef m a
r ((a -> (a, ())) -> m ()) -> (a -> (a, ())) -> m ()
forall a b. (a -> b) -> a -> b
$ (a, ()) -> a -> (a, ())
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 = IORef m a -> (a -> (a, ())) -> m ()
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 = STM m (TVar (STM m) a) -> m (TVar (STM m) a)
forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (STM m (TVar (STM m) a) -> m (TVar (STM m) a))
-> (a -> STM m (TVar (STM m) a)) -> a -> m (TVar (STM m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> STM m (TVar (STM m) a)
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 = STM m a -> m a
forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (STM m a -> m a)
-> (TVar (STM m) a -> STM m a) -> TVar (STM m) a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (STM m) a -> STM m a
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 :: m () -> m (ThreadId m)
fork m ()
ma = ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 :: Int -> m () -> m (ThreadId m)
forkOn Int
c m ()
ma = Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 :: m () -> m (ThreadId m)
forkOS m ()
ma = ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 :: m a -> (Either SomeException a -> m ()) -> m (ThreadId m)
forkFinally m a
action Either SomeException a -> m ()
and_then =
  ((forall a. m a -> m a) -> m (ThreadId m)) -> m (ThreadId m)
forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (ThreadId m)) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m (ThreadId m)) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore ->
    m () -> m (ThreadId m)
forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork (m () -> m (ThreadId m)) -> m () -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ca.try (m a -> m a
forall a. m a -> m a
restore m a
action) m (Either SomeException a)
-> (Either SomeException a -> m ()) -> m ()
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 :: m a -> m (MVar m a)
spawn m a
ma = do
  MVar m a
cvar <- m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  ThreadId m
_ <- m () -> m (ThreadId m)
forall (m :: * -> *). MonadConc m => m () -> m (ThreadId m)
fork (m () -> m (ThreadId m)) -> m () -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ m a
ma m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar
  MVar m a -> m (MVar m a)
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 :: ThreadId m -> m ()
killThread ThreadId m
tid = ThreadId m -> AsyncException -> m ()
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 :: String -> m () -> m (ThreadId m)
forkN String
name m ()
ma = String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 :: String -> Int -> m () -> m (ThreadId m)
forkOnN String
name Int
i m ()
ma = String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 :: String -> m () -> m (ThreadId m)
forkOSN String
name m ()
ma = String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 :: m a -> m a
runInBoundThread =
  m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
forall (m :: * -> *) a.
MonadConc m =>
m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
runInThread (Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
forall (m :: * -> *). MonadConc m => m Bool
isCurrentThreadBound) (String -> m () -> m (ThreadId m)
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 :: m a -> m a
runInUnboundThread =
  m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
forall (m :: * -> *) a.
MonadConc m =>
m Bool -> (m () -> m (ThreadId m)) -> m a -> m a
runInThread m Bool
forall (m :: * -> *). MonadConc m => m Bool
isCurrentThreadBound (String -> m () -> m (ThreadId m)
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 :: 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 <- m (MVar m (Either SomeException a))
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
      ((forall a. m a -> m a) -> m a) -> m a
forall (m :: * -> *) b.
MonadConc m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m a) -> m a)
-> ((forall a. m a -> m a) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
        ThreadId m
tid <- m () -> m (ThreadId m)
dofork (m () -> m (ThreadId m)) -> m () -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Ca.try (m a -> m a
forall a. m a -> m a
restore m a
action) m (Either SomeException a)
-> (Either SomeException a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar m (Either SomeException a) -> Either SomeException a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m (Either SomeException a)
mv
        let wait :: m (Either SomeException a)
wait = MVar m (Either SomeException a) -> m (Either SomeException a)
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar MVar m (Either SomeException a)
mv m (Either SomeException a)
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadConc m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
e :: SomeException) -> ThreadId m -> SomeException -> m ()
forall (m :: * -> *) e.
(MonadConc m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
tid SomeException
e m () -> m (Either SomeException a) -> m (Either SomeException a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Either SomeException a)
wait
        m (Either SomeException a)
wait m (Either SomeException a)
-> (Either SomeException a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> m a)
-> (a -> m a) -> Either SomeException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(SomeException
e :: SomeException) -> SomeException -> m a
forall (m :: * -> *) e a. (MonadConc m, Exception e) => e -> m a
throw SomeException
e) a -> m a
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 :: e -> m a
throw = e -> m a
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 :: m a -> (e -> m a) -> m a
catch = m a -> (e -> m a) -> m a
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 a. m a -> m a) -> m b) -> m b
mask = ((forall a. m a -> m a) -> m b) -> m b
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 a. m a -> m a) -> m b) -> m b
uninterruptibleMask = ((forall a. m a -> m a) -> m b) -> m b
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 :: m a -> m a
interruptible m a
act = do
  MaskingState
st <- m MaskingState
forall (m :: * -> *). MonadConc m => m MaskingState
getMaskingState
  case MaskingState
st of
    MaskingState
Unmasked              -> m a
act
    MaskingState
MaskedInterruptible   -> m a -> m a
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 :: a -> m (MVar m a)
newMVar a
a = do
  MVar m a
cvar <- m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
a
  MVar m a -> m (MVar m 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 :: String -> a -> m (MVar m a)
newMVarN String
n a
a = do
  MVar m a
cvar <- String -> m (MVar m a)
forall (m :: * -> *) a. MonadConc m => String -> m (MVar m a)
newEmptyMVarN String
n
  MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
cvar a
a
  MVar m a -> m (MVar m 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 :: Ticket m a -> m a
peekTicket Ticket m a
t = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Proxy m -> Ticket m a -> a
forall (m :: * -> *) a. MonadConc m => Proxy m -> Ticket m a -> a
peekTicket' (Proxy m
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 :: IORef m a -> a -> m (Bool, a)
cas IORef m a
ioref a
a = do
  Ticket m a
tick         <- IORef m a -> m (Ticket m a)
forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
readForCAS IORef m a
ioref
  (Bool
suc, Ticket m a
tick') <- IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
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'           <- Ticket m a -> m a
forall (m :: * -> *) a. MonadConc m => Ticket m a -> m a
peekTicket Ticket m a
tick'

  (Bool, a) -> m (Bool, a)
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
((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
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
Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
IO.forkOnWithUnmask
  forkOSWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forkOSWithUnmask = ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
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 a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO))
-> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
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 = Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forall (m :: * -> *).
MonadConc m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOnWithUnmask Int
i (((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO))
-> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
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 a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmask (((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO))
-> ((forall a. IO a -> IO a) -> IO ()) -> IO (ThreadId IO)
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 = Bool -> IO Bool
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 :: MVar IO a -> IO a
readMVar            = MVar IO a -> IO a
forall a. MVar a -> IO a
IO.readMVar
  tryReadMVar :: MVar IO a -> IO (Maybe a)
tryReadMVar         = MVar IO a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
IO.tryReadMVar
  myThreadId :: IO (ThreadId IO)
myThreadId          = IO ThreadId
IO (ThreadId IO)
IO.myThreadId
  yield :: IO ()
yield               = IO ()
IO.yield
  threadDelay :: Int -> IO ()
threadDelay         = Int -> IO ()
IO.threadDelay
  throwTo :: ThreadId IO -> e -> IO ()
throwTo             = ThreadId IO -> e -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
IO.throwTo
  newEmptyMVar :: IO (MVar IO a)
newEmptyMVar        = IO (MVar IO a)
forall a. IO (MVar a)
IO.newEmptyMVar
  putMVar :: MVar IO a -> a -> IO ()
putMVar             = MVar IO a -> a -> IO ()
forall a. MVar a -> a -> IO ()
IO.putMVar
  tryPutMVar :: MVar IO a -> a -> IO Bool
tryPutMVar          = MVar IO a -> a -> IO Bool
forall a. MVar a -> a -> IO Bool
IO.tryPutMVar
  takeMVar :: MVar IO a -> IO a
takeMVar            = MVar IO a -> IO a
forall a. MVar a -> IO a
IO.takeMVar
  tryTakeMVar :: MVar IO a -> IO (Maybe a)
tryTakeMVar         = MVar IO a -> IO (Maybe a)
forall a. MVar a -> IO (Maybe a)
IO.tryTakeMVar
  newIORef :: a -> IO (IORef IO a)
newIORef            = a -> IO (IORef IO a)
forall a. a -> IO (IORef a)
IO.newIORef
  readIORef :: IORef IO a -> IO a
readIORef           = IORef IO a -> IO a
forall a. IORef a -> IO a
IO.readIORef
  atomicModifyIORef :: IORef IO a -> (a -> (a, b)) -> IO b
atomicModifyIORef   = IORef IO a -> (a -> (a, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
IO.atomicModifyIORef
  writeIORef :: IORef IO a -> a -> IO ()
writeIORef          = IORef IO a -> a -> IO ()
forall a. IORef a -> a -> IO ()
IO.writeIORef
  atomicWriteIORef :: IORef IO a -> a -> IO ()
atomicWriteIORef    = IORef IO a -> a -> IO ()
forall a. IORef a -> a -> IO ()
IO.atomicWriteIORef
  readForCAS :: IORef IO a -> IO (Ticket IO a)
readForCAS          = IORef IO a -> IO (Ticket IO a)
forall a. IORef a -> IO (Ticket a)
IO.readForCAS
  peekTicket' :: Proxy IO -> Ticket IO a -> a
peekTicket' Proxy IO
_       = Ticket IO a -> a
forall a. Ticket a -> a
IO.peekTicket
  casIORef :: IORef IO a -> Ticket IO a -> a -> IO (Bool, Ticket IO a)
casIORef            = IORef IO a -> Ticket IO a -> a -> IO (Bool, Ticket IO a)
forall a. IORef a -> Ticket a -> a -> IO (Bool, Ticket a)
IO.casIORef
  modifyIORefCAS :: IORef IO a -> (a -> (a, b)) -> IO b
modifyIORefCAS      = IORef IO a -> (a -> (a, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
IO.atomicModifyIORefCAS
  atomically :: STM IO a -> IO a
atomically          = STM IO a -> IO a
forall a. STM a -> IO a
IO.atomically
  newTVarConc :: a -> IO (TVar (STM IO) a)
newTVarConc         = a -> IO (TVar (STM IO) a)
forall a. a -> IO (TVar a)
IO.newTVarIO
  readTVarConc :: TVar (STM IO) a -> IO a
readTVarConc        = TVar (STM IO) a -> IO a
forall a. TVar a -> IO a
IO.readTVarIO
  getMaskingState :: IO MaskingState
getMaskingState     = IO MaskingState
IO.getMaskingState
  unsafeUnmask :: IO a -> IO a
unsafeUnmask        = IO a -> IO a
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
"" = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
labelMe String
n  = do
  ThreadId
tid <- IO ThreadId
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 { IsConc m a -> m a
unIsConc :: m a }
  deriving (a -> IsConc m b -> IsConc m a
(a -> b) -> IsConc m a -> IsConc m b
(forall a b. (a -> b) -> IsConc m a -> IsConc m b)
-> (forall a b. a -> IsConc m b -> IsConc m a)
-> Functor (IsConc m)
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
<$ :: a -> IsConc m b -> IsConc m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> IsConc m b -> IsConc m a
fmap :: (a -> b) -> IsConc m a -> IsConc m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> IsConc m a -> IsConc m b
Functor, Functor (IsConc m)
a -> IsConc m a
Functor (IsConc m)
-> (forall a. a -> IsConc m a)
-> (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 a b. IsConc m a -> IsConc m b -> IsConc m b)
-> (forall a b. IsConc m a -> IsConc m b -> IsConc m a)
-> Applicative (IsConc m)
IsConc m a -> IsConc m b -> IsConc m b
IsConc m a -> IsConc m b -> IsConc m a
IsConc m (a -> b) -> IsConc m a -> IsConc m b
(a -> b -> c) -> IsConc m a -> IsConc m b -> IsConc m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> IsConc m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> IsConc m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (IsConc m)
Applicative, Applicative (IsConc m)
a -> IsConc m a
Applicative (IsConc m)
-> (forall a b. IsConc m a -> (a -> IsConc m b) -> IsConc m b)
-> (forall a b. IsConc m a -> IsConc m b -> IsConc m b)
-> (forall a. a -> IsConc m a)
-> Monad (IsConc m)
IsConc m a -> (a -> IsConc m b) -> IsConc m b
IsConc m a -> IsConc m b -> IsConc m b
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 :: a -> IsConc m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> IsConc m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (IsConc m)
Monad, Monad (IsConc m)
e -> IsConc m a
Monad (IsConc m)
-> (forall e a. Exception e => e -> IsConc m a)
-> MonadThrow (IsConc m)
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 :: e -> IsConc m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> IsConc m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (IsConc m)
MonadThrow, MonadThrow (IsConc m)
MonadThrow (IsConc m)
-> (forall e a.
    Exception e =>
    IsConc m a -> (e -> IsConc m a) -> IsConc m a)
-> MonadCatch (IsConc m)
IsConc m a -> (e -> IsConc m a) -> IsConc m a
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 :: 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
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (IsConc m)
MonadCatch, MonadCatch (IsConc m)
MonadCatch (IsConc m)
-> (forall b.
    ((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b)
-> (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))
-> MonadMask (IsConc m)
IsConc m a
-> (a -> ExitCase b -> IsConc m c)
-> (a -> IsConc m b)
-> IsConc m (b, c)
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
((forall a. IsConc m a -> IsConc m a) -> IsConc m b) -> IsConc m b
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 :: * -> *).
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
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)
generalBracket :: 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 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 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
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (IsConc m)
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 :: m a -> IsConc m a
toIsConc = m a -> IsConc m a
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 :: IsConc m a -> m a
fromIsConc = IsConc m a -> m a
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 = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkWithUnmask        (\forall a. m a -> m a
umask -> IsConc m () -> m ()
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc (IsConc m () -> m ()) -> IsConc m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall a. m a -> m a
umask (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
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 = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 -> IsConc m () -> m ()
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc (IsConc m () -> m ()) -> IsConc m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall a. m a -> m a
umask (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
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 = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 -> IsConc m () -> m ()
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc (IsConc m () -> m ()) -> IsConc m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall a. m a -> m a
umask (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
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 = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 -> IsConc m () -> m ()
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc (IsConc m () -> m ()) -> IsConc m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall a. m a -> m a
umask (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
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 = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forkOSWithUnmask      (\forall a. m a -> m a
umask -> IsConc m () -> m ()
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc (IsConc m () -> m ()) -> IsConc m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall a. m a -> m a
umask (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
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 = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
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 -> IsConc m () -> m ()
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc (IsConc m () -> m ()) -> IsConc m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. IsConc m a -> IsConc m a) -> IsConc m ()
ma (\IsConc m a
mx -> m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall a. m a -> m a
umask (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
mx))))
  unsafeUnmask :: IsConc m a -> IsConc m a
unsafeUnmask          IsConc m a
ma = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> m a
forall (m :: * -> *) a. MonadConc m => m a -> m a
unsafeUnmask (IsConc m a -> m a
forall k (m :: k -> *) (a :: k). IsConc m a -> m a
unIsConc IsConc m a
ma))

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

  getNumCapabilities :: IsConc m Int
getNumCapabilities  = m Int -> IsConc m Int
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc m Int
forall (m :: * -> *). MonadConc m => m Int
getNumCapabilities
  setNumCapabilities :: Int -> IsConc m ()
setNumCapabilities  = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ()) -> (Int -> m ()) -> Int -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadConc m => Int -> m ()
setNumCapabilities
  myThreadId :: IsConc m (ThreadId (IsConc m))
myThreadId          = m (ThreadId m) -> IsConc m (ThreadId m)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc m (ThreadId m)
forall (m :: * -> *). MonadConc m => m (ThreadId m)
myThreadId
  yield :: IsConc m ()
yield               = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc m ()
forall (m :: * -> *). MonadConc m => m ()
yield
  threadDelay :: Int -> IsConc m ()
threadDelay         = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ()) -> (Int -> m ()) -> Int -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadConc m => Int -> m ()
threadDelay
  throwTo :: ThreadId (IsConc m) -> e -> IsConc m ()
throwTo ThreadId (IsConc m)
t           = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ()) -> (e -> m ()) -> e -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId m -> e -> m ()
forall (m :: * -> *) e.
(MonadConc m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
ThreadId (IsConc m)
t
  newEmptyMVar :: IsConc m (MVar (IsConc m) a)
newEmptyMVar        = m (MVar m a) -> IsConc m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
newEmptyMVar
  newEmptyMVarN :: String -> IsConc m (MVar (IsConc m) a)
newEmptyMVarN       = m (MVar m a) -> IsConc m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (MVar m a) -> IsConc m (MVar m a))
-> (String -> m (MVar m a)) -> String -> IsConc m (MVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (MVar m a)
forall (m :: * -> *) a. MonadConc m => String -> m (MVar m a)
newEmptyMVarN
  readMVar :: MVar (IsConc m) a -> IsConc m a
readMVar            = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> IsConc m a) -> (MVar m a -> m a) -> MVar m a -> IsConc m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
readMVar
  tryReadMVar :: MVar (IsConc m) a -> IsConc m (Maybe a)
tryReadMVar         = m (Maybe a) -> IsConc m (Maybe a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (Maybe a) -> IsConc m (Maybe a))
-> (MVar m a -> m (Maybe a)) -> MVar m a -> IsConc m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
tryReadMVar
  putMVar :: MVar (IsConc m) a -> a -> IsConc m ()
putMVar MVar (IsConc m) a
v           = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ()) -> (a -> m ()) -> a -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
putMVar MVar m a
MVar (IsConc m) a
v
  tryPutMVar :: MVar (IsConc m) a -> a -> IsConc m Bool
tryPutMVar MVar (IsConc m) a
v        = m Bool -> IsConc m Bool
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m Bool -> IsConc m Bool) -> (a -> m Bool) -> a -> IsConc m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> a -> m Bool
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m Bool
tryPutMVar MVar m a
MVar (IsConc m) a
v
  takeMVar :: MVar (IsConc m) a -> IsConc m a
takeMVar            = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> IsConc m a) -> (MVar m a -> m a) -> MVar m a -> IsConc m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
takeMVar
  tryTakeMVar :: MVar (IsConc m) a -> IsConc m (Maybe a)
tryTakeMVar         = m (Maybe a) -> IsConc m (Maybe a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (Maybe a) -> IsConc m (Maybe a))
-> (MVar m a -> m (Maybe a)) -> MVar m a -> IsConc m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
tryTakeMVar
  newIORef :: a -> IsConc m (IORef (IsConc m) a)
newIORef            = m (IORef m a) -> IsConc m (IORef m a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (IORef m a) -> IsConc m (IORef m a))
-> (a -> m (IORef m a)) -> a -> IsConc m (IORef m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (IORef m a)
forall (m :: * -> *) a. MonadConc m => a -> m (IORef m a)
newIORef
  newIORefN :: String -> a -> IsConc m (IORef (IsConc m) a)
newIORefN String
n         = m (IORef m a) -> IsConc m (IORef m a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (IORef m a) -> IsConc m (IORef m a))
-> (a -> m (IORef m a)) -> a -> IsConc m (IORef m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> m (IORef m a)
forall (m :: * -> *) a. MonadConc m => String -> a -> m (IORef m a)
newIORefN String
n
  readIORef :: IORef (IsConc m) a -> IsConc m a
readIORef           = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> IsConc m a)
-> (IORef m a -> m a) -> IORef m a -> IsConc m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> m a
forall (m :: * -> *) a. MonadConc m => IORef m a -> m a
readIORef
  atomicModifyIORef :: IORef (IsConc m) a -> (a -> (a, b)) -> IsConc m b
atomicModifyIORef IORef (IsConc m) a
r = m b -> IsConc m b
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m b -> IsConc m b)
-> ((a -> (a, b)) -> m b) -> (a -> (a, b)) -> IsConc m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
atomicModifyIORef IORef m a
IORef (IsConc m) a
r
  writeIORef :: IORef (IsConc m) a -> a -> IsConc m ()
writeIORef IORef (IsConc m) a
r        = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ()) -> (a -> m ()) -> a -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => IORef m a -> a -> m ()
writeIORef IORef m a
IORef (IsConc m) a
r
  atomicWriteIORef :: IORef (IsConc m) a -> a -> IsConc m ()
atomicWriteIORef IORef (IsConc m) a
r  = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ()) -> (a -> m ()) -> a -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => IORef m a -> a -> m ()
atomicWriteIORef IORef m a
IORef (IsConc m) a
r
  readForCAS :: IORef (IsConc m) a -> IsConc m (Ticket (IsConc m) a)
readForCAS          = m (Ticket m a) -> IsConc m (Ticket m a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (Ticket m a) -> IsConc m (Ticket m a))
-> (IORef m a -> m (Ticket m a))
-> IORef m a
-> IsConc m (Ticket m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> m (Ticket m a)
forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
readForCAS
  peekTicket' :: Proxy (IsConc m) -> Ticket (IsConc m) a -> a
peekTicket' Proxy (IsConc m)
_       = Proxy m -> Ticket m a -> a
forall (m :: * -> *) a. MonadConc m => Proxy m -> Ticket m a -> a
peekTicket' (Proxy m
forall k (t :: k). Proxy t
Proxy :: Proxy m)
  casIORef :: 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        = m (Bool, Ticket m a) -> IsConc m (Bool, Ticket m a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (Bool, Ticket m a) -> IsConc m (Bool, Ticket m a))
-> (a -> m (Bool, Ticket m a)) -> a -> IsConc m (Bool, Ticket m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
casIORef IORef m a
IORef (IsConc m) a
r Ticket m a
Ticket (IsConc m) a
t
  modifyIORefCAS :: IORef (IsConc m) a -> (a -> (a, b)) -> IsConc m b
modifyIORefCAS IORef (IsConc m) a
r    = m b -> IsConc m b
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m b -> IsConc m b)
-> ((a -> (a, b)) -> m b) -> (a -> (a, b)) -> IsConc m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
modifyIORefCAS IORef m a
IORef (IsConc m) a
r
  modifyIORefCAS_ :: IORef (IsConc m) a -> (a -> a) -> IsConc m ()
modifyIORefCAS_ IORef (IsConc m) a
r   = m () -> IsConc m ()
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m () -> IsConc m ())
-> ((a -> a) -> m ()) -> (a -> a) -> IsConc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef m a -> (a -> a) -> m ()
forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> (a -> a) -> m ()
modifyIORefCAS_ IORef m a
IORef (IsConc m) a
r
  atomically :: STM (IsConc m) a -> IsConc m a
atomically          = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> IsConc m a)
-> (IsSTM (STM m) a -> m a) -> IsSTM (STM m) a -> IsConc m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM m a -> m a
forall (m :: * -> *) a. MonadConc m => STM m a -> m a
atomically (STM m a -> m a)
-> (IsSTM (STM m) a -> STM m a) -> IsSTM (STM m) a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsSTM (STM m) a -> STM m a
forall (m :: * -> *) a. MonadSTM m => IsSTM m a -> m a
fromIsSTM
  newTVarConc :: a -> IsConc m (TVar (STM (IsConc m)) a)
newTVarConc         = m (TVar (STM m) a) -> IsConc m (TVar (STM m) a)
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m (TVar (STM m) a) -> IsConc m (TVar (STM m) a))
-> (a -> m (TVar (STM m) a)) -> a -> IsConc m (TVar (STM m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (TVar (STM m) a)
forall (m :: * -> *) a. MonadConc m => a -> m (TVar (STM m) a)
newTVarConc
  readTVarConc :: TVar (STM (IsConc m)) a -> IsConc m a
readTVarConc        = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc (m a -> IsConc m a)
-> (TVar (STM m) a -> m a) -> TVar (STM m) a -> IsConc m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (STM m) a -> m a
forall (m :: * -> *) a. MonadConc m => TVar (STM m) a -> m a
readTVarConc
  getMaskingState :: IsConc m MaskingState
getMaskingState     = m MaskingState -> IsConc m MaskingState
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
toIsConc m MaskingState
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 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 = (Run t -> m b) -> t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t -> m b) -> t m b) -> (Run t -> m b) -> t m b
forall a b. (a -> b) -> a -> b
$ \Run t
run -> m a -> m b
f (StT t a -> a
forall x. StT t x -> x
unst (StT t a -> a) -> m (StT t a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t m a -> m (StT t a)
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 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 = (Run t -> m b) -> t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t -> m b) -> t m b) -> (Run t -> m b) -> t m b
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 -> StT t a -> a
forall x. StT t x -> x
unst (StT t a -> a) -> m (StT t a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t m a -> m (StT t a)
Run t
run ((forall x. t m x -> t m x) -> t m a
ma ((forall x. t m x -> t m x) -> t m a)
-> (forall x. t m x -> t m x) -> t m a
forall a b. (a -> b) -> a -> b
$ (forall x. StT t x -> x) -> (m x -> m x) -> t m x -> t m x
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 x -> m x
forall x. m x -> m x
unmask))