{-# 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
  ) 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
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
a, s
s') = s -> (a, s)
f s
s
   TVar m s -> s -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m s
var s
s'
   a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

swapTVarDefault :: MonadSTM m => TVar m a -> a -> STM m a
swapTVarDefault :: forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m a
swapTVarDefault TVar m a
var a
new = do
    a
old <- 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
    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
var a
new
    a -> STM m a
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
old


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

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

  --
  -- default implementations
  --

  default labelTMVar :: TMVar m ~ TMVarDefault m
                     => TMVar m a -> String -> STM m ()
  labelTMVar = TMVarDefault m a -> String -> STM m ()
TMVar 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 = TQueueDefault m a -> String -> STM m ()
TQueue 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 = TBQueueDefault m a -> String -> STM m ()
TBQueue 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 = TSemDefault m -> String -> STM m ()
TSem 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 = TChanDefault m a -> String -> STM m ()
TChan 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 = TArrayDefault m i e -> String -> STM m ()
TArray 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 $mTraceDynamic :: forall {r}.
TraceValue
-> (forall {tr}. Typeable tr => tr -> r) -> ((# #) -> r) -> r
$bTraceDynamic :: forall tr. Typeable tr => tr -> TraceValue
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 $mTraceString :: forall {r}. TraceValue -> (String -> r) -> ((# #) -> r) -> r
$bTraceString :: String -> TraceValue
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 $mDontTrace :: forall {r}. TraceValue -> ((# #) -> r) -> ((# #) -> r) -> r
$bDontTrace :: TraceValue
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
-> TMVarDefault m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
proxy m
-> TMVar 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
-> TSemDefault m
-> (Maybe Integer -> Integer -> InspectMonad m TraceValue)
-> STM m ()
proxy m
-> TSem 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)


--
-- 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 -> ShowS
[BlockedIndefinitely] -> ShowS
BlockedIndefinitely -> String
(Int -> BlockedIndefinitely -> ShowS)
-> (BlockedIndefinitely -> String)
-> ([BlockedIndefinitely] -> ShowS)
-> Show BlockedIndefinitely
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockedIndefinitely -> ShowS
showsPrec :: Int -> BlockedIndefinitely -> ShowS
$cshow :: BlockedIndefinitely -> String
show :: BlockedIndefinitely -> String
$cshowList :: [BlockedIndefinitely] -> ShowS
showList :: [BlockedIndefinitely] -> ShowS
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. 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
  TVar m (Maybe a)
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)
  TMVarDefault m a -> STM m (TMVarDefault m a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar m (Maybe a) -> TMVarDefault m a
forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar m (Maybe a)
t)

newEmptyTMVarDefault :: MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault = do
  TVar m (Maybe a)
t <- 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
  TMVarDefault m a -> STM m (TMVarDefault m a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar m (Maybe a) -> TMVarDefault m a
forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar m (Maybe a)
t)

takeTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m a
takeTMVarDefault :: forall (m :: * -> *) a. MonadSTM m => TMVarDefault m a -> STM m a
takeTMVarDefault (TMVar TVar m (Maybe a)
t) = do
  Maybe a
m <- 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 Maybe a
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
  Maybe a
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 Maybe a
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
  Maybe a
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 Maybe a
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
  Maybe a
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 Maybe a
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
  Maybe a
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 Maybe a
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
  Maybe a
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 Maybe a
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
  Maybe a
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 Maybe a
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 -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-write")

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

writeTQueueDefault :: MonadSTM m => TQueueDefault m a -> a -> STM m ()
writeTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> a -> STM m ()
writeTQueueDefault (TQueue TVar m [a]
_read TVar m [a]
write) a
a = do
  [a]
listend <- 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
  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 (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
listend)

readTQueueDefault :: MonadSTM m => TQueueDefault m a -> STM m a
readTQueueDefault :: forall (m :: * -> *) a. MonadSTM m => TQueueDefault m a -> STM m a
readTQueueDefault TQueueDefault m a
queue = 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
  [a]
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 [a]
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
      [a]
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 [a] -> [a]
forall a. [a] -> [a]
reverse [a]
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
  [a]
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 [a]
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 [a]
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 [a]
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
    [a]
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 [a]
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
    [a]
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 [a]
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
  [a]
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
  [a]
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
  Bool -> STM m () -> STM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs) (STM m () -> STM m ()) -> STM m () -> STM m ()
forall a b. (a -> b) -> a -> 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]
read []
  Bool -> STM m () -> STM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys) (STM m () -> STM m ()) -> STM m () -> STM m ()
forall a b. (a -> b) -> a -> 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]
write []
  [a] -> STM m [a]
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys)

