{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
module Control.Monad.Class.MonadSTM
( MonadSTM (..)
, MonadSTMTx (..)
, LazyTVar
, LazyTMVar
, TVar
, TMVar
, TQueue
, TBQueue
, TMVarDefault (..)
, newTMVarDefault
, newTMVarIODefault
, newEmptyTMVarDefault
, newEmptyTMVarIODefault
, takeTMVarDefault
, tryTakeTMVarDefault
, putTMVarDefault
, tryPutTMVarDefault
, readTMVarDefault
, tryReadTMVarDefault
, swapTMVarDefault
, isEmptyTMVarDefault
, TQueueDefault (..)
, newTQueueDefault
, readTQueueDefault
, tryReadTQueueDefault
, writeTQueueDefault
, isEmptyTQueueDefault
, TBQueueDefault (..)
, newTBQueueDefault
, readTBQueueDefault
, tryReadTBQueueDefault
, writeTBQueueDefault
, isEmptyTBQueueDefault
, isFullTBQueueDefault
, lengthTBQueueDefault
, flushTBQueueDefault
, throwSTM
, catchSTM
, newTVarM
, newTMVarM
, newTMVarMDefault
, newEmptyTMVarM
, newEmptyTMVarMDefault
) where
import Prelude hiding (read)
import qualified Control.Concurrent.STM.TBQueue as STM
import qualified Control.Concurrent.STM.TMVar as STM
import qualified Control.Concurrent.STM.TQueue as STM
import qualified Control.Concurrent.STM.TVar as STM
import qualified Control.Monad.STM as STM
import qualified Control.Monad.Class.MonadThrow as MonadThrow
import Control.Applicative (Alternative (..))
import Control.Exception
import Control.Monad.Reader
import Data.Kind (Type)
import GHC.Stack
import Numeric.Natural (Natural)
{-# DEPRECATED LazyTVar "Renamed back to 'TVar'" #-}
{-# DEPRECATED LazyTMVar "Renamed back to 'TMVar'" #-}
type LazyTVar m = TVar m
type LazyTMVar m = TMVar m
class ( Monad stm
, Alternative stm
, MonadPlus stm
) => MonadSTMTx stm where
type TVar_ stm :: Type -> Type
newTVar :: a -> stm (TVar_ stm a)
readTVar :: TVar_ stm a -> stm a
writeTVar :: TVar_ stm a -> a -> stm ()
retry :: stm a
orElse :: stm a -> stm a -> stm a
modifyTVar :: TVar_ stm a -> (a -> a) -> stm ()
modifyTVar TVar_ stm a
v a -> a
f = TVar_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar_ stm a
v stm a -> (a -> stm ()) -> stm ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar_ stm a -> a -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar_ stm a
v (a -> stm ()) -> (a -> a) -> a -> stm ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f
modifyTVar' :: TVar_ stm a -> (a -> a) -> stm ()
modifyTVar' TVar_ stm a
v a -> a
f = TVar_ stm a -> stm a
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar_ stm a
v stm a -> (a -> stm ()) -> stm ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> TVar_ stm a -> a -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar_ stm a
v (a -> stm ()) -> a -> stm ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x
stateTVar :: TVar_ stm s -> (s -> (a, s)) -> stm a
stateTVar = TVar_ stm s -> (s -> (a, s)) -> stm a
forall (stm :: * -> *) s a.
MonadSTMTx stm =>
TVar_ stm s -> (s -> (a, s)) -> stm a
stateTVarDefault
check :: Bool -> stm ()
check Bool
True = () -> stm ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
check Bool
_ = stm ()
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
type TMVar_ stm :: Type -> Type
newTMVar :: a -> stm (TMVar_ stm a)
newEmptyTMVar :: stm (TMVar_ stm a)
takeTMVar :: TMVar_ stm a -> stm a
tryTakeTMVar :: TMVar_ stm a -> stm (Maybe a)
putTMVar :: TMVar_ stm a -> a -> stm ()
tryPutTMVar :: TMVar_ stm a -> a -> stm Bool
readTMVar :: TMVar_ stm a -> stm a
tryReadTMVar :: TMVar_ stm a -> stm (Maybe a)
swapTMVar :: TMVar_ stm a -> a -> stm a
isEmptyTMVar :: TMVar_ stm a -> stm Bool
type TQueue_ stm :: Type -> Type
newTQueue :: stm (TQueue_ stm a)
readTQueue :: TQueue_ stm a -> stm a
tryReadTQueue :: TQueue_ stm a -> stm (Maybe a)
writeTQueue :: TQueue_ stm a -> a -> stm ()
isEmptyTQueue :: TQueue_ stm a -> stm Bool
type TBQueue_ stm :: Type -> Type
newTBQueue :: Natural -> stm (TBQueue_ stm a)
readTBQueue :: TBQueue_ stm a -> stm a
tryReadTBQueue :: TBQueue_ stm a -> stm (Maybe a)
flushTBQueue :: TBQueue_ stm a -> stm [a]
writeTBQueue :: TBQueue_ stm a -> a -> stm ()
lengthTBQueue :: TBQueue_ stm a -> stm Natural
isEmptyTBQueue :: TBQueue_ stm a -> stm Bool
isFullTBQueue :: TBQueue_ stm a -> stm Bool
stateTVarDefault :: MonadSTMTx stm => TVar_ stm s -> (s -> (a, s)) -> stm a
stateTVarDefault :: TVar_ stm s -> (s -> (a, s)) -> stm a
stateTVarDefault TVar_ stm s
var s -> (a, s)
f = do
s
s <- TVar_ stm s -> stm s
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar_ stm s
var
let (a
a, s
s') = s -> (a, s)
f s
s
TVar_ stm s -> s -> stm ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar_ stm s
var s
s'
a -> stm a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
type TVar m = TVar_ (STM m)
type TMVar m = TMVar_ (STM m)
type TQueue m = TQueue_ (STM m)
type TBQueue m = TBQueue_ (STM m)
class (Monad m, MonadSTMTx (STM m)) => MonadSTM m where
type STM m :: Type -> Type
atomically :: HasCallStack => STM m a -> m a
newTVarIO :: a -> m (TVar m a)
newTMVarIO :: a -> m (TMVar m a)
newEmptyTMVarIO :: m (TMVar m a)
newTBQueueIO :: Natural -> m (TBQueue m a)
newTVarIO = STM m (TVar m a) -> m (TVar 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 (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar
newTMVarIO = STM m (TMVar m a) -> m (TMVar 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 (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TMVar_ stm a)
newTMVar
newEmptyTMVarIO = STM m (TMVar m a) -> m (TMVar m a)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (TMVar m a)
forall (stm :: * -> *) a. MonadSTMTx stm => stm (TMVar_ stm a)
newEmptyTMVar
newTBQueueIO = STM m (TBQueue m a) -> m (TBQueue 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 (stm :: * -> *) a.
MonadSTMTx stm =>
Natural -> stm (TBQueue_ stm a)
newTBQueue
newTVarM :: MonadSTM m => a -> m (TVar m a)
newTVarM :: a -> m (TVar m a)
newTVarM = a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO
{-# DEPRECATED newTVarM "Use newTVarIO" #-}
newTMVarM :: MonadSTM m => a -> m (TMVar m a)
newTMVarM :: a -> m (TMVar m a)
newTMVarM = a -> m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
newTMVarIO
{-# DEPRECATED newTMVarM "Use newTMVarIO" #-}
newEmptyTMVarM :: MonadSTM m => m (TMVar m a)
newEmptyTMVarM :: m (TMVar m a)
newEmptyTMVarM = m (TMVar m a)
forall (m :: * -> *) a. MonadSTM m => m (TMVar m a)
newEmptyTMVarIO
{-# DEPRECATED newEmptyTMVarM "Use newEmptyTMVarIO" #-}
instance MonadSTMTx STM.STM where
type TVar_ STM.STM = STM.TVar
type TMVar_ STM.STM = STM.TMVar
type TQueue_ STM.STM = STM.TQueue
type TBQueue_ STM.STM = STM.TBQueue
newTVar :: a -> STM (TVar_ STM a)
newTVar = a -> STM (TVar_ STM a)
forall a. a -> STM (TVar a)
STM.newTVar
readTVar :: TVar_ STM a -> STM a
readTVar = TVar_ STM a -> STM a
forall a. TVar a -> STM a
STM.readTVar
writeTVar :: TVar_ STM a -> a -> STM ()
writeTVar = TVar_ STM a -> a -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar
retry :: STM a
retry = STM a
forall a. STM a
STM.retry
orElse :: STM a -> STM a -> STM a
orElse = STM a -> STM a -> STM a
forall a. STM a -> STM a -> STM a
STM.orElse
modifyTVar :: TVar_ STM a -> (a -> a) -> STM ()
modifyTVar = TVar_ STM a -> (a -> a) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar
modifyTVar' :: TVar_ STM a -> (a -> a) -> STM ()
modifyTVar' = TVar_ STM a -> (a -> a) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar'
stateTVar :: TVar_ STM s -> (s -> (a, s)) -> STM a
stateTVar = TVar_ STM s -> (s -> (a, s)) -> STM a
forall s a. TVar s -> (s -> (a, s)) -> STM a
STM.stateTVar
check :: Bool -> STM ()
check = Bool -> STM ()
STM.check
newTMVar :: a -> STM (TMVar_ STM a)
newTMVar = a -> STM (TMVar_ STM a)
forall a. a -> STM (TMVar a)
STM.newTMVar
newEmptyTMVar :: STM (TMVar_ STM a)
newEmptyTMVar = STM (TMVar_ STM a)
forall a. STM (TMVar a)
STM.newEmptyTMVar
takeTMVar :: TMVar_ STM a -> STM a
takeTMVar = TMVar_ STM a -> STM a
forall a. TMVar a -> STM a
STM.takeTMVar
tryTakeTMVar :: TMVar_ STM a -> STM (Maybe a)
tryTakeTMVar = TMVar_ STM a -> STM (Maybe a)
forall a. TMVar a -> STM (Maybe a)
STM.tryTakeTMVar
putTMVar :: TMVar_ STM a -> a -> STM ()
putTMVar = TMVar_ STM a -> a -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar
tryPutTMVar :: TMVar_ STM a -> a -> STM Bool
tryPutTMVar = TMVar_ STM a -> a -> STM Bool
forall a. TMVar a -> a -> STM Bool
STM.tryPutTMVar
readTMVar :: TMVar_ STM a -> STM a
readTMVar = TMVar_ STM a -> STM a
forall a. TMVar a -> STM a
STM.readTMVar
tryReadTMVar :: TMVar_ STM a -> STM (Maybe a)
tryReadTMVar = TMVar_ STM a -> STM (Maybe a)
forall a. TMVar a -> STM (Maybe a)
STM.tryReadTMVar
swapTMVar :: TMVar_ STM a -> a -> STM a
swapTMVar = TMVar_ STM a -> a -> STM a
forall a. TMVar a -> a -> STM a
STM.swapTMVar
isEmptyTMVar :: TMVar_ STM a -> STM Bool
isEmptyTMVar = TMVar_ STM a -> STM Bool
forall a. TMVar a -> STM Bool
STM.isEmptyTMVar
newTQueue :: STM (TQueue_ STM a)
newTQueue = STM (TQueue_ STM a)
forall a. STM (TQueue a)
STM.newTQueue
readTQueue :: TQueue_ STM a -> STM a
readTQueue = TQueue_ STM a -> STM a
forall a. TQueue a -> STM a
STM.readTQueue
tryReadTQueue :: TQueue_ STM a -> STM (Maybe a)
tryReadTQueue = TQueue_ STM a -> STM (Maybe a)
forall a. TQueue a -> STM (Maybe a)
STM.tryReadTQueue
flushTBQueue :: TBQueue_ STM a -> STM [a]
flushTBQueue = TBQueue_ STM a -> STM [a]
forall a. TBQueue a -> STM [a]
STM.flushTBQueue
writeTQueue :: TQueue_ STM a -> a -> STM ()
writeTQueue = TQueue_ STM a -> a -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue
isEmptyTQueue :: TQueue_ STM a -> STM Bool
isEmptyTQueue = TQueue_ STM a -> STM Bool
forall a. TQueue a -> STM Bool
STM.isEmptyTQueue
newTBQueue :: Natural -> STM (TBQueue_ STM a)
newTBQueue = Natural -> STM (TBQueue_ STM a)
forall a. Natural -> STM (TBQueue a)
STM.newTBQueue
readTBQueue :: TBQueue_ STM a -> STM a
readTBQueue = TBQueue_ STM a -> STM a
forall a. TBQueue a -> STM a
STM.readTBQueue
tryReadTBQueue :: TBQueue_ STM a -> STM (Maybe a)
tryReadTBQueue = TBQueue_ STM a -> STM (Maybe a)
forall a. TBQueue a -> STM (Maybe a)
STM.tryReadTBQueue
writeTBQueue :: TBQueue_ STM a -> a -> STM ()
writeTBQueue = TBQueue_ STM a -> a -> STM ()
forall a. TBQueue a -> a -> STM ()
STM.writeTBQueue
lengthTBQueue :: TBQueue_ STM a -> STM Natural
lengthTBQueue = TBQueue_ STM a -> STM Natural
forall a. TBQueue a -> STM Natural
STM.lengthTBQueue
isEmptyTBQueue :: TBQueue_ STM a -> STM Bool
isEmptyTBQueue = TBQueue_ STM a -> STM Bool
forall a. TBQueue a -> STM Bool
STM.isEmptyTBQueue
isFullTBQueue :: TBQueue_ STM a -> STM Bool
isFullTBQueue = TBQueue_ STM a -> STM Bool
forall a. TBQueue a -> STM Bool
STM.isFullTBQueue
instance MonadSTM IO where
type STM IO = STM.STM
atomically :: 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
newTVarIO :: a -> IO (TVar IO a)
newTVarIO = a -> IO (TVar IO a)
forall a. a -> IO (TVar a)
STM.newTVarIO
newTMVarIO :: a -> IO (TMVar IO a)
newTMVarIO = a -> IO (TMVar IO a)
forall a. a -> IO (TMVar a)
STM.newTMVarIO
newEmptyTMVarIO :: IO (TMVar IO a)
newEmptyTMVarIO = IO (TMVar IO a)
forall a. IO (TMVar a)
STM.newEmptyTMVarIO
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
showList :: [BlockedIndefinitely] -> ShowS
$cshowList :: [BlockedIndefinitely] -> ShowS
show :: BlockedIndefinitely -> String
$cshow :: BlockedIndefinitely -> String
showsPrec :: Int -> BlockedIndefinitely -> ShowS
$cshowsPrec :: Int -> BlockedIndefinitely -> ShowS
Show)
instance Exception BlockedIndefinitely where
displayException :: BlockedIndefinitely -> String
displayException (BlockedIndefinitely CallStack
cs BlockedIndefinitelyOnSTM
e) = [String] -> String
unlines [
BlockedIndefinitelyOnSTM -> String
forall e. Exception e => e -> String
displayException BlockedIndefinitelyOnSTM
e
, CallStack -> String
prettyCallStack CallStack
cs
]
wrapBlockedIndefinitely :: HasCallStack => IO a -> IO a
wrapBlockedIndefinitely :: 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)
instance MonadSTM m => MonadSTM (ReaderT r m) where
type STM (ReaderT r m) = STM m
atomically :: STM (ReaderT r m) a -> ReaderT r m a
atomically = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (STM m a -> m a) -> STM m a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically
newTVarIO :: a -> ReaderT r m (TVar (ReaderT r m) a)
newTVarIO = m (TVar_ (STM m) a) -> ReaderT r m (TVar_ (STM m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar_ (STM m) a) -> ReaderT r m (TVar_ (STM m) a))
-> (a -> m (TVar_ (STM m) a)) -> a -> ReaderT r m (TVar_ (STM m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (TVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarM
newTMVarIO :: a -> ReaderT r m (TMVar (ReaderT r m) a)
newTMVarIO = m (TMVar_ (STM m) a) -> ReaderT r m (TMVar_ (STM m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TMVar_ (STM m) a) -> ReaderT r m (TMVar_ (STM m) a))
-> (a -> m (TMVar_ (STM m) a))
-> a
-> ReaderT r m (TMVar_ (STM m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (TMVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVar m a)
newTMVarM
newEmptyTMVarIO :: ReaderT r m (TMVar (ReaderT r m) a)
newEmptyTMVarIO = m (TMVar_ (STM m) a) -> ReaderT r m (TMVar_ (STM m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (TMVar_ (STM m) a)
forall (m :: * -> *) a. MonadSTM m => m (TMVar m a)
newEmptyTMVarM
newtype TMVarDefault m a = TMVar (TVar m (Maybe a))
newTMVarDefault :: MonadSTM m => a -> STM m (TMVarDefault m a)
newTMVarDefault :: a -> STM m (TMVarDefault m a)
newTMVarDefault a
a = do
TVar_ (STM m) (Maybe a)
t <- Maybe a -> STM m (TVar_ (STM m) (Maybe a))
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
TMVarDefault m a -> STM m (TMVarDefault m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar_ (STM m) (Maybe a) -> TMVarDefault m a
forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar_ (STM m) (Maybe a)
t)
newTMVarIODefault :: MonadSTM m => a -> m (TMVarDefault m a)
newTMVarIODefault :: a -> m (TMVarDefault m a)
newTMVarIODefault a
a = do
TVar_ (STM m) (Maybe a)
t <- Maybe a -> m (TVar_ (STM m) (Maybe a))
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarM (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
TMVarDefault m a -> m (TMVarDefault m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar_ (STM m) (Maybe a) -> TMVarDefault m a
forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar_ (STM m) (Maybe a)
t)
newTMVarMDefault :: MonadSTM m => a -> m (TMVarDefault m a)
newTMVarMDefault :: a -> m (TMVarDefault m a)
newTMVarMDefault = a -> m (TMVarDefault m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TMVarDefault m a)
newTMVarIODefault
{-# DEPRECATED newTMVarMDefault "Use newTMVarIODefault" #-}
newEmptyTMVarDefault :: MonadSTM m => STM m (TMVarDefault m a)
newEmptyTMVarDefault :: STM m (TMVarDefault m a)
newEmptyTMVarDefault = do
TVar_ (STM m) (Maybe a)
t <- Maybe a -> STM m (TVar_ (STM m) (Maybe a))
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar Maybe a
forall a. Maybe a
Nothing
TMVarDefault m a -> STM m (TMVarDefault m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar_ (STM m) (Maybe a) -> TMVarDefault m a
forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar_ (STM m) (Maybe a)
t)
newEmptyTMVarIODefault :: MonadSTM m => m (TMVarDefault m a)
newEmptyTMVarIODefault :: m (TMVarDefault m a)
newEmptyTMVarIODefault = do
TVar_ (STM m) (Maybe a)
t <- Maybe a -> m (TVar_ (STM m) (Maybe a))
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarM Maybe a
forall a. Maybe a
Nothing
TMVarDefault m a -> m (TMVarDefault m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar_ (STM m) (Maybe a) -> TMVarDefault m a
forall (m :: * -> *) a. TVar m (Maybe a) -> TMVarDefault m a
TMVar TVar_ (STM m) (Maybe a)
t)
newEmptyTMVarMDefault :: MonadSTM m => m (TMVarDefault m a)
newEmptyTMVarMDefault :: m (TMVarDefault m a)
newEmptyTMVarMDefault = m (TMVarDefault m a)
forall (m :: * -> *) a. MonadSTM m => m (TMVarDefault m a)
newEmptyTMVarIODefault
{-# DEPRECATED newEmptyTMVarMDefault "Use newEmptyTMVarIODefault" #-}
takeTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m a
takeTMVarDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m (Maybe a)
t
case Maybe a
m of
Maybe a
Nothing -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
Just a
a -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m (Maybe a)
t Maybe a
forall a. Maybe a
Nothing; 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 :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m (Maybe a)
t
case Maybe a
m of
Maybe a
Nothing -> Maybe a -> STM m (Maybe 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m (Maybe a)
t Maybe a
forall a. Maybe a
Nothing; Maybe a -> STM m (Maybe 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 :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
a); () -> STM m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
_ -> STM m ()
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
tryPutTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m Bool
tryPutTMVarDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
a); Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just a
_ -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
readTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m a
readTMVarDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m (Maybe a)
t
case Maybe a
m of
Maybe a
Nothing -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
Just a
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 :: TMVarDefault m a -> STM m (Maybe a)
tryReadTMVarDefault (TMVar TVar m (Maybe a)
t) = TVar m (Maybe a) -> STM m (Maybe a)
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m (Maybe a)
t
swapTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m a
swapTMVarDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m (Maybe a)
t
case Maybe a
m of
Maybe a
Nothing -> STM m a
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
Just a
old -> do TVar m (Maybe a) -> Maybe a -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m (Maybe a)
t (a -> Maybe a
forall a. a -> Maybe a
Just a
new); a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
old
isEmptyTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m Bool
isEmptyTMVarDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m (Maybe a)
t
case Maybe a
m of
Maybe a
Nothing -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just a
_ -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
data TQueueDefault m a = TQueue !(TVar m [a])
!(TVar m [a])
newTQueueDefault :: MonadSTM m => STM m (TQueueDefault m a)
newTQueueDefault :: STM m (TQueueDefault m a)
newTQueueDefault = do
TVar_ (STM m) [a]
read <- [a] -> STM m (TVar_ (STM m) [a])
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar []
TVar_ (STM m) [a]
write <- [a] -> STM m (TVar_ (STM m) [a])
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar []
TQueueDefault m a -> STM m (TQueueDefault m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar_ (STM m) [a] -> TVar_ (STM m) [a] -> TQueueDefault m a
forall (m :: * -> *) a.
TVar m [a] -> TVar m [a] -> TQueueDefault m a
TQueue TVar_ (STM m) [a]
read TVar_ (STM m) [a]
write)
writeTQueueDefault :: MonadSTM m => TQueueDefault m a -> a -> STM m ()
writeTQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
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 :: 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 (stm :: * -> *) a. MonadSTMTx stm => stm a
retry 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.
MonadSTMTx (STM m) =>
TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault TQueueDefault m a
queue
tryReadTQueueDefault :: MonadSTMTx (STM m) => TQueueDefault m a -> STM m (Maybe a)
tryReadTQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
read
case [a]
xs of
(a
x:[a]
xs') -> do
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
read [a]
xs'
Maybe a -> STM m (Maybe 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys of
[] -> Maybe a -> STM m (Maybe 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
write []
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
read [a]
zs
Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
z)
isEmptyTQueueDefault :: MonadSTMTx (STM m) => TQueueDefault m a -> STM m Bool
isEmptyTQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
read
case [a]
xs of
(a
_:[a]
_) -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[] -> do [a]
ys <- TVar m [a] -> STM m [a]
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
case [a]
ys of
[] -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[a]
_ -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
data TBQueueDefault m a = TBQueue
!(TVar m Natural)
!(TVar m [a])
!(TVar m Natural)
!(TVar m [a])
!Natural
newTBQueueDefault :: MonadSTM m => Natural -> STM m (TBQueueDefault m a)
newTBQueueDefault :: Natural -> STM m (TBQueueDefault m a)
newTBQueueDefault Natural
size = do
TVar_ (STM m) Natural
rsize <- Natural -> STM m (TVar_ (STM m) Natural)
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar Natural
0
TVar_ (STM m) [a]
read <- [a] -> STM m (TVar_ (STM m) [a])
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar []
TVar_ (STM m) Natural
wsize <- Natural -> STM m (TVar_ (STM m) Natural)
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar Natural
size
TVar_ (STM m) [a]
write <- [a] -> STM m (TVar_ (STM m) [a])
forall (stm :: * -> *) a. MonadSTMTx stm => a -> stm (TVar_ stm a)
newTVar []
TBQueueDefault m a -> STM m (TBQueueDefault m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar_ (STM m) Natural
-> TVar_ (STM m) [a]
-> TVar_ (STM m) Natural
-> TVar_ (STM 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_ (STM m) Natural
rsize TVar_ (STM m) [a]
read TVar_ (STM m) Natural
wsize TVar_ (STM m) [a]
write Natural
size)
readTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m a
readTBQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => stm a
retry 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.
MonadSTMTx (STM m) =>
TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault TBQueueDefault m a
queue
tryReadTBQueueDefault :: MonadSTMTx (STM m) => TBQueueDefault m a -> STM m (Maybe a)
tryReadTBQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
read
Natural
r <- TVar m Natural -> STM m Natural
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m Natural
rsize
TVar m Natural -> Natural -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
read [a]
xs'
Maybe a -> STM m (Maybe 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys of
[] -> Maybe a -> STM m (Maybe 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
write []
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
read [a]
zs
Maybe a -> STM m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
z)
writeTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> a -> STM m ()
writeTBQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm 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 (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m Natural
rsize Natural
0
TVar m Natural -> Natural -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
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 (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
[a]
listend <- TVar m [a] -> STM m [a]
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
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 :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
read
case [a]
xs of
(a
_:[a]
_) -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
[] -> do [a]
ys <- TVar m [a] -> STM m [a]
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
case [a]
ys of
[] -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[a]
_ -> Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isFullTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isFullTBQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
Natural
r <- TVar m Natural -> STM m Natural
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else Bool -> STM m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
lengthTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Natural
lengthTBQueueDefault :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m Natural
rsize
Natural
w <- TVar m Natural -> STM m Natural
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m Natural
wsize
Natural -> STM m Natural
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 :: 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 (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
read
[a]
ys <- TVar m [a] -> STM m [a]
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
readTVar TVar m [a]
write
if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs Bool -> Bool -> Bool
&& [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys
then [a] -> STM m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
read []
TVar m [a] -> [a] -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m [a]
write []
TVar m Natural -> Natural -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m Natural
rsize Natural
0
TVar m Natural -> Natural -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TVar_ stm a -> a -> stm ()
writeTVar TVar m Natural
wsize Natural
size
[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)
throwSTM :: (MonadSTMTx stm, MonadThrow.MonadThrow stm, Exception e)
=> e -> stm a
throwSTM :: e -> stm a
throwSTM = e -> stm a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MonadThrow.throwIO
catchSTM :: (MonadSTMTx stm, MonadThrow.MonadCatch stm, Exception e)
=> stm a -> (e -> stm a) -> stm a
catchSTM :: stm a -> (e -> stm a) -> stm a
catchSTM = stm a -> (e -> stm a) -> stm a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
MonadThrow.catch