{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeFamilyDependencies     #-}
{-# LANGUAGE TypeOperators              #-}

-- needed for `ReaderT` instance
{-# LANGUAGE UndecidableInstances       #-}

-- Internal module.  It's only exposed as it provides various default types for
-- defining new instances, otherwise prefer to use
-- 'Control.Concurrent.Class.MonadSTM'.
--
module Control.Monad.Class.MonadSTM.Internal
  ( MonadSTM (..)
  , MonadLabelledSTM (..)
  , MonadInspectSTM (..)
  , TraceValue (TraceValue, TraceDynamic, TraceString, DontTrace, traceDynamic, traceString)
  , MonadTraceSTM (..)
    -- * MonadThrow aliases
  , throwSTM
  , catchSTM
    -- * Default implementations
    -- $default-implementations
    --
    -- ** Default 'TMVar' implementation
  , TMVarDefault (..)
  , newTMVarDefault
  , newEmptyTMVarDefault
  , takeTMVarDefault
  , tryTakeTMVarDefault
  , putTMVarDefault
  , tryPutTMVarDefault
  , readTMVarDefault
  , tryReadTMVarDefault
  , swapTMVarDefault
  , isEmptyTMVarDefault
  , labelTMVarDefault
  , traceTMVarDefault
    -- ** Default 'TBQueue' implementation
  , TQueueDefault (..)
  , newTQueueDefault
  , writeTQueueDefault
  , readTQueueDefault
  , tryReadTQueueDefault
  , isEmptyTQueueDefault
  , peekTQueueDefault
  , tryPeekTQueueDefault
  , flushTQueueDefault
  , unGetTQueueDefault
  , labelTQueueDefault
    -- ** Default 'TBQueue' implementation
  , TBQueueDefault (..)
  , newTBQueueDefault
  , writeTBQueueDefault
  , readTBQueueDefault
  , tryReadTBQueueDefault
  , peekTBQueueDefault
  , tryPeekTBQueueDefault
  , isEmptyTBQueueDefault
  , isFullTBQueueDefault
  , lengthTBQueueDefault
  , flushTBQueueDefault
  , unGetTBQueueDefault
  , labelTBQueueDefault
    -- ** Default 'TArray' implementation
  , TArrayDefault (..)
    -- ** Default 'TSem' implementation
  , TSemDefault (..)
  , newTSemDefault
  , waitTSemDefault
  , signalTSemDefault
  , signalTSemNDefault
  , labelTSemDefault
    -- ** Default 'TChan' implementation
  , TChanDefault (..)
  , newTChanDefault
  , newBroadcastTChanDefault
  , writeTChanDefault
  , readTChanDefault
  , tryReadTChanDefault
  , peekTChanDefault
  , tryPeekTChanDefault
  , dupTChanDefault
  , unGetTChanDefault
  , isEmptyTChanDefault
  , cloneTChanDefault
  , labelTChanDefault
  ) where

import           Prelude hiding (read)

import qualified Control.Concurrent.STM.TArray as STM
import qualified Control.Concurrent.STM.TBQueue as STM
import qualified Control.Concurrent.STM.TChan as STM
import qualified Control.Concurrent.STM.TMVar as STM
import qualified Control.Concurrent.STM.TQueue as STM
import qualified Control.Concurrent.STM.TSem as STM
import qualified Control.Concurrent.STM.TVar as STM
import           Control.Monad (unless, when)
import qualified Control.Monad.STM as STM

import           Control.Monad.Reader (ReaderT (..))
import           Control.Monad.Trans (lift)

import qualified Control.Monad.Class.MonadThrow as MonadThrow

import           Control.Exception
import           Data.Array (Array, bounds)
import qualified Data.Array as Array
import           Data.Array.Base (IArray (numElements), MArray (..),
                     arrEleBottom, listArray, unsafeAt)
import           Data.Foldable (traverse_)
import           Data.Ix (Ix, rangeSize)
import           Data.Kind (Type)
import           Data.Proxy (Proxy (..))
import           Data.Typeable (Typeable)
import           GHC.Stack
import           Numeric.Natural (Natural)


-- $default-implementations
--
-- The default implementations are based on a `TVar` defined in the class.  They
-- are tailored towards `IOSim` rather than instances which would like to derive
-- from `IO` or monad transformers.


-- | The STM primitives parametrised by a monad `m`.
--
class (Monad m, Monad (STM m)) => MonadSTM m where
  -- | The STM monad.
  type STM  m = (stm :: Type -> Type)  | stm -> m
  -- | Atomically run an STM computation.
  --
  -- See `STM.atomically`.
  atomically :: HasCallStack => STM m a -> m a

  -- | A type of a 'TVar'.
  --
  -- See `STM.TVar'.
  type TVar m  :: Type -> Type

  newTVar      :: a -> STM m (TVar m a)
  readTVar     :: TVar m a -> STM m a
  writeTVar    :: TVar m a -> a -> STM m ()
  -- | See `STM.retry`.
  retry        :: STM m a
  -- | See `STM.orElse`.
  orElse       :: STM m a -> STM m a -> STM m a

  modifyTVar   :: TVar m a -> (a -> a) -> STM m ()
  modifyTVar  TVar m a
v a -> a
f = forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m a
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m a
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f

  modifyTVar'  :: TVar m a -> (a -> a) -> STM m ()
  modifyTVar' TVar m a
v a -> a
f = forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m a
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m a
v forall a b. (a -> b) -> a -> b
$! a -> a
f a
x

  -- | @since io-classes-0.2.0.0
  stateTVar    :: TVar m s -> (s -> (a, s)) -> STM m a
  stateTVar    = forall (m :: * -> *) s a.
MonadSTM m =>
TVar m s -> (s -> (a, s)) -> STM m a
stateTVarDefault

  swapTVar     :: TVar m a -> a -> STM m a
  swapTVar     = forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m a
swapTVarDefault

  -- | See `STM.check`.
  check        :: Bool -> STM m ()
  check Bool
True = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  check Bool
_    = forall (m :: * -> *) a. MonadSTM m => STM m a
retry

  -- Additional derived STM APIs
  type TMVar m    :: Type -> Type
  newTMVar        :: a -> STM m (TMVar m a)
  newEmptyTMVar   ::      STM m (TMVar m a)
  takeTMVar       :: TMVar m a      -> STM m a
  tryTakeTMVar    :: TMVar m a      -> STM m (Maybe a)
  putTMVar        :: TMVar m a -> a -> STM m ()
  tryPutTMVar     :: TMVar m a -> a -> STM m Bool
  readTMVar       :: TMVar m a      -> STM m a
  tryReadTMVar    :: TMVar m a      -> STM m (Maybe a)
  swapTMVar       :: TMVar m a -> a -> STM m a
  isEmptyTMVar    :: TMVar m a      -> STM m Bool

  type TQueue m  :: Type -> Type
  newTQueue      :: STM m (TQueue m a)
  readTQueue     :: TQueue m a -> STM m a
  tryReadTQueue  :: TQueue m a -> STM m (Maybe a)
  peekTQueue     :: TQueue m a -> STM m a
  tryPeekTQueue  :: TQueue m a -> STM m (Maybe a)
  flushTQueue    :: TQueue m a -> STM m [a]
  writeTQueue    :: TQueue m a -> a -> STM m ()
  isEmptyTQueue  :: TQueue m a -> STM m Bool
  unGetTQueue    :: TQueue m a -> a -> STM m ()

  type TBQueue m ::  Type -> Type
  newTBQueue     :: Natural -> STM m (TBQueue m a)
  readTBQueue    :: TBQueue m a -> STM m a
  tryReadTBQueue :: TBQueue m a -> STM m (Maybe a)
  peekTBQueue    :: TBQueue m a -> STM m a
  tryPeekTBQueue :: TBQueue m a -> STM m (Maybe a)
  flushTBQueue   :: TBQueue m a -> STM m [a]
  writeTBQueue   :: TBQueue m a -> a -> STM m ()
  -- | @since 0.2.0.0
  lengthTBQueue  :: TBQueue m a -> STM m Natural
  isEmptyTBQueue :: TBQueue m a -> STM m Bool
  isFullTBQueue  :: TBQueue m a -> STM m Bool
  unGetTBQueue   :: TBQueue m a -> a -> STM m ()

  type TArray m  :: Type -> Type -> Type

  type TSem m :: Type
  newTSem     :: Integer -> STM m (TSem m)
  waitTSem    :: TSem m -> STM m ()
  signalTSem  :: TSem m -> STM m ()
  signalTSemN :: Natural -> TSem m -> STM m ()

  type TChan m      :: Type -> Type
  newTChan          :: STM m (TChan m a)
  newBroadcastTChan :: STM m (TChan m a)
  dupTChan          :: TChan m a -> STM m (TChan m a)
  cloneTChan        :: TChan m a -> STM m (TChan m a)
  readTChan         :: TChan m a -> STM m a
  tryReadTChan      :: TChan m a -> STM m (Maybe a)
  peekTChan         :: TChan m a -> STM m a
  tryPeekTChan      :: TChan m a -> STM m (Maybe a)
  writeTChan        :: TChan m a -> a -> STM m ()
  unGetTChan        :: TChan m a -> a -> STM m ()
  isEmptyTChan      :: TChan m a -> STM m Bool


  -- Helpful derived functions with default implementations

  newTVarIO           :: a -> m (TVar  m a)
  readTVarIO          :: TVar m a -> m a
  newTMVarIO          :: a -> m (TMVar m a)
  newEmptyTMVarIO     ::      m (TMVar m a)
  newTQueueIO         :: m (TQueue m a)
  newTBQueueIO        :: Natural -> m (TBQueue m a)
  newTChanIO          :: m (TChan m a)
  newBroadcastTChanIO :: m (TChan m a)

  --
  -- default implementations
  --

  newTVarIO           = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar
  readTVarIO          = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar
  newTMVarIO          = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadSTM m => a -> STM m (TMVar m a)
newTMVar
  newEmptyTMVarIO     = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   forall (m :: * -> *) a. MonadSTM m => STM m (TMVar m a)
newEmptyTMVar
  newTQueueIO         = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  newTBQueueIO        = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadSTM m =>
Natural -> STM m (TBQueue m a)
newTBQueue
  newTChanIO          = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a)
newTChan
  newBroadcastTChanIO = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a)
newBroadcastTChan



stateTVarDefault :: MonadSTM m => TVar m s -> (s -> (a, s)) -> STM m a
stateTVarDefault :: forall (m :: * -> *) s a.
MonadSTM m =>
TVar m s -> (s -> (a, s)) -> STM m a
stateTVarDefault TVar m s
var s -> (a, s)
f = do
   s
s <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m s
var
   let (a
a, s
s') = s -> (a, s)
f s
s
   forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m s
var s
s'
   forall (m :: * -> *) a. Monad m => a -> m a
return a
a

swapTVarDefault :: MonadSTM m => TVar m a -> a -> STM m a
swapTVarDefault :: forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m a
swapTVarDefault TVar m a
var a
new = do
    a
old <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m a
var
    forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m a
var a
new
    forall (m :: * -> *) a. Monad m => a -> m a
return a
old


-- | Labelled `TVar`s & friends.
--
-- The `IO` instances is no-op, the `IOSim` instance enhances simulation trace.
-- This is very useful when analysing low lever concurrency issues (e.g.
-- deadlocks, livelocks etc).
--
class MonadSTM m
   => MonadLabelledSTM m where
  -- | Name a `TVar`.
  labelTVar    :: TVar    m a   -> String -> STM m ()
  labelTMVar   :: TMVar   m a   -> String -> STM m ()
  labelTQueue  :: TQueue  m a   -> String -> STM m ()
  labelTBQueue :: TBQueue m a   -> String -> STM m ()
  labelTArray  :: (Ix i, Show i)
               => TArray  m i e -> String -> STM m ()
  labelTSem    :: TSem    m     -> String -> STM m ()
  labelTChan   :: TChan   m a   -> String -> STM m ()

  labelTVarIO    :: TVar    m a   -> String -> m ()
  labelTMVarIO   :: TMVar   m a   -> String -> m ()
  labelTQueueIO  :: TQueue  m a   -> String -> m ()
  labelTBQueueIO :: TBQueue m a   -> String -> m ()
  labelTArrayIO  :: (Ix i, Show i)
                 => TArray  m i e -> String -> m ()
  labelTSemIO    :: TSem    m     -> String -> m ()
  labelTChanIO   :: TChan   m a   -> String -> m ()

  --
  -- default implementations
  --

  default labelTMVar :: TMVar m ~ TMVarDefault m
                     => TMVar m a -> String -> STM m ()
  labelTMVar = forall (m :: * -> *) a.
MonadLabelledSTM m =>
TMVarDefault m a -> String -> STM m ()
labelTMVarDefault

  default labelTQueue :: TQueue m ~ TQueueDefault m
                      => TQueue m a -> String -> STM m ()
  labelTQueue = forall (m :: * -> *) a.
MonadLabelledSTM m =>
TQueueDefault m a -> String -> STM m ()
labelTQueueDefault

  default labelTBQueue :: TBQueue m ~ TBQueueDefault m
                       => TBQueue m a -> String -> STM m ()
  labelTBQueue = forall (m :: * -> *) a.
MonadLabelledSTM m =>
TBQueueDefault m a -> String -> STM m ()
labelTBQueueDefault

  default labelTSem :: TSem m ~ TSemDefault m
                    => TSem m -> String -> STM m ()
  labelTSem = forall (m :: * -> *).
MonadLabelledSTM m =>
TSemDefault m -> String -> STM m ()
labelTSemDefault

  default labelTChan :: TChan m ~ TChanDefault m
                     => TChan m a -> String -> STM m ()
  labelTChan = forall (m :: * -> *) a.
MonadLabelledSTM m =>
TChanDefault m a -> String -> STM m ()
labelTChanDefault

  default labelTArray :: ( TArray m ~ TArrayDefault m
                         , Ix i
                         , Show i
                         )
                      => TArray m i e -> String -> STM m ()
  labelTArray = forall (m :: * -> *) i e.
(MonadLabelledSTM m, Ix i, Show i) =>
TArrayDefault m i e -> String -> STM m ()
labelTArrayDefault

  default labelTVarIO :: TVar m a -> String -> m ()
  labelTVarIO = \TVar m a
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m a
v String
l)

  default labelTMVarIO :: TMVar m a -> String -> m ()
  labelTMVarIO = \TMVar m a
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a.
MonadLabelledSTM m =>
TMVar m a -> String -> STM m ()
labelTMVar TMVar m a
v String
l)

  default labelTQueueIO :: TQueue m a -> String -> m ()
  labelTQueueIO = \TQueue m a
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a.
MonadLabelledSTM m =>
TQueue m a -> String -> STM m ()
labelTQueue TQueue m a
v String
l)

  default labelTBQueueIO :: TBQueue m a -> String -> m ()
  labelTBQueueIO = \TBQueue m a
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a.
MonadLabelledSTM m =>
TBQueue m a -> String -> STM m ()
labelTBQueue TBQueue m a
v String
l)

  default labelTArrayIO :: (Ix i, Show i)
                        => TArray m i e -> String -> m ()
  labelTArrayIO = \TArray m i e
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) i e.
(MonadLabelledSTM m, Ix i, Show i) =>
TArray m i e -> String -> STM m ()
labelTArray TArray m i e
v String
l)

  default labelTSemIO :: TSem m -> String -> m ()
  labelTSemIO = \TSem m
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *).
MonadLabelledSTM m =>
TSem m -> String -> STM m ()
labelTSem TSem m
v String
l)

  default labelTChanIO :: TChan m a -> String -> m ()
  labelTChanIO = \TChan m a
v String
l -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a.
MonadLabelledSTM m =>
TChan m a -> String -> STM m ()
labelTChan TChan m a
v String
l)


-- | This type class is indented for
-- ['io-sim'](https://hackage.haskell.org/package/io-sim), where one might want
-- to access a 'TVar' in the underlying 'ST' monad.
--
class ( MonadSTM m
      , Monad (InspectMonad m)
      )
    => MonadInspectSTM m where
    type InspectMonad m :: Type -> Type
    -- | Return the value of a `TVar` as an `InspectMonad` computation.
    --
    -- `inspectTVar` is useful if the value of a `TVar` observed by `traceTVar`
    -- contains other `TVar`s.
    inspectTVar  :: proxy m -> TVar  m a -> InspectMonad m a
    -- | Return the value of a `TMVar` as an `InspectMonad` computation.
    inspectTMVar :: proxy m -> TMVar m a -> InspectMonad m (Maybe a)
    -- TODO: inspectTQueue, inspectTBQueue

instance MonadInspectSTM IO where
    type InspectMonad IO = IO
    inspectTVar :: forall (proxy :: (* -> *) -> *) a.
proxy IO -> TVar IO a -> InspectMonad IO a
inspectTVar  proxy IO
_ = forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO
    -- issue #3198: tryReadTMVarIO
    inspectTMVar :: forall (proxy :: (* -> *) -> *) a.
proxy IO -> TMVar IO a -> InspectMonad IO (Maybe a)
inspectTMVar proxy IO
_ = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
tryReadTMVar


-- | A GADT which instructs how to trace the value.  The 'traceDynamic' will
-- use dynamic tracing, e.g. "Control.Monad.IOSim.traceM"; while 'traceString'
-- will be traced with 'EventSay'.  The `IOSim`s dynamic tracing allows to
-- recover the value from the simulation trace (see
-- "Control.Monad.IOSim.selectTraceEventsDynamic").
--
data TraceValue where
    TraceValue :: forall tr. Typeable tr
               => { ()
traceDynamic :: Maybe tr
                  , TraceValue -> Maybe String
traceString  :: Maybe String
                  }
               -> TraceValue


-- | Use only a dynamic tracer.
--
pattern TraceDynamic :: () => forall tr. Typeable tr => tr -> TraceValue
pattern $bTraceDynamic :: forall tr. Typeable tr => tr -> TraceValue
$mTraceDynamic :: forall {r}.
TraceValue
-> (forall {tr}. Typeable tr => tr -> r) -> ((# #) -> r) -> r
TraceDynamic tr <- TraceValue { traceDynamic = Just tr }
  where
    TraceDynamic tr
tr = TraceValue { traceDynamic :: Maybe tr
traceDynamic = forall a. a -> Maybe a
Just tr
tr, traceString :: Maybe String
traceString = forall a. Maybe a
Nothing }

-- | Use only string tracing.
--
pattern TraceString :: String -> TraceValue
pattern $bTraceString :: String -> TraceValue
$mTraceString :: forall {r}. TraceValue -> (String -> r) -> ((# #) -> r) -> r
TraceString tr <- TraceValue { traceString = Just tr }
  where
    TraceString String
tr = TraceValue { traceDynamic :: Maybe ()
traceDynamic = (forall a. Maybe a
Nothing :: Maybe ())
                                , traceString :: Maybe String
traceString  = forall a. a -> Maybe a
Just String
tr
                                }

-- | Do not trace the value.
--
pattern DontTrace :: TraceValue
pattern $bDontTrace :: TraceValue
$mDontTrace :: forall {r}. TraceValue -> ((# #) -> r) -> ((# #) -> r) -> r
DontTrace <- TraceValue Nothing Nothing
  where
    DontTrace = forall tr. Typeable tr => Maybe tr -> Maybe String -> TraceValue
TraceValue (forall a. Maybe a
Nothing :: Maybe ()) forall a. Maybe a
Nothing

-- | 'MonadTraceSTM' allows to trace values of stm variables when stm
-- transaction is committed.  This allows to verify invariants when a variable
-- is committed.
--
class MonadInspectSTM m
   => MonadTraceSTM m where
  {-# MINIMAL traceTVar, traceTQueue, traceTBQueue #-}

  -- | Construct a trace output out of previous & new value of a 'TVar'.  The
  -- callback is called whenever an stm transaction which modifies the 'TVar' is
  -- committed.
  --
  -- This is supported by 'IOSim' (and 'IOSimPOR'); 'IO' has a trivial instance.
  --
  -- The simplest example is:
  -- 
  -- >
  -- > traceTVar (Proxy @m) tvar (\_ -> TraceString . show)
  -- >
  --
  -- Note that the interpretation of `TraceValue` depends on the monad `m`
  -- itself (see 'TraceValue').
  --
  traceTVar    :: proxy m
               -> TVar m a
               -> (Maybe a -> a -> InspectMonad m TraceValue)
               -- ^ callback which receives initial value or 'Nothing' (if it
               -- is a newly created 'TVar'), and the committed value.
               -> STM m ()


  traceTMVar   :: proxy m
               -> TMVar m a
               -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)
               -> STM m ()

  traceTQueue  :: proxy m
               -> TQueue m a
               -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
               -> STM m ()

  traceTBQueue :: proxy m
               -> TBQueue m a
               -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
               -> STM m ()

  traceTSem    :: proxy m
               -> TSem m
               -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
               -> STM m ()

  default traceTMVar :: TMVar m a ~ TMVarDefault m a
                     => proxy m
                     -> TMVar m a
                     -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)
                     -> STM m ()
  traceTMVar = forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVarDefault m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVarDefault

  default traceTSem :: TSem m ~ TSemDefault m
                    => proxy m
                    -> TSem m
                    -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
                    -> STM m ()
  traceTSem = forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadTraceSTM m =>
proxy m
-> TSemDefault m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
traceTSemDefault


  traceTVarIO    :: TVar m a
                 -> (Maybe a -> a -> InspectMonad m TraceValue)
                 -> m ()

  traceTMVarIO   :: TMVar m a
                 -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)
                 -> m ()

  traceTQueueIO  :: TQueue m a
                 -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
                 -> m ()

  traceTBQueueIO :: TBQueue m a
                 -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
                 -> m ()

  traceTSemIO    :: TSem m
                 -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
                 -> m ()

  default traceTVarIO :: TVar m a
                      -> (Maybe a -> a -> InspectMonad m TraceValue)
                      -> m ()
  traceTVarIO = \TVar m a
v Maybe a -> a -> InspectMonad m TraceValue
f -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar forall {k} (t :: k). Proxy t
Proxy TVar m a
v Maybe a -> a -> InspectMonad m TraceValue
f)

  default traceTMVarIO :: TMVar m a
                       -> (Maybe (Maybe a) -> (Maybe a) -> InspectMonad m TraceValue)
                       -> m ()
  traceTMVarIO = \TMVar m a
v Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue
f -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVar forall {k} (t :: k). Proxy t
Proxy TMVar m a
v Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue
f)

  default traceTQueueIO :: TQueue m a
                        -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
                        -> m ()
  traceTQueueIO = \TQueue m a
v Maybe [a] -> [a] -> InspectMonad m TraceValue
f -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTQueue forall {k} (t :: k). Proxy t
Proxy TQueue m a
v Maybe [a] -> [a] -> InspectMonad m TraceValue
f)

  default traceTBQueueIO :: TBQueue m a
                         -> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
                         -> m ()
  traceTBQueueIO = \TBQueue m a
v Maybe [a] -> [a] -> InspectMonad m TraceValue
f -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTBQueue forall {k} (t :: k). Proxy t
Proxy TBQueue m a
v Maybe [a] -> [a] -> InspectMonad m TraceValue
f)

  default traceTSemIO :: TSem m
                      -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
                      -> m ()
  traceTSemIO = \TSem m
v Maybe Integer -> Integer -> InspectMonad m TraceValue
f -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadTraceSTM m =>
proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
traceTSem forall {k} (t :: k). Proxy t
Proxy TSem m
v Maybe Integer -> Integer -> InspectMonad m TraceValue
f)


--
-- Instance for IO uses the existing STM library implementations
--

instance MonadSTM IO where
  type STM IO = STM.STM

  atomically :: forall a. HasCallStack => STM IO a -> IO a
atomically = forall a. HasCallStack => IO a -> IO a
wrapBlockedIndefinitely forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
STM.atomically

  type TVar    IO = STM.TVar
  type TMVar   IO = STM.TMVar
  type TQueue  IO = STM.TQueue
  type TBQueue IO = STM.TBQueue
  type TArray  IO = STM.TArray
  type TSem    IO = STM.TSem
  type TChan   IO = STM.TChan

  newTVar :: forall a. a -> STM IO (TVar IO a)
newTVar        = forall a. a -> STM (TVar a)
STM.newTVar
  readTVar :: forall a. TVar IO a -> STM IO a
readTVar       = forall a. TVar a -> STM a
STM.readTVar
  writeTVar :: forall a. TVar IO a -> a -> STM IO ()
writeTVar      = forall a. TVar a -> a -> STM ()
STM.writeTVar
  retry :: forall a. STM IO a
retry          = forall a. STM a
STM.retry
  orElse :: forall a. STM IO a -> STM IO a -> STM IO a
orElse         = forall a. STM a -> STM a -> STM a
STM.orElse
  modifyTVar :: forall a. TVar IO a -> (a -> a) -> STM IO ()
modifyTVar     = forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar
  modifyTVar' :: forall a. TVar IO a -> (a -> a) -> STM IO ()
modifyTVar'    = forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar'
  stateTVar :: forall s a. TVar IO s -> (s -> (a, s)) -> STM IO a
stateTVar      = forall s a. TVar s -> (s -> (a, s)) -> STM a
STM.stateTVar
  swapTVar :: forall a. TVar IO a -> a -> STM IO a
swapTVar       = forall a. TVar a -> a -> STM a
STM.swapTVar
  check :: Bool -> STM IO ()
check          = Bool -> STM ()
STM.check
  newTMVar :: forall a. a -> STM IO (TMVar IO a)
newTMVar       = forall a. a -> STM (TMVar a)
STM.newTMVar
  newEmptyTMVar :: forall a. STM IO (TMVar IO a)
newEmptyTMVar  = forall a. STM (TMVar a)
STM.newEmptyTMVar
  takeTMVar :: forall a. TMVar IO a -> STM IO a
takeTMVar      = forall a. TMVar a -> STM a
STM.takeTMVar
  tryTakeTMVar :: forall a. TMVar IO a -> STM IO (Maybe a)
tryTakeTMVar   = forall a. TMVar a -> STM (Maybe a)
STM.tryTakeTMVar
  putTMVar :: forall a. TMVar IO a -> a -> STM IO ()
putTMVar       = forall a. TMVar a -> a -> STM ()
STM.putTMVar
  tryPutTMVar :: forall a. TMVar IO a -> a -> STM IO Bool
tryPutTMVar    = forall a. TMVar a -> a -> STM Bool
STM.tryPutTMVar
  readTMVar :: forall a. TMVar IO a -> STM IO a
readTMVar      = forall a. TMVar a -> STM a
STM.readTMVar
  tryReadTMVar :: forall a. TMVar IO a -> STM IO (Maybe a)
tryReadTMVar   = forall a. TMVar a -> STM (Maybe a)
STM.tryReadTMVar
  swapTMVar :: forall a. TMVar IO a -> a -> STM IO a
swapTMVar      = forall a. TMVar a -> a -> STM a
STM.swapTMVar
  isEmptyTMVar :: forall a. TMVar IO a -> STM IO Bool
isEmptyTMVar   = forall a. TMVar a -> STM Bool
STM.isEmptyTMVar
  newTQueue :: forall a. STM IO (TQueue IO a)
newTQueue      = forall a. STM (TQueue a)
STM.newTQueue
  readTQueue :: forall a. TQueue IO a -> STM IO a
readTQueue     = forall a. TQueue a -> STM a
STM.readTQueue
  tryReadTQueue :: forall a. TQueue IO a -> STM IO (Maybe a)
tryReadTQueue  = forall a. TQueue a -> STM (Maybe a)
STM.tryReadTQueue
  peekTQueue :: forall a. TQueue IO a -> STM IO a
peekTQueue     = forall a. TQueue a -> STM a
STM.peekTQueue
  tryPeekTQueue :: forall a. TQueue IO a -> STM IO (Maybe a)
tryPeekTQueue  = forall a. TQueue a -> STM (Maybe a)
STM.tryPeekTQueue
  flushTQueue :: forall a. TQueue IO a -> STM IO [a]
flushTQueue    = forall a. TQueue a -> STM [a]
STM.flushTQueue
  writeTQueue :: forall a. TQueue IO a -> a -> STM IO ()
writeTQueue    = forall a. TQueue a -> a -> STM ()
STM.writeTQueue
  isEmptyTQueue :: forall a. TQueue IO a -> STM IO Bool
isEmptyTQueue  = forall a. TQueue a -> STM Bool
STM.isEmptyTQueue
  unGetTQueue :: forall a. TQueue IO a -> a -> STM IO ()
unGetTQueue    = forall a. TQueue a -> a -> STM ()
STM.unGetTQueue
  newTBQueue :: forall a. Natural -> STM IO (TBQueue IO a)
newTBQueue     = forall a. Natural -> STM (TBQueue a)
STM.newTBQueue
  readTBQueue :: forall a. TBQueue IO a -> STM IO a
readTBQueue    = forall a. TBQueue a -> STM a
STM.readTBQueue
  tryReadTBQueue :: forall a. TBQueue IO a -> STM IO (Maybe a)
tryReadTBQueue = forall a. TBQueue a -> STM (Maybe a)
STM.tryReadTBQueue
  peekTBQueue :: forall a. TBQueue IO a -> STM IO a
peekTBQueue    = forall a. TBQueue a -> STM a
STM.peekTBQueue
  tryPeekTBQueue :: forall a. TBQueue IO a -> STM IO (Maybe a)
tryPeekTBQueue = forall a. TBQueue a -> STM (Maybe a)
STM.tryPeekTBQueue
  writeTBQueue :: forall a. TBQueue IO a -> a -> STM IO ()
writeTBQueue   = forall a. TBQueue a -> a -> STM ()
STM.writeTBQueue
  flushTBQueue :: forall a. TBQueue IO a -> STM IO [a]
flushTBQueue   = forall a. TBQueue a -> STM [a]
STM.flushTBQueue
  lengthTBQueue :: forall a. TBQueue IO a -> STM IO Natural
lengthTBQueue  = forall a. TBQueue a -> STM Natural
STM.lengthTBQueue
  isEmptyTBQueue :: forall a. TBQueue IO a -> STM IO Bool
isEmptyTBQueue = forall a. TBQueue a -> STM Bool
STM.isEmptyTBQueue
  isFullTBQueue :: forall a. TBQueue IO a -> STM IO Bool
isFullTBQueue  = forall a. TBQueue a -> STM Bool
STM.isFullTBQueue
  unGetTBQueue :: forall a. TBQueue IO a -> a -> STM IO ()
unGetTBQueue   = forall a. TBQueue a -> a -> STM ()
STM.unGetTBQueue
  newTSem :: Integer -> STM IO (TSem IO)
newTSem        = Integer -> STM TSem
STM.newTSem
  waitTSem :: TSem IO -> STM IO ()
waitTSem       = TSem -> STM ()
STM.waitTSem
  signalTSem :: TSem IO -> STM IO ()
signalTSem     = TSem -> STM ()
STM.signalTSem
  signalTSemN :: Natural -> TSem IO -> STM IO ()
signalTSemN    = Natural -> TSem -> STM ()
STM.signalTSemN

  newTChan :: forall a. STM IO (TChan IO a)
newTChan          = forall a. STM (TChan a)
STM.newTChan
  newBroadcastTChan :: forall a. STM IO (TChan IO a)
newBroadcastTChan = forall a. STM (TChan a)
STM.newBroadcastTChan
  dupTChan :: forall a. TChan IO a -> STM IO (TChan IO a)
dupTChan          = forall a. TChan a -> STM (TChan a)
STM.dupTChan
  cloneTChan :: forall a. TChan IO a -> STM IO (TChan IO a)
cloneTChan        = forall a. TChan a -> STM (TChan a)
STM.cloneTChan
  readTChan :: forall a. TChan IO a -> STM IO a
readTChan         = forall a. TChan a -> STM a
STM.readTChan
  tryReadTChan :: forall a. TChan IO a -> STM IO (Maybe a)
tryReadTChan      = forall a. TChan a -> STM (Maybe a)
STM.tryReadTChan
  peekTChan :: forall a. TChan IO a -> STM IO a
peekTChan         = forall a. TChan a -> STM a
STM.peekTChan
  tryPeekTChan :: forall a. TChan IO a -> STM IO (Maybe a)
tryPeekTChan      = forall a. TChan a -> STM (Maybe a)
STM.tryPeekTChan
  writeTChan :: forall a. TChan IO a -> a -> STM IO ()
writeTChan        = forall a. TChan a -> a -> STM ()
STM.writeTChan
  unGetTChan :: forall a. TChan IO a -> a -> STM IO ()
unGetTChan        = forall a. TChan a -> a -> STM ()
STM.unGetTChan
  isEmptyTChan :: forall a. TChan IO a -> STM IO Bool
isEmptyTChan      = forall a. TChan a -> STM Bool
STM.isEmptyTChan

  newTVarIO :: forall a. a -> IO (TVar IO a)
newTVarIO           = forall a. a -> IO (TVar a)
STM.newTVarIO
  readTVarIO :: forall a. TVar IO a -> IO a
readTVarIO          = forall a. TVar a -> IO a
STM.readTVarIO
  newTMVarIO :: forall a. a -> IO (TMVar IO a)
newTMVarIO          = forall a. a -> IO (TMVar a)
STM.newTMVarIO
  newEmptyTMVarIO :: forall a. IO (TMVar IO a)
newEmptyTMVarIO     = forall a. IO (TMVar a)
STM.newEmptyTMVarIO
  newTQueueIO :: forall a. IO (TQueue IO a)
newTQueueIO         = forall a. IO (TQueue a)
STM.newTQueueIO
  newTBQueueIO :: forall a. Natural -> IO (TBQueue IO a)
newTBQueueIO        = forall a. Natural -> IO (TBQueue a)
STM.newTBQueueIO
  newTChanIO :: forall a. IO (TChan IO a)
newTChanIO          = forall a. IO (TChan a)
STM.newTChanIO
  newBroadcastTChanIO :: forall a. IO (TChan IO a)
newBroadcastTChanIO = forall a. IO (TChan a)
STM.newBroadcastTChanIO

-- | noop instance
--
instance MonadLabelledSTM IO where
  labelTVar :: forall a. TVar IO a -> String -> STM IO ()
labelTVar    = \TVar IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTMVar :: forall a. TMVar IO a -> String -> STM IO ()
labelTMVar   = \TMVar IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTQueue :: forall a. TQueue IO a -> String -> STM IO ()
labelTQueue  = \TQueue IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTBQueue :: forall a. TBQueue IO a -> String -> STM IO ()
labelTBQueue = \TBQueue IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTArray :: forall i e. (Ix i, Show i) => TArray IO i e -> String -> STM IO ()
labelTArray  = \TArray IO i e
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTSem :: TSem IO -> String -> STM IO ()
labelTSem    = \TSem IO
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTChan :: forall a. TChan IO a -> String -> STM IO ()
labelTChan   = \TChan IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  labelTVarIO :: forall a. TVar IO a -> String -> IO ()
labelTVarIO    = \TVar IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTMVarIO :: forall a. TMVar IO a -> String -> IO ()
labelTMVarIO   = \TMVar IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTQueueIO :: forall a. TQueue IO a -> String -> IO ()
labelTQueueIO  = \TQueue IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTBQueueIO :: forall a. TBQueue IO a -> String -> IO ()
labelTBQueueIO = \TBQueue IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTArrayIO :: forall i e. (Ix i, Show i) => TArray IO i e -> String -> IO ()
labelTArrayIO  = \TArray IO i e
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTSemIO :: TSem IO -> String -> IO ()
labelTSemIO    = \TSem IO
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTChanIO :: forall a. TChan IO a -> String -> IO ()
labelTChanIO   = \TChan IO a
_  String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | noop instance
--
instance MonadTraceSTM IO where
  traceTVar :: forall (proxy :: (* -> *) -> *) a.
proxy IO
-> TVar IO a
-> (Maybe a -> a -> InspectMonad IO TraceValue)
-> STM IO ()
traceTVar    = \proxy IO
_ TVar IO a
_ Maybe a -> a -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTMVar :: forall (proxy :: (* -> *) -> *) a.
proxy IO
-> TMVar IO a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad IO TraceValue)
-> STM IO ()
traceTMVar   = \proxy IO
_ TMVar IO a
_ Maybe (Maybe a) -> Maybe a -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTQueue :: forall (proxy :: (* -> *) -> *) a.
proxy IO
-> TQueue IO a
-> (Maybe [a] -> [a] -> InspectMonad IO TraceValue)
-> STM IO ()
traceTQueue  = \proxy IO
_ TQueue IO a
_ Maybe [a] -> [a] -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTBQueue :: forall (proxy :: (* -> *) -> *) a.
proxy IO
-> TBQueue IO a
-> (Maybe [a] -> [a] -> InspectMonad IO TraceValue)
-> STM IO ()
traceTBQueue = \proxy IO
_ TBQueue IO a
_ Maybe [a] -> [a] -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTSem :: forall (proxy :: (* -> *) -> *).
proxy IO
-> TSem IO
-> (Maybe Integer -> Integer -> InspectMonad IO TraceValue)
-> STM IO ()
traceTSem    = \proxy IO
_ TSem IO
_ Maybe Integer -> Integer -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  traceTVarIO :: forall a.
TVar IO a -> (Maybe a -> a -> InspectMonad IO TraceValue) -> IO ()
traceTVarIO    = \TVar IO a
_ Maybe a -> a -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTMVarIO :: forall a.
TMVar IO a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad IO TraceValue)
-> IO ()
traceTMVarIO   = \TMVar IO a
_ Maybe (Maybe a) -> Maybe a -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTQueueIO :: forall a.
TQueue IO a
-> (Maybe [a] -> [a] -> InspectMonad IO TraceValue) -> IO ()
traceTQueueIO  = \TQueue IO a
_ Maybe [a] -> [a] -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTBQueueIO :: forall a.
TBQueue IO a
-> (Maybe [a] -> [a] -> InspectMonad IO TraceValue) -> IO ()
traceTBQueueIO = \TBQueue IO a
_ Maybe [a] -> [a] -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  traceTSemIO :: TSem IO
-> (Maybe Integer -> Integer -> InspectMonad IO TraceValue)
-> IO ()
traceTSemIO    = \TSem IO
_ Maybe Integer -> Integer -> InspectMonad IO TraceValue
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Wrapper around 'BlockedIndefinitelyOnSTM' that stores a call stack
data BlockedIndefinitely = BlockedIndefinitely {
      BlockedIndefinitely -> CallStack
blockedIndefinitelyCallStack :: CallStack
    , BlockedIndefinitely -> BlockedIndefinitelyOnSTM
blockedIndefinitelyException :: BlockedIndefinitelyOnSTM
    }
  deriving Int -> BlockedIndefinitely -> ShowS
[BlockedIndefinitely] -> ShowS
BlockedIndefinitely -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockedIndefinitely] -> ShowS
$cshowList :: [BlockedIndefinitely] -> ShowS
show :: BlockedIndefinitely -> String
$cshow :: BlockedIndefinitely -> String
showsPrec :: Int -> BlockedIndefinitely -> ShowS
$cshowsPrec :: Int -> BlockedIndefinitely -> ShowS
Show

instance Exception BlockedIndefinitely where
  displayException :: BlockedIndefinitely -> String
displayException (BlockedIndefinitely CallStack
cs BlockedIndefinitelyOnSTM
e) = [String] -> String
unlines [
        forall e. Exception e => e -> String
displayException BlockedIndefinitelyOnSTM
e
      , CallStack -> String
prettyCallStack CallStack
cs
      ]

wrapBlockedIndefinitely :: HasCallStack => IO a -> IO a
wrapBlockedIndefinitely :: forall a. HasCallStack => IO a -> IO a
wrapBlockedIndefinitely = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> BlockedIndefinitelyOnSTM -> BlockedIndefinitely
BlockedIndefinitely HasCallStack => CallStack
callStack)

--
-- Default TMVar implementation in terms of TVars
--

newtype TMVarDefault m a = TMVar (TVar m (Maybe a))

labelTMVarDefault
  :: MonadLabelledSTM m
  => TMVarDefault m a -> String -> STM m ()
labelTMVarDefault :: forall (m :: * -> *) a.
MonadLabelledSTM m =>
TMVarDefault m a -> String -> STM m ()
labelTMVarDefault (TMVar TVar m (Maybe a)
tvar) = forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m (Maybe a)
tvar

traceTMVarDefault
  :: MonadTraceSTM m
  => proxy m
  -> TMVarDefault m a
  -> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
  -> STM m ()
traceTMVarDefault :: forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVarDefault m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVarDefault proxy m
p (TMVar TVar m (Maybe a)
t) Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue
f = forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar proxy m
p TVar m (Maybe a)
t Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue
f

newTMVarDefault :: MonadSTM m => a -> STM m (TMVarDefault m a)
newTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => a -> STM m (TMVarDefault m a)
newTMVarDefault a
a = do
  TVar m (Maybe a)
t <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (forall a. a -> Maybe a
Just a
a)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar m (Maybe a)
t)

newEmptyTMVarDefault :: MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault = do
  TVar m (Maybe a)
t <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar m (Maybe a)
t)

takeTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m a
takeTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => TMVarDefault m a -> STM m a
takeTMVarDefault (TMVar TVar m (Maybe a)
t) = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    Just a
a  -> do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t forall a. Maybe a
Nothing; forall (m :: * -> *) a. Monad m => a -> m a
return a
a

tryTakeTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m (Maybe a)
tryTakeTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> STM m (Maybe a)
tryTakeTMVarDefault (TMVar TVar m (Maybe a)
t) = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Just a
a  -> do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t forall a. Maybe a
Nothing; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)

putTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m ()
putTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> a -> STM m ()
putTMVarDefault (TMVar TVar m (Maybe a)
t) a
a = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing -> do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (forall a. a -> Maybe a
Just a
a); forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just a
_  -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry

tryPutTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m Bool
tryPutTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> a -> STM m Bool
tryPutTMVarDefault (TMVar TVar m (Maybe a)
t) a
a = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing -> do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (forall a. a -> Maybe a
Just a
a); forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just a
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

readTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m a
readTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => TMVarDefault m a -> STM m a
readTMVarDefault (TMVar TVar m (Maybe a)
t) = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    Just a
a  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

tryReadTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m (Maybe a)
tryReadTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> STM m (Maybe a)
tryReadTMVarDefault (TMVar TVar m (Maybe a)
t) = forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t

swapTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m a
swapTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> a -> STM m a
swapTMVarDefault (TMVar TVar m (Maybe a)
t) a
new = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing  -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    Just a
old -> do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (forall a. a -> Maybe a
Just a
new); forall (m :: * -> *) a. Monad m => a -> m a
return a
old

isEmptyTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m Bool
isEmptyTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> STM m Bool
isEmptyTMVarDefault (TMVar TVar m (Maybe a)
t) = do
  Maybe a
m <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case Maybe a
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just a
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

--
-- Default TQueue implementation in terms of TVars (used by sim)
--

data TQueueDefault m a = TQueue !(TVar m [a])
                                !(TVar m [a])

labelTQueueDefault
  :: MonadLabelledSTM m
  => TQueueDefault m a -> String -> STM m ()
labelTQueueDefault :: forall (m :: * -> *) a.
MonadLabelledSTM m =>
TQueueDefault m a -> String -> STM m ()
labelTQueueDefault (TQueue TVar m [a]
read TVar m [a]
write) String
label = do
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
read (String
label forall a. [a] -> [a] -> [a]
++ String
"-read")
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
write (String
label forall a. [a] -> [a] -> [a]
++ String
"-write")

newTQueueDefault :: MonadSTM m => STM m (TQueueDefault m a)
newTQueueDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TQueueDefault m a)
newTQueueDefault = do
  TVar m [a]
read  <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar []
  TVar m [a]
write <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar []
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
TVar m [a] -> TVar m [a] -> TQueueDefault m a
TQueue TVar m [a]
read TVar m [a]
write)

writeTQueueDefault :: MonadSTM m => TQueueDefault m a -> a -> STM m ()
writeTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> a -> STM m ()
writeTQueueDefault (TQueue TVar m [a]
_read TVar m [a]
write) a
a = do
  [a]
listend <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write (a
aforall a. a -> [a] -> [a]
:[a]
listend)

readTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m a
readTQueueDefault :: forall (m :: * -> *) a. MonadSTM m => TQueueDefault m a -> STM m a
readTQueueDefault TQueueDefault m a
queue = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadSTM m => STM m a
retry forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault TQueueDefault m a
queue

tryReadTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault (TQueue TVar m [a]
read TVar m [a]
write) = do
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  case [a]
xs of
    (a
x:[a]
xs') -> do
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
xs'
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
    [] -> do
      [a]
ys <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
      case forall a. [a] -> [a]
reverse [a]
ys of
        []     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        (a
z:[a]
zs) -> do
          forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write []
          forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
zs
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
z)

isEmptyTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m Bool
isEmptyTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> STM m Bool
isEmptyTQueueDefault (TQueue TVar m [a]
read TVar m [a]
write) = do
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  case [a]
xs of
    (a
_:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    [] -> do [a]
ys <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
             case [a]
ys of
               [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               [a]
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

peekTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m a
peekTQueueDefault :: forall (m :: * -> *) a. MonadSTM m => TQueueDefault m a -> STM m a
peekTQueueDefault (TQueue TVar m [a]
read TVar m [a]
_write) = do
    [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case [a]
xs of
      (a
x:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      [a]
_     -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry

tryPeekTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m (Maybe a)
tryPeekTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> STM m (Maybe a)
tryPeekTQueueDefault (TQueue TVar m [a]
read TVar m [a]
_write) = do
    [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case [a]
xs of
      (a
x:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
      [a]
_     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


flushTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m [a]
flushTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> STM m [a]
flushTQueueDefault (TQueue TVar m [a]
read TVar m [a]
write) = do
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  [a]
ys <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read []
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write []
  forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
ys)

unGetTQueueDefault :: MonadSTM m => TQueueDefault m a -> a -> STM m ()
unGetTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> a -> STM m ()
unGetTQueueDefault (TQueue TVar m [a]
read TVar m [a]
_write) a
a = forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar TVar m [a]
read (a
aforall a. a -> [a] -> [a]
:)



--
-- Default TBQueue implementation in terms of TVars
--

data TBQueueDefault m a = TBQueue
  !(TVar m Natural) -- read capacity
  !(TVar m [a])     -- elements waiting for read
  !(TVar m Natural) -- write capacity
  !(TVar m [a])     -- written elements
  !Natural

labelTBQueueDefault
  :: MonadLabelledSTM m
  => TBQueueDefault m a -> String -> STM m ()
labelTBQueueDefault :: forall (m :: * -> *) a.
MonadLabelledSTM m =>
TBQueueDefault m a -> String -> STM m ()
labelTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
read TVar m Natural
wsize TVar m [a]
write Natural
_size) String
label = do
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m Natural
rsize (String
label forall a. [a] -> [a] -> [a]
++ String
"-rsize")
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
read (String
label forall a. [a] -> [a] -> [a]
++ String
"-read")
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m Natural
wsize (String
label forall a. [a] -> [a] -> [a]
++ String
"-wsize")
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
write (String
label forall a. [a] -> [a] -> [a]
++ String
"-write")

newTBQueueDefault :: MonadSTM m => Natural -> STM m (TBQueueDefault m a)
newTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
Natural -> STM m (TBQueueDefault m a)
newTBQueueDefault Natural
size = do
  TVar m Natural
rsize <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar Natural
0
  TVar m [a]
read  <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar []
  TVar m Natural
wsize <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar Natural
size
  TVar m [a]
write <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar []
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
TVar m Natural
-> TVar m [a]
-> TVar m Natural
-> TVar m [a]
-> Natural
-> TBQueueDefault m a
TBQueue TVar m Natural
rsize TVar m [a]
read TVar m Natural
wsize TVar m [a]
write Natural
size)

readTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m a
readTBQueueDefault :: forall (m :: * -> *) a. MonadSTM m => TBQueueDefault m a -> STM m a
readTBQueueDefault TBQueueDefault m a
queue = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadSTM m => STM m a
retry forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault TBQueueDefault m a
queue

tryReadTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
read TVar m Natural
_wsize TVar m [a]
write Natural
_size) = do
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  Natural
r <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
rsize forall a b. (a -> b) -> a -> b
$! Natural
r forall a. Num a => a -> a -> a
+ Natural
1
  case [a]
xs of
    (a
x:[a]
xs') -> do
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
xs'
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
    [] -> do
      [a]
ys <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
      case forall a. [a] -> [a]
reverse [a]
ys of
        [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

        -- NB. lazy: we want the transaction to be
        -- short, otherwise it will conflict
        (a
z:[a]
zs)  -> do
          forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write []
          forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
zs
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
z)

peekTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m a
peekTBQueueDefault :: forall (m :: * -> *) a. MonadSTM m => TBQueueDefault m a -> STM m a
peekTBQueueDefault (TBQueue TVar m Natural
_rsize TVar m [a]
read TVar m Natural
_wsize TVar m [a]
_write Natural
_size) = do
    [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case [a]
xs of
      (a
x:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      [a]
_     -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry

tryPeekTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m (Maybe a)
tryPeekTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m (Maybe a)
tryPeekTBQueueDefault (TBQueue TVar m Natural
_rsize TVar m [a]
read TVar m Natural
_wsize TVar m [a]
_write Natural
_size) = do
    [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case [a]
xs of
      (a
x:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
      [a]
_     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

writeTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> a -> STM m ()
writeTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> a -> STM m ()
writeTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
_read TVar m Natural
wsize TVar m [a]
write Natural
_size) a
a = do
  Natural
w <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
wsize
  if (Natural
w forall a. Ord a => a -> a -> Bool
> Natural
0)
    then do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
wsize forall a b. (a -> b) -> a -> b
$! Natural
w forall a. Num a => a -> a -> a
- Natural
1
    else do
          Natural
r <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
          if (Natural
r forall a. Ord a => a -> a -> Bool
> Natural
0)
            then do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
rsize Natural
0
                    forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
wsize forall a b. (a -> b) -> a -> b
$! Natural
r forall a. Num a => a -> a -> a
- Natural
1
            else forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  [a]
listend <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write (a
aforall a. a -> [a] -> [a]
:[a]
listend)

isEmptyTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault (TBQueue TVar m Natural
_rsize TVar m [a]
read TVar m Natural
_wsize TVar m [a]
write Natural
_size) = do
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  case [a]
xs of
    (a
_:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    [] -> do [a]
ys <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
             case [a]
ys of
               [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               [a]
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

isFullTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isFullTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m Bool
isFullTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
_read TVar m Natural
wsize TVar m [a]
_write Natural
_size) = do
  Natural
w <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
wsize
  if (Natural
w forall a. Ord a => a -> a -> Bool
> Natural
0)
     then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
     else do
         Natural
r <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
         if (Natural
r forall a. Ord a => a -> a -> Bool
> Natural
0)
            then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

lengthTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Natural
lengthTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m Natural
lengthTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
_read TVar m Natural
wsize TVar m [a]
_write Natural
size) = do
  Natural
r <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
  Natural
w <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
wsize
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Natural
size forall a. Num a => a -> a -> a
- Natural
r forall a. Num a => a -> a -> a
- Natural
w


flushTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m [a]
flushTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m [a]
flushTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
read TVar m Natural
wsize TVar m [a]
write Natural
size) = do
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  [a]
ys <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys
    then forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read []
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write []
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
rsize Natural
0
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
wsize Natural
size
      forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
ys)

unGetTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> a -> STM m ()
unGetTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> a -> STM m ()
unGetTBQueueDefault (TBQueue TVar m Natural
rsize TVar m [a]
read TVar m Natural
wsize TVar m [a]
_write Natural
_size) a
a = do
  Natural
r <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
  if (Natural
r forall a. Ord a => a -> a -> Bool
> Natural
0)
     then do forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
rsize forall a b. (a -> b) -> a -> b
$! Natural
r forall a. Num a => a -> a -> a
- Natural
1
     else do
          Natural
w <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
wsize
          if (Natural
w forall a. Ord a => a -> a -> Bool
> Natural
0)
             then forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
wsize forall a b. (a -> b) -> a -> b
$! Natural
w forall a. Num a => a -> a -> a
- Natural
1
             else forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  [a]
xs <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read (a
aforall a. a -> [a] -> [a]
:[a]
xs)


--
-- Default `TArray` implementation
--

-- | Default implementation of 'TArray'.
--
data TArrayDefault m i e = TArray (Array i (TVar m e))
  deriving Typeable

deriving instance (Eq (TVar m e), Ix i) => Eq (TArrayDefault m i e)

instance (Monad stm, MonadSTM m, stm ~ STM m)
      => MArray (TArrayDefault m) e stm where
    getBounds :: forall i. Ix i => TArrayDefault m i e -> stm (i, i)
getBounds (TArray Array i (TVar m e)
a) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall i e. Array i e -> (i, i)
bounds Array i (TVar m e)
a)
    newArray :: forall i. Ix i => (i, i) -> e -> stm (TArrayDefault m i e)
newArray (i, i)
b e
e = do
      [TVar m e]
a <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep (forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar e
e)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i e. Array i (TVar m e) -> TArrayDefault m i e
TArray (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b [TVar m e]
a)
    newArray_ :: forall i. Ix i => (i, i) -> stm (TArrayDefault m i e)
newArray_ (i, i)
b = do
      [TVar m e]
a <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep (forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar forall a. a
arrEleBottom)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i e. Array i (TVar m e) -> TArrayDefault m i e
TArray (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b [TVar m e]
a)
    unsafeRead :: forall i. Ix i => TArrayDefault m i e -> Int -> stm e
unsafeRead (TArray Array i (TVar m e)
a) Int
i = forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt Array i (TVar m e)
a Int
i
    unsafeWrite :: forall i. Ix i => TArrayDefault m i e -> Int -> e -> stm ()
unsafeWrite (TArray Array i (TVar m e)
a) Int
i e
e = forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt Array i (TVar m e)
a Int
i) e
e
    getNumElements :: forall i. Ix i => TArrayDefault m i e -> stm Int
getNumElements (TArray Array i (TVar m e)
a) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> Int
numElements Array i (TVar m e)
a)

rep :: Monad m => Int -> m a -> m [a]
rep :: forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep Int
n m a
m = Int -> [a] -> m [a]
go Int
n []
    where
      go :: Int -> [a] -> m [a]
go Int
0 [a]
xs = forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
      go Int
i [a]
xs = do
          a
x <- m a
m
          Int -> [a] -> m [a]
go (Int
iforall a. Num a => a -> a -> a
-Int
1) (a
xforall a. a -> [a] -> [a]
:[a]
xs)

labelTArrayDefault :: ( MonadLabelledSTM m
                      , Ix i
                      , Show i
                      )
                   => TArrayDefault m i e -> String -> STM m ()
labelTArrayDefault :: forall (m :: * -> *) i e.
(MonadLabelledSTM m, Ix i, Show i) =>
TArrayDefault m i e -> String -> STM m ()
labelTArrayDefault (TArray Array i (TVar m e)
arr) String
name = do
    let as :: [(i, TVar m e)]
as = forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array i (TVar m e)
arr
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\(i
i, TVar m e
v) -> forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m e
v (String
name forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show i
i)) [(i, TVar m e)]
as


--
-- Default `TSem` implementation
--

newtype TSemDefault m = TSem (TVar m Integer)

labelTSemDefault :: MonadLabelledSTM m => TSemDefault m -> String -> STM m ()
labelTSemDefault :: forall (m :: * -> *).
MonadLabelledSTM m =>
TSemDefault m -> String -> STM m ()
labelTSemDefault (TSem TVar m Integer
t) = forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m Integer
t

traceTSemDefault :: MonadTraceSTM m
                 => proxy m
                 -> TSemDefault m
                 -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
                 -> STM m ()
traceTSemDefault :: forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadTraceSTM m =>
proxy m
-> TSemDefault m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
traceTSemDefault proxy m
proxy (TSem TVar m Integer
t) Maybe Integer -> Integer -> InspectMonad m TraceValue
k = forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar proxy m
proxy TVar m Integer
t Maybe Integer -> Integer -> InspectMonad m TraceValue
k

newTSemDefault :: MonadSTM m => Integer -> STM m (TSemDefault m)
newTSemDefault :: forall (m :: * -> *).
MonadSTM m =>
Integer -> STM m (TSemDefault m)
newTSemDefault Integer
i = forall (m :: * -> *). TVar m Integer -> TSemDefault m
TSem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar forall a b. (a -> b) -> a -> b
$! Integer
i)

waitTSemDefault :: MonadSTM m => TSemDefault m -> STM m ()
waitTSemDefault :: forall (m :: * -> *). MonadSTM m => TSemDefault m -> STM m ()
waitTSemDefault (TSem TVar m Integer
t) = do
  Integer
i <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Integer
t
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
0) forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Integer
t forall a b. (a -> b) -> a -> b
$! (Integer
iforall a. Num a => a -> a -> a
-Integer
1)

signalTSemDefault :: MonadSTM m => TSemDefault m -> STM m ()
signalTSemDefault :: forall (m :: * -> *). MonadSTM m => TSemDefault m -> STM m ()
signalTSemDefault (TSem TVar m Integer
t) = do
  Integer
i <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Integer
t
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Integer
t forall a b. (a -> b) -> a -> b
$! Integer
iforall a. Num a => a -> a -> a
+Integer
1

signalTSemNDefault :: MonadSTM m => Natural -> TSemDefault m -> STM m ()
signalTSemNDefault :: forall (m :: * -> *).
MonadSTM m =>
Natural -> TSemDefault m -> STM m ()
signalTSemNDefault Natural
0 TSemDefault m
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
signalTSemNDefault Natural
1 TSemDefault m
s = forall (m :: * -> *). MonadSTM m => TSemDefault m -> STM m ()
signalTSemDefault TSemDefault m
s
signalTSemNDefault Natural
n (TSem TVar m Integer
t) = do
  Integer
i <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Integer
t
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Integer
t forall a b. (a -> b) -> a -> b
$! Integer
iforall a. Num a => a -> a -> a
+(forall a. Integral a => a -> Integer
toInteger Natural
n)

--
-- Default `TChan` implementation
--

type TVarList m a = TVar m (TList m a)
data TList m a = TNil | TCons a (TVarList m a)

data TChanDefault m a = TChan (TVar m (TVarList m a)) (TVar m (TVarList m a))

labelTChanDefault :: MonadLabelledSTM m => TChanDefault m a -> String -> STM m ()
labelTChanDefault :: forall (m :: * -> *) a.
MonadLabelledSTM m =>
TChanDefault m a -> String -> STM m ()
labelTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
write) String
name = do
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m (TVarList m a)
read  (String
name forall a. [a] -> [a] -> [a]
++ String
":read")
  forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m (TVarList m a)
write (String
name forall a. [a] -> [a] -> [a]
++ String
":write")

newTChanDefault :: MonadSTM m => STM m (TChanDefault m a)
newTChanDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TChanDefault m a)
newTChanDefault = do
  TVar m (TList m a)
hole <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar forall (m :: * -> *) a. TList m a
TNil
  TVar m (TVar m (TList m a))
read <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVar m (TList m a)
hole
  TVar m (TVar m (TList m a))
write <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVar m (TList m a)
hole
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVar m (TList m a))
read TVar m (TVar m (TList m a))
write)

newBroadcastTChanDefault :: MonadSTM m => STM m (TChanDefault m a)
newBroadcastTChanDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TChanDefault m a)
newBroadcastTChanDefault = do
    TVar m (TList m a)
write_hole <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar forall (m :: * -> *) a. TList m a
TNil
    TVar m (TVar m (TList m a))
read <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (forall a. HasCallStack => String -> a
error String
"reading from a TChan created by newBroadcastTChan; use dupTChan first")
    TVar m (TVar m (TList m a))
write <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVar m (TList m a)
write_hole
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVar m (TList m a))
read TVar m (TVar m (TList m a))
write)

writeTChanDefault :: MonadSTM m => TChanDefault m a -> a -> STM m ()
writeTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> a -> STM m ()
writeTChanDefault (TChan TVar m (TVarList m a)
_read TVar m (TVarList m a)
write) a
a = do
  TVarList m a
listend <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
write -- listend == TVar pointing to TNil
  TVarList m a
new_listend <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar forall (m :: * -> *) a. TList m a
TNil
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVarList m a
listend (forall (m :: * -> *) a. a -> TVarList m a -> TList m a
TCons a
a TVarList m a
new_listend)
  forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (TVarList m a)
write TVarList m a
new_listend

readTChanDefault :: MonadSTM m => TChanDefault m a -> STM m a
readTChanDefault :: forall (m :: * -> *) a. MonadSTM m => TChanDefault m a -> STM m a
readTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  TList m a
head_ <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    TCons a
a TVarList m a
tail_ -> do
        forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (TVarList m a)
read TVarList m a
tail_
        forall (m :: * -> *) a. Monad m => a -> m a
return a
a

tryReadTChanDefault :: MonadSTM m => TChanDefault m a -> STM m (Maybe a)
tryReadTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> STM m (Maybe a)
tryReadTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  TList m a
head_ <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    TCons a
a TVarList m a
tl -> do
      forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (TVarList m a)
read TVarList m a
tl
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)

peekTChanDefault :: MonadSTM m => TChanDefault m a -> STM m a
peekTChanDefault :: forall (m :: * -> *) a. MonadSTM m => TChanDefault m a -> STM m a
peekTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  TList m a
head_ <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil      -> forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    TCons a
a TVarList m a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

tryPeekTChanDefault :: MonadSTM m => TChanDefault m a -> STM m (Maybe a)
tryPeekTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> STM m (Maybe a)
tryPeekTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  TList m a
head_ <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    TCons a
a TVarList m a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)

dupTChanDefault :: MonadSTM m => TChanDefault m a -> STM m (TChanDefault m a)
dupTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> STM m (TChanDefault m a)
dupTChanDefault (TChan TVar m (TVarList m a)
_read TVar m (TVarList m a)
write) = do
  TVarList m a
hole <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
write
  TVar m (TVarList m a)
new_read <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVarList m a
hole
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVarList m a)
new_read TVar m (TVarList m a)
write)

unGetTChanDefault :: MonadSTM m => TChanDefault m a -> a -> STM m ()
unGetTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> a -> STM m ()
unGetTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) a
a = do
   TVarList m a
listhead <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
   TVarList m a
newhead <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (forall (m :: * -> *) a. a -> TVarList m a -> TList m a
TCons a
a TVarList m a
listhead)
   forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (TVarList m a)
read TVarList m a
newhead

isEmptyTChanDefault :: MonadSTM m => TChanDefault m a -> STM m Bool
isEmptyTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> STM m Bool
isEmptyTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  TList m a
head_ <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil      -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    TCons a
_ TVarList m a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

cloneTChanDefault :: MonadSTM m => TChanDefault m a -> STM m (TChanDefault m a)
cloneTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> STM m (TChanDefault m a)
cloneTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
write) = do
  TVarList m a
readpos <- forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  TVar m (TVarList m a)
new_read <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVarList m a
readpos
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVarList m a)
new_read TVar m (TVarList m a)
write)


-- | 'throwIO' specialised to @stm@ monad.
--
throwSTM :: (MonadSTM m, MonadThrow.MonadThrow (STM m), Exception e)
         => e -> STM m a
throwSTM :: forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MonadThrow.throwIO


-- | 'catch' specialized for an @stm@ monad.
--
catchSTM :: (MonadSTM m, MonadThrow.MonadCatch (STM m), Exception e)
         => STM m a -> (e -> STM m a) -> STM m a
catchSTM :: forall (m :: * -> *) e a.
(MonadSTM m, MonadCatch (STM m), Exception e) =>
STM m a -> (e -> STM m a) -> STM m a
catchSTM = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
MonadThrow.catch

--
-- ReaderT instance
--


-- | The underlying stm monad is also transformed.
--
instance MonadSTM m => MonadSTM (ReaderT r m) where
    type STM (ReaderT r m) = ReaderT r (STM m)
    atomically :: forall a. HasCallStack => STM (ReaderT r m) a -> ReaderT r m a
atomically (ReaderT r -> STM m a
stm) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (r -> STM m a
stm r
r)

    type TVar (ReaderT r m) = TVar m
    newTVar :: forall a. a -> STM (ReaderT r m) (TVar (ReaderT r m) a)
newTVar        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar
    readTVar :: forall a. TVar (ReaderT r m) a -> STM (ReaderT r m) a
readTVar       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar
    writeTVar :: forall a. TVar (ReaderT r m) a -> a -> STM (ReaderT r m) ()
writeTVar      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar
    retry :: forall a. STM (ReaderT r m) a
retry          = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    orElse :: forall a.
STM (ReaderT r m) a -> STM (ReaderT r m) a -> STM (ReaderT r m) a
orElse (ReaderT r -> STM m a
a) (ReaderT r -> STM m a
b) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> r -> STM m a
a r
r forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse` r -> STM m a
b r
r

    modifyTVar :: forall a. TVar (ReaderT r m) a -> (a -> a) -> STM (ReaderT r m) ()
modifyTVar     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar
    modifyTVar' :: forall a. TVar (ReaderT r m) a -> (a -> a) -> STM (ReaderT r m) ()
modifyTVar'    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar'
    stateTVar :: forall s a.
TVar (ReaderT r m) s -> (s -> (a, s)) -> STM (ReaderT r m) a
stateTVar      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) s a.
MonadSTM m =>
TVar m s -> (s -> (a, s)) -> STM m a
stateTVar
    swapTVar :: forall a. TVar (ReaderT r m) a -> a -> STM (ReaderT r m) a
swapTVar       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m a
swapTVar
    check :: Bool -> STM (ReaderT r m) ()
check          = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check

    type TMVar (ReaderT r m) = TMVar m
    newTMVar :: forall a. a -> STM (ReaderT r m) (TMVar (ReaderT r m) a)
newTMVar       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => a -> STM m (TMVar m a)
newTMVar
    newEmptyTMVar :: forall a. STM (ReaderT r m) (TMVar (ReaderT r m) a)
newEmptyTMVar  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    forall (m :: * -> *) a. MonadSTM m => STM m (TMVar m a)
newEmptyTMVar
    takeTMVar :: forall a. TMVar (ReaderT r m) a -> STM (ReaderT r m) a
takeTMVar      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar
    tryTakeTMVar :: forall a. TMVar (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryTakeTMVar   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
tryTakeTMVar
    putTMVar :: forall a. TMVar (ReaderT r m) a -> a -> STM (ReaderT r m) ()
putTMVar       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
putTMVar
    tryPutTMVar :: forall a. TMVar (ReaderT r m) a -> a -> STM (ReaderT r m) Bool
tryPutTMVar    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m Bool
tryPutTMVar
    readTMVar :: forall a. TMVar (ReaderT r m) a -> STM (ReaderT r m) a
readTMVar      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
readTMVar
    tryReadTMVar :: forall a. TMVar (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryReadTMVar   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m (Maybe a)
tryReadTMVar
    swapTMVar :: forall a. TMVar (ReaderT r m) a -> a -> STM (ReaderT r m) a
swapTMVar      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m a
swapTMVar
    isEmptyTMVar :: forall a. TMVar (ReaderT r m) a -> STM (ReaderT r m) Bool
isEmptyTMVar   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m Bool
isEmptyTMVar

    type TQueue (ReaderT r m) = TQueue m
    newTQueue :: forall a. STM (ReaderT r m) (TQueue (ReaderT r m) a)
newTQueue      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
    readTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) a
readTQueue     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue
    tryReadTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryReadTQueue  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m (Maybe a)
tryReadTQueue
    peekTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) a
peekTQueue     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
peekTQueue
    tryPeekTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryPeekTQueue  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m (Maybe a)
tryPeekTQueue
    flushTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) [a]
flushTQueue    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m [a]
flushTQueue
    writeTQueue :: forall a. TQueue (ReaderT r m) a -> a -> STM (ReaderT r m) ()
writeTQueue TQueue (ReaderT r m) a
v  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue (ReaderT r m) a
v
    isEmptyTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) Bool