unGetTQueueDefault :: MonadSTM m => TQueueDefault m a -> a -> STM m ()
unGetTQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TQueueDefault m a -> a -> STM m ()
unGetTQueueDefault (TQueue TVar m [a]
read TVar m [a]
_write) a
a = 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 -> ShowS
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 -> ShowS
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 -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-write")

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

readTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m a
readTBQueueDefault :: forall (m :: * -> *) a. MonadSTM m => TBQueueDefault m a -> STM m a
readTBQueueDefault TBQueueDefault m a
queue = 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
  [a]
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
  Natural
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
  TVar m Natural -> Natural -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
rsize (Natural -> STM m ()) -> Natural -> STM m ()
forall a b. (a -> b) -> a -> b
$! Natural
r Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
  case [a]
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
      [a]
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 [a] -> [a]
forall a. [a] -> [a]
reverse [a]
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
    [a]
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 [a]
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
    [a]
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 [a]
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
  Natural
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 (Natural
w Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
    then do TVar m Natural -> Natural -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
wsize (Natural -> STM m ()) -> Natural -> STM m ()
forall a b. (a -> b) -> a -> b
$! Natural
w Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
    else do
          Natural
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 (Natural
r Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
            then do TVar m Natural -> Natural -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
rsize Natural
0
                    TVar m Natural -> Natural -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Natural
wsize (Natural -> STM m ()) -> Natural -> STM m ()
forall a b. (a -> b) -> a -> b
$! Natural
r Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
            else STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  [a]
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
  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 (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
listend)

isEmptyTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault (TBQueue TVar m Natural
_rsize TVar m [a]
read TVar m Natural
_wsize TVar m [a]
write Natural
_size) = do
  [a]
xs <- 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 [a]
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 [a]
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 [a]
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
  Natural
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 (Natural
w Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
     then Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
     else do
         Natural
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 (Natural
r Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0)
            then Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

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


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

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


--
-- Default `TArray` implementation
--

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

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

instance (Monad stm, MonadSTM m, stm ~ STM m)
      => MArray (TArrayDefault m) e stm where
    getBounds :: forall i. Ix i => TArrayDefault m i e -> stm (i, i)
getBounds (TArray Array i (TVar m e)
a) = (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
      [TVar m e]
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)
      TArrayDefault m i e -> stm (TArrayDefault m i e)
forall a. a -> stm a
forall (m :: * -> *) a. Monad m => a -> m a
return (TArrayDefault m i e -> stm (TArrayDefault m i e))
-> TArrayDefault m i e -> stm (TArrayDefault m i e)
forall a b. (a -> b) -> a -> b
$ Array i (TVar m e) -> TArrayDefault m i e
forall (m :: * -> *) i e. Array i (TVar m e) -> TArrayDefault m i e
TArray ((i, i) -> [TVar m e] -> Array i (TVar m e)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b [TVar m e]
a)
    newArray_ :: forall i. Ix i => (i, i) -> stm (TArrayDefault m i e)
newArray_ (i, i)
b = do
      [TVar m e]
a <- 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)
      TArrayDefault m i e -> stm (TArrayDefault m i e)
forall a. a -> stm a
forall (m :: * -> *) a. Monad m => a -> m a
return (TArrayDefault m i e -> stm (TArrayDefault m i e))
-> TArrayDefault m i e -> stm (TArrayDefault m i e)
forall a b. (a -> b) -> a -> b
$ Array i (TVar m e) -> TArrayDefault m i e
forall (m :: * -> *) i e. Array i (TVar m e) -> TArrayDefault m i e
TArray ((i, i) -> [TVar m e] -> Array i (TVar m e)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b [TVar m e]
a)
    unsafeRead :: forall i. Ix i => TArrayDefault m i e -> Int -> stm e
unsafeRead (TArray Array i (TVar m e)
a) Int
i = 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
          a
x <- m a
m
          Int -> [a] -> m [a]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

labelTArrayDefault :: ( MonadLabelledSTM m
                      , Ix i
                      , Show i
                      )
                   => TArrayDefault m i e -> String -> STM m ()
labelTArrayDefault :: forall (m :: * -> *) i e.
(MonadLabelledSTM m, Ix i, Show i) =>
TArrayDefault m i e -> String -> STM m ()
labelTArrayDefault (TArray Array i (TVar m e)
arr) String
name = do
    let as :: [(i, TVar m e)]
as = 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
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
  Integer
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
  Bool -> STM m () -> STM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0) STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
  TVar m Integer -> Integer -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Integer
t (Integer -> STM m ()) -> Integer -> STM m ()
forall a b. (a -> b) -> a -> b
$! (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)

signalTSemDefault :: MonadSTM m => TSemDefault m -> STM m ()
signalTSemDefault :: forall (m :: * -> *). MonadSTM m => TSemDefault m -> STM m ()
signalTSemDefault (TSem TVar m Integer
t) = do
  Integer
i <- 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
  TVar m Integer -> Integer -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Integer
t (Integer -> STM m ()) -> Integer -> STM m ()
forall a b. (a -> b) -> a -> b
$! Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1

signalTSemNDefault :: MonadSTM m => Natural -> TSemDefault m -> STM m ()
signalTSemNDefault :: forall (m :: * -> *).
MonadSTM m =>
Natural -> TSemDefault m -> STM m ()
signalTSemNDefault Natural
0 TSemDefault m
_ = () -> 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
  Integer
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
  TVar m Integer -> Integer -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m Integer
t (Integer -> STM m ()) -> Integer -> STM m ()
forall a b. (a -> b) -> a -> b
$! Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+(Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n)

--
-- Default `TChan` implementation
--

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

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

labelTChanDefault :: MonadLabelledSTM m => TChanDefault m a -> String -> STM m ()
labelTChanDefault :: forall (m :: * -> *) a.
MonadLabelledSTM m =>
TChanDefault m a -> String -> STM m ()
labelTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
write) String
name = do
  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 -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":write")

