{-# LANGUAGE CPP                        #-}
{-# 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
  , writeTMVarDefault
  , isEmptyTMVarDefault
  , labelTMVarDefault
  , traceTMVarDefault
    -- ** Default 'TQueue' 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
    -- * Trace tvar and tmvar
  , debugTraceTVar
  , debugTraceTVarIO
  , debugTraceTMVar
  , debugTraceTMVarIO
  ) where

import Prelude hiding (read)

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

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

import Control.Monad.Class.MonadThrow qualified as MonadThrow

import Control.Exception
import Data.Array (Array, bounds)
import Data.Array qualified 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 = TVar m a -> STM m a
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m a
v STM m a -> (a -> STM m ()) -> STM m ()
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar m a -> a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m a
v (a -> STM m ()) -> (a -> a) -> a -> STM m ()
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 = TVar m a -> STM m a
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m a
v STM m a -> (a -> STM m ()) -> STM m ()
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> TVar m a -> a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m a
v (a -> STM m ()) -> a -> STM m ()
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    = TVar m s -> (s -> (a, s)) -> STM m a
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     = TVar m a -> a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m a
swapTVarDefault

  -- | See `STM.check`.
  check        :: Bool -> STM m ()
  check Bool
True = () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  check Bool
_    = STM m ()
forall a. STM m a
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
  writeTMVar      :: TMVar m a -> a -> STM m ()
  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           = STM m (TVar m a) -> m (TVar m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (TVar m a) -> m (TVar m a))
-> (a -> STM m (TVar m a)) -> a -> m (TVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> STM m (TVar m a)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar
  readTVarIO          = STM m a -> m a
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m a -> m a) -> (TVar m a -> STM m a) -> TVar m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar m a -> STM m a
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar
  newTMVarIO          = STM m (TMVar m a) -> m (TMVar m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (TMVar m a) -> m (TMVar m a))
-> (a -> STM m (TMVar m a)) -> a -> m (TMVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> STM m (TMVar m a)
forall a. a -> STM m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TMVar m a)
newTMVar
  newEmptyTMVarIO     = STM m (TMVar m a) -> m (TMVar m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   STM m (TMVar m a)
forall a. STM m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TMVar m a)
newEmptyTMVar
  newTQueueIO         = STM m (TQueue m a) -> m (TQueue m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   STM m (TQueue m a)
forall a. STM m (TQueue m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  newTBQueueIO        = STM m (TBQueue m a) -> m (TBQueue m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (TBQueue m a) -> m (TBQueue m a))
-> (Natural -> STM m (TBQueue m a)) -> Natural -> m (TBQueue m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> STM m (TBQueue m a)
forall a. Natural -> STM m (TBQueue m a)
forall (m :: * -> *) a.
MonadSTM m =>
Natural -> STM m (TBQueue m a)
newTBQueue
  newTChanIO          = STM m (TChan m a) -> m (TChan m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   STM m (TChan m a)
forall a. STM m (TChan m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a)
newTChan
  newBroadcastTChanIO = STM m (TChan m a) -> m (TChan m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically   STM m (TChan m a)
forall a. STM m (TChan m a)
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 <- TVar m s -> STM m s
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m s
var
   let (a, s') = f s
   writeTVar var s'
   return 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
    old <- TVar m a -> STM m a
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m a
var
    writeTVar var new
    return 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 = TMVar m a -> String -> STM m ()
TMVarDefault m a -> String -> STM m ()
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 = TQueue m a -> String -> STM m ()
TQueueDefault m a -> String -> STM m ()
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 = TBQueue m a -> String -> STM m ()
TBQueueDefault m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TBQueueDefault m a -> String -> STM m ()
labelTBQueueDefault

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

  default labelTChan :: TChan m ~ TChanDefault m
                     => TChan m a -> String -> STM m ()
  labelTChan = TChan m a -> String -> STM m ()
TChanDefault m a -> String -> STM m ()
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 = TArray m i e -> String -> STM m ()
TArrayDefault m i e -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TVar m a -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TMVar m a -> String -> STM m ()
forall a. TMVar m a -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TQueue m a -> String -> STM m ()
forall a. TQueue m a -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TBQueue m a -> String -> STM m ()
forall a. TBQueue m a -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TArray m i e -> String -> STM m ()
forall i e. (Ix i, Show i) => TArray m i e -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TSem m -> String -> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TChan m a -> String -> STM m ()
forall a. TChan m a -> String -> STM m ()
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
_ = TVar IO a -> IO a
TVar IO a -> InspectMonad IO a
forall a. TVar IO a -> IO a
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
_ = STM (Maybe a) -> IO (Maybe a)
STM IO (Maybe a) -> IO (Maybe a)
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (Maybe a) -> IO (Maybe a))
-> (TMVar a -> STM (Maybe a)) -> TMVar a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar a -> STM (Maybe a)
TMVar IO a -> STM IO (Maybe a)
forall a. TMVar IO a -> STM IO (Maybe a)
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 = tr -> Maybe tr
forall a. a -> Maybe a
Just tr
tr, traceString :: Maybe String
traceString = Maybe String
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 = (Maybe ()
forall a. Maybe a
Nothing :: Maybe ())
                                , traceString :: Maybe String
traceString  = String -> Maybe String
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 = Maybe () -> Maybe String -> TraceValue
forall tr. Typeable tr => Maybe tr -> Maybe String -> TraceValue
TraceValue (Maybe ()
forall a. Maybe a
Nothing :: Maybe ()) Maybe String
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 = proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
proxy m
-> TMVarDefault m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
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 = proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
proxy m
-> TSemDefault m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar Proxy m
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVar Proxy m
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTQueue Proxy m
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTBQueue Proxy m
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 -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadTraceSTM m =>
proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *).
proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
traceTSem Proxy m
forall {k} (t :: k). Proxy t
Proxy TSem m
v Maybe Integer -> Integer -> InspectMonad m TraceValue
f)

debugTraceTVar :: (MonadTraceSTM m, Show a)
               => proxy m
               -> TVar m a
               -> STM m ()
debugTraceTVar :: forall (m :: * -> *) a (proxy :: (* -> *) -> *).
(MonadTraceSTM m, Show a) =>
proxy m -> TVar m a -> STM m ()
debugTraceTVar proxy m
p TVar m a
tvar =
  proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar proxy m
p TVar m a
tvar (\Maybe a
pv a
v -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceValue -> InspectMonad m TraceValue)
-> TraceValue -> InspectMonad m TraceValue
forall a b. (a -> b) -> a -> b
$ String -> TraceValue
TraceString (String -> TraceValue) -> String -> TraceValue
forall a b. (a -> b) -> a -> b
$ case (Maybe a
pv, a
v) of
          (Maybe a
Nothing, a
_)     -> String -> String
forall a. HasCallStack => String -> a
error String
"Unreachable"
          (Just a
st', a
st'') -> String
"Modified: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st''
      )

debugTraceTVarIO :: (MonadTraceSTM m, Show a)
               => TVar m a
               -> m ()
debugTraceTVarIO :: forall (m :: * -> *) a.
(MonadTraceSTM m, Show a) =>
TVar m a -> m ()
debugTraceTVarIO TVar m a
tvar =
  TVar m a -> (Maybe a -> a -> InspectMonad m TraceValue) -> m ()
forall a.
TVar m a -> (Maybe a -> a -> InspectMonad m TraceValue) -> m ()
forall (m :: * -> *) a.
MonadTraceSTM m =>
TVar m a -> (Maybe a -> a -> InspectMonad m TraceValue) -> m ()
traceTVarIO TVar m a
tvar (\Maybe a
pv a
v -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceValue -> InspectMonad m TraceValue)
-> TraceValue -> InspectMonad m TraceValue
forall a b. (a -> b) -> a -> b
$ String -> TraceValue
TraceString (String -> TraceValue) -> String -> TraceValue
forall a b. (a -> b) -> a -> b
$ case (Maybe a
pv, a
v) of
          (Maybe a
Nothing, a
_)     -> String -> String
forall a. HasCallStack => String -> a
error String
"Unreachable"
          (Just a
st', a
st'') -> String
"Modified: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st''
      )

debugTraceTMVar :: (MonadTraceSTM m, Show a)
               => proxy m
               -> TMVar m a
               -> STM m ()
debugTraceTMVar :: forall (m :: * -> *) a (proxy :: (* -> *) -> *).
(MonadTraceSTM m, Show a) =>
proxy m -> TMVar m a -> STM m ()
debugTraceTMVar proxy m
p TMVar m a
tmvar =
  proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVar proxy m
p TMVar m a
tmvar (\Maybe (Maybe a)
pv Maybe a
v -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceValue -> InspectMonad m TraceValue)
-> TraceValue -> InspectMonad m TraceValue
forall a b. (a -> b) -> a -> b
$ String -> TraceValue
TraceString (String -> TraceValue) -> String -> TraceValue
forall a b. (a -> b) -> a -> b
$ case (Maybe (Maybe a)
pv, Maybe a
v) of
          (Maybe (Maybe a)
Nothing, Maybe a
_) -> String -> String
forall a. HasCallStack => String -> a
error String
"Unreachable"
          (Just Maybe a
Nothing, Just a
st') -> String
"Put: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st'
          (Just Maybe a
Nothing, Maybe a
Nothing) -> String
"Remains empty"
          (Just Just{}, Maybe a
Nothing) -> String
"Take"
          (Just (Just a
st'), Just a
st'') -> String
"Modified: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st''
      )

debugTraceTMVarIO :: (Show a, MonadTraceSTM m)
                 => TMVar m a
                 -> m ()
debugTraceTMVarIO :: forall a (m :: * -> *).
(Show a, MonadTraceSTM m) =>
TMVar m a -> m ()
debugTraceTMVarIO TMVar m a
tmvar =
  TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> m ()
forall a.
TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> m ()
forall (m :: * -> *) a.
MonadTraceSTM m =>
TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> m ()
traceTMVarIO TMVar m a
tmvar (\Maybe (Maybe a)
pv Maybe a
v -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceValue -> InspectMonad m TraceValue)
-> TraceValue -> InspectMonad m TraceValue
forall a b. (a -> b) -> a -> b
$ String -> TraceValue
TraceString (String -> TraceValue) -> String -> TraceValue
forall a b. (a -> b) -> a -> b
$ case (Maybe (Maybe a)
pv, Maybe a
v) of
          (Maybe (Maybe a)
Nothing, Maybe a
_) -> String -> String
forall a. HasCallStack => String -> a
error String
"Unreachable"
          (Just Maybe a
Nothing, Just a
st') -> String
"Put: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st'
          (Just Maybe a
Nothing, Maybe a
Nothing) -> String
"Remains empty"
          (Just Just{}, Maybe a
Nothing) -> String
"Take"
          (Just (Just a
st'), Just a
st'') -> String
"Modified: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
st''
      )

--
-- 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 = IO a -> IO a
forall a. HasCallStack => IO a -> IO a
wrapBlockedIndefinitely (IO a -> IO a) -> (STM a -> IO a) -> STM a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM a -> IO a
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        = a -> STM (TVar a)
a -> STM IO (TVar IO a)
forall a. a -> STM (TVar a)
STM.newTVar
  readTVar :: forall a. TVar IO a -> STM IO a
readTVar       = TVar a -> STM a
TVar IO a -> STM IO a
forall a. TVar a -> STM a
STM.readTVar
  writeTVar :: forall a. TVar IO a -> a -> STM IO ()
writeTVar      = TVar a -> a -> STM ()
TVar IO a -> a -> STM IO ()
forall a. TVar a -> a -> STM ()
STM.writeTVar
  retry :: forall a. STM IO a
retry          = STM a
STM IO a
forall a. STM a
STM.retry
  orElse :: forall a. STM IO a -> STM IO a -> STM IO a
orElse         = STM a -> STM a -> STM a
STM IO a -> STM IO a -> STM IO a
forall a. STM a -> STM a -> STM a
STM.orElse
  modifyTVar :: forall a. TVar IO a -> (a -> a) -> STM IO ()
modifyTVar     = TVar a -> (a -> a) -> STM ()
TVar IO a -> (a -> a) -> STM IO ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar
  modifyTVar' :: forall a. TVar IO a -> (a -> a) -> STM IO ()
modifyTVar'    = TVar a -> (a -> a) -> STM ()
TVar IO a -> (a -> a) -> STM IO ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar'
  stateTVar :: forall s a. TVar IO s -> (s -> (a, s)) -> STM IO a
stateTVar      = TVar s -> (s -> (a, s)) -> STM a
TVar IO s -> (s -> (a, s)) -> STM IO a
forall s a. TVar s -> (s -> (a, s)) -> STM a
STM.stateTVar
  swapTVar :: forall a. TVar IO a -> a -> STM IO a
swapTVar       = TVar a -> a -> STM a
TVar IO a -> a -> STM IO a
forall a. TVar a -> a -> STM a
STM.swapTVar
  check :: Bool -> STM IO ()
check          = Bool -> STM ()
Bool -> STM IO ()
STM.check
  newTMVar :: forall a. a -> STM IO (TMVar IO a)
newTMVar       = a -> STM (TMVar a)
a -> STM IO (TMVar IO a)
forall a. a -> STM (TMVar a)
STM.newTMVar
  newEmptyTMVar :: forall a. STM IO (TMVar IO a)
newEmptyTMVar  = STM (TMVar a)
STM IO (TMVar IO a)
forall a. STM (TMVar a)
STM.newEmptyTMVar
  takeTMVar :: forall a. TMVar IO a -> STM IO a
takeTMVar      = TMVar a -> STM a
TMVar IO a -> STM IO a
forall a. TMVar a -> STM a
STM.takeTMVar
  tryTakeTMVar :: forall a. TMVar IO a -> STM IO (Maybe a)
tryTakeTMVar   = TMVar a -> STM (Maybe a)
TMVar IO a -> STM IO (Maybe a)
forall a. TMVar a -> STM (Maybe a)
STM.tryTakeTMVar
  putTMVar :: forall a. TMVar IO a -> a -> STM IO ()
putTMVar       = TMVar a -> a -> STM ()
TMVar IO a -> a -> STM IO ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar
  tryPutTMVar :: forall a. TMVar IO a -> a -> STM IO Bool
tryPutTMVar    = TMVar a -> a -> STM Bool
TMVar IO a -> a -> STM IO Bool
forall a. TMVar a -> a -> STM Bool
STM.tryPutTMVar
  readTMVar :: forall a. TMVar IO a -> STM IO a
readTMVar      = TMVar a -> STM a
TMVar IO a -> STM IO a
forall a. TMVar a -> STM a
STM.readTMVar
  tryReadTMVar :: forall a. TMVar IO a -> STM IO (Maybe a)
tryReadTMVar   = TMVar a -> STM (Maybe a)
TMVar IO a -> STM IO (Maybe a)
forall a. TMVar a -> STM (Maybe a)
STM.tryReadTMVar
  swapTMVar :: forall a. TMVar IO a -> a -> STM IO a
swapTMVar      = TMVar a -> a -> STM a
TMVar IO a -> a -> STM IO a
forall a. TMVar a -> a -> STM a
STM.swapTMVar
#if MIN_VERSION_stm(2, 5, 1)
  writeTMVar :: forall a. TMVar IO a -> a -> STM IO ()
writeTMVar     = TMVar a -> a -> STM ()
TMVar IO a -> a -> STM IO ()
forall a. TMVar a -> a -> STM ()
STM.writeTMVar
#else
  writeTMVar     = writeTMVar'
#endif
  isEmptyTMVar :: forall a. TMVar IO a -> STM IO Bool
isEmptyTMVar   = TMVar a -> STM Bool
TMVar IO a -> STM IO Bool
forall a. TMVar a -> STM Bool
STM.isEmptyTMVar
  newTQueue :: forall a. STM IO (TQueue IO a)
newTQueue      = STM (TQueue a)
STM IO (TQueue IO a)
forall a. STM (TQueue a)
STM.newTQueue
  readTQueue :: forall a. TQueue IO a -> STM IO a
readTQueue     = TQueue a -> STM a
TQueue IO a -> STM IO a
forall a. TQueue a -> STM a
STM.readTQueue
  tryReadTQueue :: forall a. TQueue IO a -> STM IO (Maybe a)
tryReadTQueue  = TQueue a -> STM (Maybe a)
TQueue IO a -> STM IO (Maybe a)
forall a. TQueue a -> STM (Maybe a)
STM.tryReadTQueue
  peekTQueue :: forall a. TQueue IO a -> STM IO a
peekTQueue     = TQueue a -> STM a
TQueue IO a -> STM IO a
forall a. TQueue a -> STM a
STM.peekTQueue
  tryPeekTQueue :: forall a. TQueue IO a -> STM IO (Maybe a)
tryPeekTQueue  = TQueue a -> STM (Maybe a)
TQueue IO a -> STM IO (Maybe a)
forall a. TQueue a -> STM (Maybe a)
STM.tryPeekTQueue
  flushTQueue :: forall a. TQueue IO a -> STM IO [a]
flushTQueue    = TQueue a -> STM [a]
TQueue IO a -> STM IO [a]
forall a. TQueue a -> STM [a]
STM.flushTQueue
  writeTQueue :: forall a. TQueue IO a -> a -> STM IO ()
writeTQueue    = TQueue a -> a -> STM ()
TQueue IO a -> a -> STM IO ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue
  isEmptyTQueue :: forall a. TQueue IO a -> STM IO Bool
isEmptyTQueue  = TQueue a -> STM Bool
TQueue IO a -> STM IO Bool
forall a. TQueue a -> STM Bool
STM.isEmptyTQueue
  unGetTQueue :: forall a. TQueue IO a -> a -> STM IO ()
unGetTQueue    = TQueue a -> a -> STM ()
TQueue IO a -> a -> STM IO ()
forall a. TQueue a -> a -> STM ()
STM.unGetTQueue
  newTBQueue :: forall a. Natural -> STM IO (TBQueue IO a)
newTBQueue     = Natural -> STM (TBQueue a)
Natural -> STM IO (TBQueue IO a)
forall a. Natural -> STM (TBQueue a)
STM.newTBQueue
  readTBQueue :: forall a. TBQueue IO a -> STM IO a
readTBQueue    = TBQueue a -> STM a
TBQueue IO a -> STM IO a
forall a. TBQueue a -> STM a
STM.readTBQueue
  tryReadTBQueue :: forall a. TBQueue IO a -> STM IO (Maybe a)
tryReadTBQueue = TBQueue a -> STM (Maybe a)
TBQueue IO a -> STM IO (Maybe a)
forall a. TBQueue a -> STM (Maybe a)
STM.tryReadTBQueue
  peekTBQueue :: forall a. TBQueue IO a -> STM IO a
peekTBQueue    = TBQueue a -> STM a
TBQueue IO a -> STM IO a
forall a. TBQueue a -> STM a
STM.peekTBQueue
  tryPeekTBQueue :: forall a. TBQueue IO a -> STM IO (Maybe a)
tryPeekTBQueue = TBQueue a -> STM (Maybe a)
TBQueue IO a -> STM IO (Maybe a)
forall a. TBQueue a -> STM (Maybe a)
STM.tryPeekTBQueue
  writeTBQueue :: forall a. TBQueue IO a -> a -> STM IO ()
writeTBQueue   = TBQueue a -> a -> STM ()
TBQueue IO a -> a -> STM IO ()
forall a. TBQueue a -> a -> STM ()
STM.writeTBQueue
  flushTBQueue :: forall a. TBQueue IO a -> STM IO [a]
flushTBQueue   = TBQueue a -> STM [a]
TBQueue IO a -> STM IO [a]
forall a. TBQueue a -> STM [a]
STM.flushTBQueue
  lengthTBQueue :: forall a. TBQueue IO a -> STM IO Natural
lengthTBQueue  = TBQueue a -> STM Natural
TBQueue IO a -> STM IO Natural
forall a. TBQueue a -> STM Natural
STM.lengthTBQueue
  isEmptyTBQueue :: forall a. TBQueue IO a -> STM IO Bool
isEmptyTBQueue = TBQueue a -> STM Bool
TBQueue IO a -> STM IO Bool
forall a. TBQueue a -> STM Bool
STM.isEmptyTBQueue
  isFullTBQueue :: forall a. TBQueue IO a -> STM IO Bool
isFullTBQueue  = TBQueue a -> STM Bool
TBQueue IO a -> STM IO Bool
forall a. TBQueue a -> STM Bool
STM.isFullTBQueue
  unGetTBQueue :: forall a. TBQueue IO a -> a -> STM IO ()
unGetTBQueue   = TBQueue a -> a -> STM ()
TBQueue IO a -> a -> STM IO ()
forall a. TBQueue a -> a -> STM ()
STM.unGetTBQueue
  newTSem :: Integer -> STM IO (TSem IO)
newTSem        = Integer -> STM TSem
Integer -> STM IO (TSem IO)
STM.newTSem
  waitTSem :: TSem IO -> STM IO ()
waitTSem       = TSem -> STM ()
TSem IO -> STM IO ()
STM.waitTSem
  signalTSem :: TSem IO -> STM IO ()
signalTSem     = TSem -> STM ()
TSem IO -> STM IO ()
STM.signalTSem
  signalTSemN :: Natural -> TSem IO -> STM IO ()
signalTSemN    = Natural -> TSem -> STM ()
Natural -> TSem IO -> STM IO ()
STM.signalTSemN

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

  newTVarIO :: forall a. a -> IO (TVar IO a)
newTVarIO           = a -> IO (TVar a)
a -> IO (TVar IO a)
forall a. a -> IO (TVar a)
STM.newTVarIO
  readTVarIO :: forall a. TVar IO a -> IO a
readTVarIO          = TVar a -> IO a
TVar IO a -> IO a
forall a. TVar a -> IO a
STM.readTVarIO
  newTMVarIO :: forall a. a -> IO (TMVar IO a)
newTMVarIO          = a -> IO (TMVar a)
a -> IO (TMVar IO a)
forall a. a -> IO (TMVar a)
STM.newTMVarIO
  newEmptyTMVarIO :: forall a. IO (TMVar IO a)
newEmptyTMVarIO     = IO (TMVar a)
IO (TMVar IO a)
forall a. IO (TMVar a)
STM.newEmptyTMVarIO
  newTQueueIO :: forall a. IO (TQueue IO a)
newTQueueIO         = IO (TQueue a)
IO (TQueue IO a)
forall a. IO (TQueue a)
STM.newTQueueIO
  newTBQueueIO :: forall a. Natural -> IO (TBQueue IO a)
newTBQueueIO        = Natural -> IO (TBQueue a)
Natural -> IO (TBQueue IO a)
forall a. Natural -> IO (TBQueue a)
STM.newTBQueueIO
  newTChanIO :: forall a. IO (TChan IO a)
newTChanIO          = IO (TChan a)
IO (TChan IO a)
forall a. IO (TChan a)
STM.newTChanIO
  newBroadcastTChanIO :: forall a. IO (TChan IO a)
newBroadcastTChanIO = IO (TChan a)
IO (TChan IO a)
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
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTMVar :: forall a. TMVar IO a -> String -> STM IO ()
labelTMVar   = \TMVar IO a
_  String
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTQueue :: forall a. TQueue IO a -> String -> STM IO ()
labelTQueue  = \TQueue IO a
_  String
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTBQueue :: forall a. TBQueue IO a -> String -> STM IO ()
labelTBQueue = \TBQueue IO a
_  String
_ -> () -> STM ()
forall a. a -> STM a
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
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTSem :: TSem IO -> String -> STM IO ()
labelTSem    = \TSem IO
_  String
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTChan :: forall a. TChan IO a -> String -> STM IO ()
labelTChan   = \TChan IO a
_  String
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  labelTVarIO :: forall a. TVar IO a -> String -> IO ()
labelTVarIO    = \TVar IO a
_  String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTMVarIO :: forall a. TMVar IO a -> String -> IO ()
labelTMVarIO   = \TMVar IO a
_  String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTQueueIO :: forall a. TQueue IO a -> String -> IO ()
labelTQueueIO  = \TQueue IO a
_  String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTBQueueIO :: forall a. TBQueue IO a -> String -> IO ()
labelTBQueueIO = \TBQueue IO a
_  String
_ -> () -> IO ()
forall a. a -> IO a
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
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTSemIO :: TSem IO -> String -> IO ()
labelTSemIO    = \TSem IO
_  String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  labelTChanIO :: forall a. TChan IO a -> String -> IO ()
labelTChanIO   = \TChan IO a
_  String
_ -> () -> IO ()
forall a. a -> IO a
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
_ -> () -> STM ()
forall a. a -> STM a
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
_ -> () -> STM ()
forall a. a -> STM a
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
_ -> () -> STM ()
forall a. a -> STM a
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
_ -> () -> STM ()
forall a. a -> STM a
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
_ -> () -> STM ()
forall a. a -> STM a
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
_ -> () -> IO ()
forall a. a -> IO a
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
_ -> () -> IO ()
forall a. a -> IO a
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
_ -> () -> IO ()
forall a. a -> IO a
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
_ -> () -> IO ()
forall a. a -> IO a
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
_ -> () -> IO ()
forall a. a -> IO a
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 -> String -> String
[BlockedIndefinitely] -> String -> String
BlockedIndefinitely -> String
(Int -> BlockedIndefinitely -> String -> String)
-> (BlockedIndefinitely -> String)
-> ([BlockedIndefinitely] -> String -> String)
-> Show BlockedIndefinitely
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> BlockedIndefinitely -> String -> String
showsPrec :: Int -> BlockedIndefinitely -> String -> String
$cshow :: BlockedIndefinitely -> String
show :: BlockedIndefinitely -> String
$cshowList :: [BlockedIndefinitely] -> String -> String
showList :: [BlockedIndefinitely] -> String -> String
Show

instance Exception BlockedIndefinitely where
  displayException :: BlockedIndefinitely -> String
displayException (BlockedIndefinitely CallStack
cs BlockedIndefinitelyOnSTM
e) = [String] -> String
unlines [
        BlockedIndefinitelyOnSTM -> String
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 = (BlockedIndefinitelyOnSTM -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (BlockedIndefinitely -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (BlockedIndefinitely -> IO a)
-> (BlockedIndefinitelyOnSTM -> BlockedIndefinitely)
-> BlockedIndefinitelyOnSTM
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> BlockedIndefinitelyOnSTM -> BlockedIndefinitely
BlockedIndefinitely CallStack
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) = TVar m (Maybe a) -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
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 = proxy m
-> TVar m (Maybe a)
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
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
  t <- Maybe a -> STM m (TVar m (Maybe a))
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
  return (TMVar t)

newEmptyTMVarDefault :: MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault = do
  t <- Maybe a -> STM m (TVar m (Maybe a))
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar Maybe a
forall a. Maybe a
Nothing
  return (TMVar 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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing -> STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    Just a
a  -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t Maybe a
forall a. Maybe a
Nothing; a -> STM m a
forall a. a -> STM m a
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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just a
a  -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t Maybe a
forall a. Maybe a
Nothing; Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
a); () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just a
_  -> STM m ()
forall a. STM m 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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
a); Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just a
_  -> Bool -> STM m Bool
forall a. a -> STM m 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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing -> STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    Just a
a  -> a -> STM m a
forall a. a -> STM m 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) = TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing  -> STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    Just a
old -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
new); a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
old

writeTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m ()
writeTMVarDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TMVarDefault m a -> a -> STM m ()
writeTMVarDefault (TMVar TVar m (Maybe a)
t) a
new = TVar m (Maybe a) -> Maybe a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
new)

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
  m <- TVar m (Maybe a) -> STM m (Maybe a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (Maybe a)
t
  case m of
    Maybe a
Nothing -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just a
_  -> Bool -> STM m Bool
forall a. a -> STM m 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
  TVar m [a] -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
read (String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-read")
  TVar m [a] -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
write (String
label String -> String -> String
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
  read  <- [a] -> STM m (TVar m [a])
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar []
  write <- newTVar []
  return (TQueue read 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
  listend <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
  writeTVar write (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 = STM m a -> (a -> STM m a) -> Maybe a -> STM m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m a) -> STM m (Maybe a) -> STM m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TQueueDefault m a -> STM m (Maybe a)
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
  xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  case xs of
    (a
x:[a]
xs') -> do
      TVar m [a] -> [a] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
xs'
      Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    [] -> do
      ys <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
      case reverse ys of
        []     -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        (a
z:[a]
zs) -> do
          TVar m [a] -> [a] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write []
          TVar m [a] -> [a] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
zs
          Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
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
  xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  case xs of
    (a
_:[a]
_) -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    [] -> do ys <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
             case ys of
               [] -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               [a]
_  -> Bool -> STM m Bool
forall a. a -> STM m 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
    xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case xs of
      (a
x:[a]
_) -> a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      [a]
_     -> STM m a
forall a. STM m 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
    xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case xs of
      (a
x:[a]
_) -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
      [a]
_     -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
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
  xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  ys <- readTVar write
  unless (null xs) $ writeTVar read []
  unless (null ys) $ writeTVar write []
  return (xs ++ reverse 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 = TVar m [a] -> ([a] -> [a]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar TVar m [a]
read (a
aa -> [a] -> [a]
forall 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
  TVar m Natural -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m Natural
rsize (String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-rsize")
  TVar m [a] -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
read (String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-read")
  TVar m Natural -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m Natural
wsize (String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-wsize")
  TVar m [a] -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m [a]
write (String
label String -> String -> String
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
  rsize <- Natural -> STM m (TVar m Natural)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar Natural
0
  read  <- newTVar []
  wsize <- newTVar size
  write <- newTVar []
  return (TBQueue rsize read wsize write 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 = STM m a -> (a -> STM m a) -> Maybe a -> STM m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> STM m a) -> STM m (Maybe a) -> STM m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TBQueueDefault m a -> STM m (Maybe a)
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
  xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  r <- readTVar rsize
  writeTVar rsize $! r + 1
  case xs of
    (a
x:[a]
xs') -> do
      TVar m [a] -> [a] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
xs'
      Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    [] -> do
      ys <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
      case reverse ys of
        [] -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

        -- NB. lazy: we want the transaction to be
        -- short, otherwise it will conflict
        (a
z:[a]
zs)  -> do
          TVar m [a] -> [a] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
write []
          TVar m [a] -> [a] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [a]
read [a]
zs
          Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
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
    xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case xs of
      (a
x:[a]
_) -> a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      [a]
_     -> STM m a
forall a. STM m 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
    xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
    case xs of
      (a
x:[a]
_) -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
      [a]
_     -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
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
  w <- TVar m Natural -> STM m Natural
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
wsize
  if (w > 0)
    then do writeTVar wsize $! w - 1
    else do
          r <- readTVar rsize
          if (r > 0)
            then do writeTVar rsize 0
                    writeTVar wsize $! r - 1
            else retry
  listend <- readTVar write
  writeTVar write (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
  xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  case xs of
    (a
_:[a]
_) -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    [] -> do ys <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
write
             case ys of
               [] -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               [a]
_  -> Bool -> STM m Bool
forall a. a -> STM m 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
  w <- TVar m Natural -> STM m Natural
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
wsize
  if (w > 0)
     then return False
     else do
         r <- readTVar rsize
         if (r > 0)
            then return False
            else return 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
  r <- TVar m Natural -> STM m Natural
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
  w <- readTVar wsize
  return $! size - r - 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
  xs <- TVar m [a] -> STM m [a]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [a]
read
  ys <- readTVar write
  if null xs && null ys
    then return []
    else do
      writeTVar read []
      writeTVar write []
      writeTVar rsize 0
      writeTVar wsize size
      return (xs ++ reverse 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
  r <- TVar m Natural -> STM m Natural
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Natural
rsize
  if (r > 0)
     then do writeTVar rsize $! r - 1
     else do
          w <- readTVar wsize
          if (w > 0)
             then writeTVar wsize $! w - 1
             else retry
  xs <- readTVar read
  writeTVar read (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) = (i, i) -> stm (i, i)
forall a. a -> stm a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array i (TVar m e) -> (i, i)
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
      a <- Int -> stm (TVar m e) -> stm [TVar m e]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (e -> STM m (TVar m e)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar e
e)
      return $ TArray (listArray b a)
    newArray_ :: forall i. Ix i => (i, i) -> stm (TArrayDefault m i e)
newArray_ (i, i)
b = do
      a <- Int -> stm (TVar m e) -> stm [TVar m e]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
rep ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
b) (e -> STM m (TVar m e)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar e
forall a. a
arrEleBottom)
      return $ TArray (listArray b a)
    unsafeRead :: forall i. Ix i => TArrayDefault m i e -> Int -> stm e
unsafeRead (TArray Array i (TVar m e)
a) Int
i = TVar m e -> STM m e
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar (TVar m e -> STM m e) -> TVar m e -> STM m e
forall a b. (a -> b) -> a -> b
$ Array i (TVar m e) -> Int -> TVar m e
forall i. Ix i => Array i (TVar m e) -> Int -> TVar m e
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 = TVar m e -> e -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar (Array i (TVar m e) -> Int -> TVar m e
forall i. Ix i => Array i (TVar m e) -> Int -> TVar m e
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) = Int -> stm Int
forall a. a -> stm a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array i (TVar m e) -> Int
forall i. Ix i => Array i (TVar m e) -> Int
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 = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
      go Int
i [a]
xs = do
          x <- m a
m
          go (i-1) (x: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 = Array i (TVar m e) -> [(i, TVar m e)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array i (TVar m e)
arr
    ((i, TVar m e) -> STM m ()) -> [(i, TVar m e)] -> STM m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\(i
i, TVar m e
v) -> TVar m e -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m e
v (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ i -> String
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) = TVar m Integer -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
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 = proxy m
-> TVar m Integer
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
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 = TVar m Integer -> TSemDefault m
forall (m :: * -> *). TVar m Integer -> TSemDefault m
TSem (TVar m Integer -> TSemDefault m)
-> STM m (TVar m Integer) -> STM m (TSemDefault m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> STM m (TVar m Integer)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (Integer -> STM m (TVar m Integer))
-> Integer -> STM m (TVar m Integer)
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
  i <- TVar m Integer -> STM m Integer
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Integer
t
  when (i <= 0) retry
  writeTVar t $! (i-1)

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

signalTSemNDefault :: MonadSTM m => Natural -> TSemDefault m -> STM m ()
signalTSemNDefault :: forall (m :: * -> *).
MonadSTM m =>
Natural -> TSemDefault m -> STM m ()
signalTSemNDefault Natural
0 TSemDefault m
_ = () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
signalTSemNDefault Natural
1 TSemDefault m
s = TSemDefault m -> STM m ()
forall (m :: * -> *). MonadSTM m => TSemDefault m -> STM m ()
signalTSemDefault TSemDefault m
s
signalTSemNDefault Natural
n (TSem TVar m Integer
t) = do
  i <- TVar m Integer -> STM m Integer
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m Integer
t
  writeTVar t $! i+(toInteger 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
  TVar m (TVarList m a) -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m (TVarList m a)
read  (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":read")
  TVar m (TVarList m a) -> String -> STM m ()
forall a. TVar m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
TVar m a -> String -> STM m ()
labelTVar TVar m (TVarList m a)
write (String
name String -> String -> String
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
  hole <- TList m a -> STM m (TVar m (TList m a))
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TList m a
forall (m :: * -> *) a. TList m a
TNil
  read <- newTVar hole
  write <- newTVar hole
  return (TChan read write)

newBroadcastTChanDefault :: MonadSTM m => STM m (TChanDefault m a)
newBroadcastTChanDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TChanDefault m a)
newBroadcastTChanDefault = do
    write_hole <- TList m a -> STM m (TVar m (TList m a))
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TList m a
forall (m :: * -> *) a. TList m a
TNil
    read <- newTVar (error "reading from a TChan created by newBroadcastTChan; use dupTChan first")
    write <- newTVar write_hole
    return (TChan read 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
  listend <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
write -- listend == TVar pointing to TNil
  new_listend <- newTVar TNil
  writeTVar listend (TCons a new_listend)
  writeTVar write 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
  listhead <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  head_ <- readTVar listhead
  case head_ of
    TList m a
TNil -> STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    TCons a
a TVarList m a
tail_ -> do
        TVar m (TVarList m a) -> TVarList m a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (TVarList m a)
read TVarList m a
tail_
        a -> STM m a
forall a. a -> STM m a
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
  listhead <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  head_ <- readTVar listhead
  case head_ of
    TList m a
TNil       -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    TCons a
a TVarList m a
tl -> do
      TVar m (TVarList m a) -> TVarList m a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m (TVarList m a)
read TVarList m a
tl
      Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
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
  listhead <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  head_ <- readTVar listhead
  case head_ of
    TList m a
TNil      -> STM m a
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    TCons a
a TVarList m a
_ -> a -> STM m a
forall a. a -> STM 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
  listhead <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  head_ <- readTVar listhead
  case head_ of
    TList m a
TNil      -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    TCons a
a TVarList m a
_ -> Maybe a -> STM m (Maybe a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
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
  hole <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
write
  new_read <- newTVar hole
  return (TChan new_read 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
   listhead <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
   newhead <- newTVar (TCons a listhead)
   writeTVar read 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
  listhead <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  head_ <- readTVar listhead
  case head_ of
    TList m a
TNil      -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    TCons a
_ TVarList m a
_ -> Bool -> STM m Bool
forall a. a -> STM 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
  readpos <- TVar m (TVarList m a) -> STM m (TVarList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (TVarList m a)
read
  new_read <- newTVar readpos
  return (TChan new_read 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 = e -> STM m a
forall e a. Exception e => e -> STM m a
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 = STM m a -> (e -> STM m a) -> STM m a
forall e a. Exception e => STM m a -> (e -> STM m a) -> STM m a
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) = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
r -> STM m a -> m a
forall a. HasCallStack => STM m a -> m a
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        = STM m (TVar m a) -> ReaderT r (STM m) (TVar m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TVar m a) -> ReaderT r (STM m) (TVar m a))
-> (a -> STM m (TVar m a)) -> a -> ReaderT r (STM m) (TVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> STM m (TVar m a)
forall a. a -> STM m (TVar m a)
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       = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TVar m a -> STM m a) -> TVar m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TVar m a -> STM m a
forall a. TVar m a -> STM m a
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      = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TVar m a -> a -> STM m ())
-> TVar m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TVar m a -> a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar
    retry :: forall a. STM (ReaderT r m) a
retry          = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m a
forall a. STM m a
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) = (r -> STM m a) -> ReaderT r (STM m) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> STM m a) -> ReaderT r (STM m) a)
-> (r -> STM m a) -> ReaderT r (STM m) a
forall a b. (a -> b) -> a -> b
$ \r
r -> r -> STM m a
a r
r STM m a -> STM m a -> STM m a
forall a. STM m a -> STM m a -> STM m a
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     = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TVar m a -> (a -> a) -> STM m ())
-> TVar m a
-> (a -> a)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TVar m a -> (a -> a) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
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'    = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TVar m a -> (a -> a) -> STM m ())
-> TVar m a
-> (a -> a)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TVar m a -> (a -> a) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
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      = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TVar m s -> (s -> (a, s)) -> STM m a)
-> TVar m s
-> (s -> (a, s))
-> ReaderT r (STM m) a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TVar m s -> (s -> (a, s)) -> STM m a
forall s a. TVar m s -> (s -> (a, s)) -> STM m a
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       = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TVar m a -> a -> STM m a)
-> TVar m a
-> a
-> ReaderT r (STM m) a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TVar m a -> a -> STM m a
forall a. TVar m a -> a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m a
swapTVar
    check :: Bool -> STM (ReaderT r m) ()
check          = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift  (STM m () -> ReaderT r (STM m) ())
-> (Bool -> STM m ()) -> Bool -> ReaderT r (STM m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> STM m ()
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       = STM m (TMVar m a) -> ReaderT r (STM m) (TMVar m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TMVar m a) -> ReaderT r (STM m) (TMVar m a))
-> (a -> STM m (TMVar m a)) -> a -> ReaderT r (STM m) (TMVar m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> STM m (TMVar m a)
forall a. a -> STM m (TMVar m a)
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  = STM m (TMVar m a) -> ReaderT r (STM m) (TMVar m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m (TMVar m a)
forall a. STM m (TMVar m a)
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      = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TMVar m a -> STM m a) -> TMVar m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m a
forall a. TMVar m a -> STM m a
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   = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TMVar m a -> STM m (Maybe a))
-> TMVar m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m (Maybe a)
forall a. TMVar m a -> STM m (Maybe a)
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       = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TMVar m a -> a -> STM m ())
-> TMVar m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TMVar m a -> a -> STM m ()
forall a. TMVar m a -> a -> STM m ()
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    = STM m Bool -> ReaderT r (STM m) Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> ReaderT r (STM m) Bool)
-> (TMVar m a -> a -> STM m Bool)
-> TMVar m a
-> a
-> ReaderT r (STM m) Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TMVar m a -> a -> STM m Bool
forall a. TMVar m a -> a -> STM m Bool
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      = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TMVar m a -> STM m a) -> TMVar m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m a
forall a. TMVar m a -> STM m a
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   = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TMVar m a -> STM m (Maybe a))
-> TMVar m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m (Maybe a)
forall a. TMVar m a -> STM m (Maybe a)
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      = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TMVar m a -> a -> STM m a)
-> TMVar m a
-> a
-> ReaderT r (STM m) a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TMVar m a -> a -> STM m a
forall a. TMVar m a -> a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m a
swapTMVar
    writeTMVar :: forall a. TMVar (ReaderT r m) a -> a -> STM (ReaderT r m) ()
writeTMVar     = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TMVar m a -> a -> STM m ())
-> TMVar m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TMVar m a -> a -> STM m ()
forall a. TMVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> a -> STM m ()
writeTMVar
    isEmptyTMVar :: forall a. TMVar (ReaderT r m) a -> STM (ReaderT r m) Bool
isEmptyTMVar   = STM m Bool -> ReaderT r (STM m) Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> ReaderT r (STM m) Bool)
-> (TMVar m a -> STM m Bool) -> TMVar m a -> ReaderT r (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TMVar m a -> STM m Bool
forall a. TMVar m a -> STM m Bool
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      = STM m (TQueue m a) -> ReaderT r (STM m) (TQueue m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift STM m (TQueue m a)
forall a. STM m (TQueue m a)
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     = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TQueue m a -> STM m a) -> TQueue m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m a
forall a. TQueue m a -> STM m a
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  = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TQueue m a -> STM m (Maybe a))
-> TQueue m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m (Maybe a)
forall a. TQueue m a -> STM m (Maybe a)
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     = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TQueue m a -> STM m a) -> TQueue m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m a
forall a. TQueue m a -> STM m a
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  = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TQueue m a -> STM m (Maybe a))
-> TQueue m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m (Maybe a)
forall a. TQueue m a -> STM m (Maybe a)
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    = STM m [a] -> ReaderT r (STM m) [a]
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m [a] -> ReaderT r (STM m) [a])
-> (TQueue m a -> STM m [a]) -> TQueue m a -> ReaderT r (STM m) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m [a]
forall a. TQueue m a -> STM m [a]
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  = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (a -> STM m ()) -> a -> ReaderT r (STM m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> a -> STM m ()
forall a. TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue m a
TQueue (ReaderT r m) a
v
    isEmptyTQueue :: forall a. TQueue (ReaderT r m) a -> STM (ReaderT r m) Bool
isEmptyTQueue  = STM m Bool -> ReaderT r (STM m) Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> ReaderT r (STM m) Bool)
-> (TQueue m a -> STM m Bool)
-> TQueue m a
-> ReaderT r (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TQueue m a -> STM m Bool
forall a. TQueue m a -> STM m Bool
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    = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TQueue m a -> a -> STM m ())
-> TQueue m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TQueue m a -> a -> STM m ()
forall a. TQueue m a -> a -> STM m ()
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     = STM m (TBQueue m a) -> ReaderT r (STM m) (TBQueue m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TBQueue m a) -> ReaderT r (STM m) (TBQueue m a))
-> (Natural -> STM m (TBQueue m a))
-> Natural
-> ReaderT r (STM m) (TBQueue m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Natural -> STM m (TBQueue m a)
forall a. Natural -> STM m (TBQueue m a)
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    = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TBQueue m a -> STM m a) -> TBQueue m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m a
forall a. TBQueue m a -> STM m a
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 = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TBQueue m a -> STM m (Maybe a))
-> TBQueue m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m (Maybe a)
forall a. TBQueue m a -> STM m (Maybe a)
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    = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TBQueue m a -> STM m a) -> TBQueue m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m a
forall a. TBQueue m a -> STM m a
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 = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TBQueue m a -> STM m (Maybe a))
-> TBQueue m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m (Maybe a)
forall a. TBQueue m a -> STM m (Maybe a)
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   = STM m [a] -> ReaderT r (STM m) [a]
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m [a] -> ReaderT r (STM m) [a])
-> (TBQueue m a -> STM m [a])
-> TBQueue m a
-> ReaderT r (STM m) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m [a]
forall a. TBQueue m a -> STM m [a]
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   = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TBQueue m a -> a -> STM m ())
-> TBQueue m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TBQueue m a -> a -> STM m ()
forall a. TBQueue m a -> a -> STM m ()
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  = STM m Natural -> ReaderT r (STM m) Natural
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Natural -> ReaderT r (STM m) Natural)
-> (TBQueue m a -> STM m Natural)
-> TBQueue m a
-> ReaderT r (STM m) Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m Natural
forall a. TBQueue m a -> STM m Natural
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 = STM m Bool -> ReaderT r (STM m) Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> ReaderT r (STM m) Bool)
-> (TBQueue m a -> STM m Bool)
-> TBQueue m a
-> ReaderT r (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m Bool
forall a. TBQueue m a -> STM m Bool
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  = STM m Bool -> ReaderT r (STM m) Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> ReaderT r (STM m) Bool)
-> (TBQueue m a -> STM m Bool)
-> TBQueue m a
-> ReaderT r (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TBQueue m a -> STM m Bool
forall a. TBQueue m a -> STM m Bool
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   = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TBQueue m a -> a -> STM m ())
-> TBQueue m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TBQueue m a -> a -> STM m ()
forall a. TBQueue m a -> a -> STM m ()
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        = STM m (TSem m) -> ReaderT r (STM m) (TSem m)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TSem m) -> ReaderT r (STM m) (TSem m))
-> (Integer -> STM m (TSem m))
-> Integer
-> ReaderT r (STM m) (TSem m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Integer -> STM m (TSem m)
forall (m :: * -> *). MonadSTM m => Integer -> STM m (TSem m)
newTSem
    waitTSem :: TSem (ReaderT r m) -> STM (ReaderT r m) ()
waitTSem       = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TSem m -> STM m ()) -> TSem m -> ReaderT r (STM m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TSem m -> STM m ()
forall (m :: * -> *). MonadSTM m => TSem m -> STM m ()
waitTSem
    signalTSem :: TSem (ReaderT r m) -> STM (ReaderT r m) ()
signalTSem     = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TSem m -> STM m ()) -> TSem m -> ReaderT r (STM m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TSem m -> STM m ()
forall (m :: * -> *). MonadSTM m => TSem m -> STM m ()
signalTSem
    signalTSemN :: Natural -> TSem (ReaderT r m) -> STM (ReaderT r m) ()
signalTSemN    = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (Natural -> TSem m -> STM m ())
-> Natural
-> TSem m
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Natural -> TSem m -> STM m ()
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          = STM m (TChan m a) -> ReaderT r (STM m) (TChan m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m (TChan m a)
forall a. STM m (TChan m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TChan m a)
newTChan
    newBroadcastTChan :: forall a. STM (ReaderT r m) (TChan (ReaderT r m) a)
newBroadcastTChan = STM m (TChan m a) -> ReaderT r (STM m) (TChan m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift    STM m (TChan m a)
forall a. STM m (TChan m a)
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          = STM m (TChan m a) -> ReaderT r (STM m) (TChan m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TChan m a) -> ReaderT r (STM m) (TChan m a))
-> (TChan m a -> STM m (TChan m a))
-> TChan m a
-> ReaderT r (STM m) (TChan m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m (TChan m a)
forall a. TChan m a -> STM m (TChan m a)
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        = STM m (TChan m a) -> ReaderT r (STM m) (TChan m a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (TChan m a) -> ReaderT r (STM m) (TChan m a))
-> (TChan m a -> STM m (TChan m a))
-> TChan m a
-> ReaderT r (STM m) (TChan m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m (TChan m a)
forall a. TChan m a -> STM m (TChan m a)
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         = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TChan m a -> STM m a) -> TChan m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m a
forall a. TChan m a -> STM m a
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      = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TChan m a -> STM m (Maybe a))
-> TChan m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m (Maybe a)
forall a. TChan m a -> STM m (Maybe a)
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         = STM m a -> ReaderT r (STM m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> ReaderT r (STM m) a)
-> (TChan m a -> STM m a) -> TChan m a -> ReaderT r (STM m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m a
forall a. TChan m a -> STM m a
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      = STM m (Maybe a) -> ReaderT r (STM m) (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m (Maybe a) -> ReaderT r (STM m) (Maybe a))
-> (TChan m a -> STM m (Maybe a))
-> TChan m a
-> ReaderT r (STM m) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m (Maybe a)
forall a. TChan m a -> STM m (Maybe a)
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        = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TChan m a -> a -> STM m ())
-> TChan m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TChan m a -> a -> STM m ()
forall a. TChan m a -> a -> STM m ()
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        = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TChan m a -> a -> STM m ())
-> TChan m a
-> a
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: TChan m a -> a -> STM m ()
forall a. TChan m a -> a -> STM m ()
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      = STM m Bool -> ReaderT r (STM m) Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m Bool -> ReaderT r (STM m) Bool)
-> (TChan m a -> STM m Bool) -> TChan m a -> ReaderT r (STM m) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TChan m a -> STM m Bool
forall a. TChan m a -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TChan m a -> STM m Bool
isEmptyTChan