isEmptyTQueue  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m Bool
isEmptyTQueue
    unGetTQueue :: forall a. TQueue (ReaderT r m) a -> a -> STM (ReaderT r m) ()
unGetTQueue    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
unGetTQueue

    type TBQueue (ReaderT r m) = TBQueue m
    newTBQueue :: forall a. Natural -> STM (ReaderT r m) (TBQueue (ReaderT r m) a)
newTBQueue     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadSTM m =>
Natural -> STM m (TBQueue m a)
newTBQueue
    readTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) a
readTBQueue    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m a
readTBQueue
    tryReadTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryReadTBQueue = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadSTM m =>
TBQueue m a -> STM m (Maybe a)
tryReadTBQueue
    peekTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) a
peekTBQueue    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m a
peekTBQueue
    tryPeekTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryPeekTBQueue = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadSTM m =>
TBQueue m a -> STM m (Maybe a)
tryPeekTBQueue
    flushTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) [a]
flushTBQueue   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m [a]
flushTBQueue
    writeTBQueue :: forall a. TBQueue (ReaderT r m) a -> a -> STM (ReaderT r m) ()
writeTBQueue   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> a -> STM m ()
writeTBQueue
    lengthTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) Natural
lengthTBQueue  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m Natural
lengthTBQueue
    isEmptyTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) Bool