newTChanDefault :: MonadSTM m => STM m (TChanDefault m a)
newTChanDefault :: forall (m :: * -> *) a. MonadSTM m => STM m (TChanDefault m a)
newTChanDefault = do
  TVar m (TList m a)
hole <- 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
  TVar m (TVar m (TList m a))
read <- TVar m (TList m a) -> STM m (TVar 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 TVar m (TList m a)
hole
  TVar m (TVar m (TList m a))
write <- TVar m (TList m a) -> STM m (TVar 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 TVar m (TList m a)
hole
  TChanDefault m a -> STM m (TChanDefault m a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar m (TVar m (TList m a))
-> TVar m (TVar m (TList m a)) -> TChanDefault m a
forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVar m (TList m a))
read TVar m (TVar m (TList m a))
write)

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

writeTChanDefault :: MonadSTM m => TChanDefault m a -> a -> STM m ()
writeTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> a -> STM m ()
writeTChanDefault (TChan TVar m (TVarList m a)
_read TVar m (TVarList m a)
write) a
a = do
  TVarList m a
listend <- 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
  TVarList m a
new_listend <- TList m a -> STM m (TVarList 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
  TVarList m a -> TList m a -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVarList m a
listend (a -> TVarList m a -> TList m a
forall (m :: * -> *) a. a -> TVarList m a -> TList m a
TCons a
a TVarList m a
new_listend)
  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)
write TVarList m a
new_listend

readTChanDefault :: MonadSTM m => TChanDefault m a -> STM m a
readTChanDefault :: forall (m :: * -> *) a. MonadSTM m => TChanDefault m a -> STM m a
readTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- 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
  TList m a
head_ <- TVarList m a -> STM m (TList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil -> 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
  TVarList m a
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
  TList m a
head_ <- TVarList m a -> STM m (TList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil       -> 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
  TVarList m a
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
  TList m a
head_ <- TVarList m a -> STM m (TList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil      -> 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
  TVarList m a
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
  TList m a
head_ <- TVarList m a -> STM m (TList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil      -> 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
  TVarList m a
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
  TVar m (TVarList m a)
new_read <- TVarList m a -> STM m (TVar m (TVarList m a))
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVarList m a
hole
  TChanDefault m a -> STM m (TChanDefault m a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVarList m a)
new_read TVar m (TVarList m a)
write)

unGetTChanDefault :: MonadSTM m => TChanDefault m a -> a -> STM m ()
unGetTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> a -> STM m ()
unGetTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) a
a = do
   TVarList m a
listhead <- 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
   TVarList m a
newhead <- TList m a -> STM m (TVarList m a)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar (a -> TVarList m a -> TList m a
forall (m :: * -> *) a. a -> TVarList m a -> TList m a
TCons a
a TVarList m a
listhead)
   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
newhead

isEmptyTChanDefault :: MonadSTM m => TChanDefault m a -> STM m Bool
isEmptyTChanDefault :: forall (m :: * -> *) a.
MonadSTM m =>
TChanDefault m a -> STM m Bool
isEmptyTChanDefault (TChan TVar m (TVarList m a)
read TVar m (TVarList m a)
_write) = do
  TVarList m a
listhead <- 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
  TList m a
head_ <- TVarList m a -> STM m (TList m a)
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVarList m a
listhead
  case TList m a
head_ of
    TList m a
TNil      -> 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
  TVarList m a
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
  TVar m (TVarList m a)
new_read <- TVarList m a -> STM m (TVar m (TVarList m a))
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar TVarList m a
readpos
  TChanDefault m a -> STM m (TChanDefault m a)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
forall (m :: * -> *) a.
TVar m (TVarList m a) -> TVar m (TVarList m a) -> TChanDefault m a
TChan TVar m (TVarList m a)
new_read TVar m (TVarList m a)
write)


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


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