instance MonadInspectSTM m => MonadInspectSTM (ReaderT r m) where
  type InspectMonad (ReaderT r m) = InspectMonad m
  inspectTVar :: forall (proxy :: (* -> *) -> *) a.
proxy (ReaderT r m)
-> TVar (ReaderT r m) a -> InspectMonad (ReaderT r m) a
inspectTVar  proxy (ReaderT r m)
_ = Proxy m -> TVar m a -> InspectMonad m a
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadInspectSTM m =>
proxy m -> TVar m a -> InspectMonad m a
forall (proxy :: (* -> *) -> *) a.
proxy m -> TVar m a -> InspectMonad m a
inspectTVar  (Proxy m
forall {k} (t :: k). Proxy t
Proxy :: Proxy m)
  inspectTMVar :: forall (proxy :: (* -> *) -> *) a.
proxy (ReaderT r m)
-> TMVar (ReaderT r m) a -> InspectMonad (ReaderT r m) (Maybe a)
inspectTMVar proxy (ReaderT r m)
_ = Proxy m -> TMVar m a -> InspectMonad m (Maybe a)
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadInspectSTM m =>
proxy m -> TMVar m a -> InspectMonad m (Maybe a)
forall (proxy :: (* -> *) -> *) a.
proxy m -> TMVar m a -> InspectMonad m (Maybe a)
inspectTMVar (Proxy m
forall {k} (t :: k). Proxy t
Proxy :: Proxy m)