isEmptyTBQueue = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m Bool
isEmptyTBQueue
    isFullTBQueue :: forall a. TBQueue (ReaderT r m) a -> STM (ReaderT r m) Bool
isFullTBQueue  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> STM m Bool
isFullTBQueue
    unGetTBQueue :: forall a. TBQueue (ReaderT r m) a -> a -> STM (ReaderT r m) ()
unGetTBQueue   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TBQueue m a -> a -> STM m ()
unGetTBQueue

    type TArray (ReaderT r m) = TArray m

    type TSem (ReaderT r m) = TSem m
    newTSem :: Integer -> STM (ReaderT r m) (TSem (ReaderT r m))
newTSem        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *). MonadSTM m => Integer -> STM m (TSem m)
newTSem
    waitTSem :: TSem (ReaderT r m) -> STM (ReaderT r m) ()
waitTSem       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *). MonadSTM m => TSem m -> STM m ()
waitTSem
    signalTSem :: TSem (ReaderT r m) -> STM (ReaderT r m) ()
signalTSem     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *). MonadSTM m => TSem m -> STM m ()
signalTSem
    signalTSemN :: Natural -> TSem (ReaderT r m) -> STM (ReaderT r m) ()
signalTSemN    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *). MonadSTM m => Natural -> TSem m -> STM m ()
signalTSemN

    type TChan (ReaderT r m) = TChan m
    newTChan :: forall a. STM (ReaderT r m) (TChan (ReaderT r m) a)
newTChan          = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a)
newTChan
    newBroadcastTChan :: forall a. STM (ReaderT r m) (TChan (ReaderT r m) a)
newBroadcastTChan = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a)
newBroadcastTChan
    dupTChan :: forall a.
TChan (ReaderT r m) a -> STM (ReaderT r m) (TChan (ReaderT r m) a)
dupTChan          = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadSTM m =>
TChan m a -> STM m (TChan m a)
dupTChan
    cloneTChan :: forall a.
TChan (ReaderT r m) a -> STM (ReaderT r m) (TChan (ReaderT r m) a)
cloneTChan        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadSTM m =>
TChan m a -> STM m (TChan m a)
cloneTChan
    readTChan :: forall a. TChan (ReaderT r m) a -> STM (ReaderT r m) a
readTChan         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m a
readTChan
    tryReadTChan :: forall a. TChan (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryReadTChan      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m (Maybe a)
tryReadTChan
    peekTChan :: forall a. TChan (ReaderT r m) a -> STM (ReaderT r m) a
peekTChan         = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m a
peekTChan
    tryPeekTChan :: forall a. TChan (ReaderT r m) a -> STM (ReaderT r m) (Maybe a)
tryPeekTChan      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m (Maybe a)
tryPeekTChan
    writeTChan :: forall a. TChan (ReaderT r m) a -> a -> STM (ReaderT r m) ()
writeTChan        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TChan m a -> a -> STM m ()
writeTChan
    unGetTChan :: forall a. TChan (ReaderT r m) a -> a -> STM (ReaderT r m) ()
unGetTChan        = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a. MonadSTM m => TChan m a -> a -> STM m ()
unGetTChan
    isEmptyTChan :: forall a. TChan (ReaderT r m) a -> STM (ReaderT r m) Bool
isEmptyTChan      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m Bool
isEmptyTChan


(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
(c -> d
f .: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: a -> b -> c
g) a
x b
y = c -> d
f (a -> b -> c
g a
x b
y)