instance MonadTraceSTM m => MonadTraceSTM (ReaderT r m) where
  traceTVar :: forall (proxy :: (* -> *) -> *) a.
proxy (ReaderT r m)
-> TVar (ReaderT r m) a
-> (Maybe a -> a -> InspectMonad (ReaderT r m) TraceValue)
-> STM (ReaderT r m) ()
traceTVar    proxy (ReaderT r m)
_ = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TVar m a
    -> (Maybe a -> a -> InspectMonad m TraceValue) -> STM m ())
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TVar m a
-> (Maybe a -> a -> InspectMonad m TraceValue)
-> STM m ()
traceTVar    Proxy m
forall {k} (t :: k). Proxy t
Proxy
  traceTMVar :: forall (proxy :: (* -> *) -> *) a.
proxy (ReaderT r m)
-> TMVar (ReaderT r m) a
-> (Maybe (Maybe a)
    -> Maybe a -> InspectMonad (ReaderT r m) TraceValue)
-> STM (ReaderT r m) ()
traceTMVar   proxy (ReaderT r m)
_ = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TMVar m a
    -> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
    -> STM m ())
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVar   Proxy m
forall {k} (t :: k). Proxy t
Proxy
  traceTQueue :: forall (proxy :: (* -> *) -> *) a.
proxy (ReaderT r m)
-> TQueue (ReaderT r m) a
-> (Maybe [a] -> [a] -> InspectMonad (ReaderT r m) TraceValue)
-> STM (ReaderT r m) ()
traceTQueue  proxy (ReaderT r m)
_ = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TQueue m a
    -> (Maybe [a] -> [a] -> InspectMonad m TraceValue) -> STM m ())
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTQueue  Proxy m
forall {k} (t :: k). Proxy t
Proxy
  traceTBQueue :: forall (proxy :: (* -> *) -> *) a.
proxy (ReaderT r m)
-> TBQueue (ReaderT r m) a
-> (Maybe [a] -> [a] -> InspectMonad (ReaderT r m) TraceValue)
-> STM (ReaderT r m) ()
traceTBQueue proxy (ReaderT r m)
_ = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TBQueue m a
    -> (Maybe [a] -> [a] -> InspectMonad m TraceValue) -> STM m ())
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *) a.
proxy m
-> TBQueue m a
-> (Maybe [a] -> [a] -> InspectMonad m TraceValue)
-> STM m ()
traceTBQueue Proxy m
forall {k} (t :: k). Proxy t
Proxy
  traceTSem :: forall (proxy :: (* -> *) -> *).
proxy (ReaderT r m)
-> TSem (ReaderT r m)
-> (Maybe Integer
    -> Integer -> InspectMonad (ReaderT r m) TraceValue)
-> STM (ReaderT r m) ()
traceTSem    proxy (ReaderT r m)
_ = STM m () -> ReaderT r (STM m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m () -> ReaderT r (STM m) ())
-> (TSem m
    -> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
    -> STM m ())
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> ReaderT r (STM m) ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadTraceSTM m =>
proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
forall (proxy :: (* -> *) -> *).
proxy m
-> TSem m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
traceTSem    Proxy m
forall {k} (t :: k). Proxy t
Proxy

(.:) :: (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)

-- TODO: writeTMVar was introduced in stm-2.5.1. But io-sim supports stm older than that
-- Therefore this can be removed once we don't need backwards compatibility with stm.
#if !MIN_VERSION_stm(2,5,1)
writeTMVar' :: STM.TMVar a -> a -> STM.STM ()
writeTMVar' t new = STM.tryTakeTMVar t >> STM.putTMVar t new
#endif