module Control.Concurrent.Classy.STM.TChan
(
TChan
, newTChan
, newBroadcastTChan
, dupTChan
, cloneTChan
, readTChan
, tryReadTChan
, peekTChan
, tryPeekTChan
, writeTChan
, unGetTChan
, isEmptyTChan
) where
import Control.Monad.STM.Class
data TChan stm a = TChan (TVar stm (TVarList stm a))
(TVar stm (TVarList stm a))
type TVarList stm a = TVar stm (TList stm a)
data TList stm a = TNil | TCons a (TVarList stm a)
newTChan :: MonadSTM stm => stm (TChan stm a)
newTChan :: forall (stm :: * -> *) a. MonadSTM stm => stm (TChan stm a)
newTChan = do
TVar stm (TList stm a)
hole <- TList stm a -> stm (TVar stm (TList stm a))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TList stm a
forall (stm :: * -> *) a. TList stm a
TNil
TVar stm (TVar stm (TList stm a))
readH <- TVar stm (TList stm a) -> stm (TVar stm (TVar stm (TList stm a)))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TVar stm (TList stm a)
hole
TVar stm (TVar stm (TList stm a))
writeH <- TVar stm (TList stm a) -> stm (TVar stm (TVar stm (TList stm a)))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TVar stm (TList stm a)
hole
TChan stm a -> stm (TChan stm a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TVar stm (TVar stm (TList stm a))
-> TVar stm (TVar stm (TList stm a)) -> TChan stm a
forall (stm :: * -> *) a.
TVar stm (TVarList stm a)
-> TVar stm (TVarList stm a) -> TChan stm a
TChan TVar stm (TVar stm (TList stm a))
readH TVar stm (TVar stm (TList stm a))
writeH)
newBroadcastTChan :: MonadSTM stm => stm (TChan stm a)
newBroadcastTChan :: forall (stm :: * -> *) a. MonadSTM stm => stm (TChan stm a)
newBroadcastTChan = do
TVar stm (TList stm a)
hole <- TList stm a -> stm (TVar stm (TList stm a))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TList stm a
forall (stm :: * -> *) a. TList stm a
TNil
TVar stm (TVar stm (TList stm a))
readT <- TVar stm (TList stm a) -> stm (TVar stm (TVar stm (TList stm a)))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar ([Char] -> TVar stm (TList stm a)
forall a. HasCallStack => [Char] -> a
error [Char]
"reading from a TChan created by newBroadcastTChan; use dupTChan first")
TVar stm (TVar stm (TList stm a))
writeT <- TVar stm (TList stm a) -> stm (TVar stm (TVar stm (TList stm a)))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TVar stm (TList stm a)
hole
TChan stm a -> stm (TChan stm a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TVar stm (TVar stm (TList stm a))
-> TVar stm (TVar stm (TList stm a)) -> TChan stm a
forall (stm :: * -> *) a.
TVar stm (TVarList stm a)
-> TVar stm (TVarList stm a) -> TChan stm a
TChan TVar stm (TVar stm (TList stm a))
readT TVar stm (TVar stm (TList stm a))
writeT)
writeTChan :: MonadSTM stm => TChan stm a -> a -> stm ()
writeTChan :: forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> a -> stm ()
writeTChan (TChan TVar stm (TVarList stm a)
_ TVar stm (TVarList stm a)
writeT) a
a = do
TVarList stm a
listend <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
writeT
TVarList stm a
listend' <- TList stm a -> stm (TVarList stm a)
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TList stm a
forall (stm :: * -> *) a. TList stm a
TNil
TVarList stm a -> TList stm a -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVarList stm a
listend (a -> TVarList stm a -> TList stm a
forall (stm :: * -> *) a. a -> TVarList stm a -> TList stm a
TCons a
a TVarList stm a
listend')
TVar stm (TVarList stm a) -> TVarList stm a -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm (TVarList stm a)
writeT TVarList stm a
listend'
readTChan :: MonadSTM stm => TChan stm a -> stm a
readTChan :: forall (stm :: * -> *) a. MonadSTM stm => TChan stm a -> stm a
readTChan TChan stm a
tchan = TChan stm a -> stm (Maybe a)
forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> stm (Maybe a)
tryReadTChan TChan stm a
tchan stm (Maybe a) -> (Maybe a -> stm a) -> stm a
forall a b. stm a -> (a -> stm b) -> stm b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= stm a -> (a -> stm a) -> Maybe a -> stm a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe stm a
forall (stm :: * -> *) a. MonadSTM stm => stm a
retry a -> stm a
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
tryReadTChan :: MonadSTM stm => TChan stm a -> stm (Maybe a)
tryReadTChan :: forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> stm (Maybe a)
tryReadTChan (TChan TVar stm (TVarList stm a)
readT TVar stm (TVarList stm a)
_) = do
TVarList stm a
listhead <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
readT
TList stm a
hd <- TVarList stm a -> stm (TList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVarList stm a
listhead
case TList stm a
hd of
TList stm a
TNil -> Maybe a -> stm (Maybe a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
TCons a
a TVarList stm a
tl -> do
TVar stm (TVarList stm a) -> TVarList stm a -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm (TVarList stm a)
readT TVarList stm a
tl
Maybe a -> stm (Maybe a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
peekTChan :: MonadSTM stm => TChan stm a -> stm a
peekTChan :: forall (stm :: * -> *) a. MonadSTM stm => TChan stm a -> stm a
peekTChan TChan stm a
tchan = TChan stm a -> stm (Maybe a)
forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> stm (Maybe a)
tryPeekTChan TChan stm a
tchan stm (Maybe a) -> (Maybe a -> stm a) -> stm a
forall a b. stm a -> (a -> stm b) -> stm b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= stm a -> (a -> stm a) -> Maybe a -> stm a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe stm a
forall (stm :: * -> *) a. MonadSTM stm => stm a
retry a -> stm a
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
tryPeekTChan :: MonadSTM stm => TChan stm a -> stm (Maybe a)
tryPeekTChan :: forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> stm (Maybe a)
tryPeekTChan (TChan TVar stm (TVarList stm a)
readT TVar stm (TVarList stm a)
_) = do
TVarList stm a
listhead <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
readT
TList stm a
hd <- TVarList stm a -> stm (TList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVarList stm a
listhead
Maybe a -> stm (Maybe a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> stm (Maybe a)) -> Maybe a -> stm (Maybe a)
forall a b. (a -> b) -> a -> b
$ case TList stm a
hd of
TList stm a
TNil -> Maybe a
forall a. Maybe a
Nothing
TCons a
a TVarList stm a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
dupTChan :: MonadSTM stm => TChan stm a -> stm (TChan stm a)
dupTChan :: forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> stm (TChan stm a)
dupTChan (TChan TVar stm (TVarList stm a)
_ TVar stm (TVarList stm a)
writeT) = do
TVarList stm a
hole <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
writeT
TVar stm (TVarList stm a)
readT' <- TVarList stm a -> stm (TVar stm (TVarList stm a))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TVarList stm a
hole
TChan stm a -> stm (TChan stm a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TVar stm (TVarList stm a)
-> TVar stm (TVarList stm a) -> TChan stm a
forall (stm :: * -> *) a.
TVar stm (TVarList stm a)
-> TVar stm (TVarList stm a) -> TChan stm a
TChan TVar stm (TVarList stm a)
readT' TVar stm (TVarList stm a)
writeT)
unGetTChan :: MonadSTM stm => TChan stm a -> a -> stm ()
unGetTChan :: forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> a -> stm ()
unGetTChan (TChan TVar stm (TVarList stm a)
readT TVar stm (TVarList stm a)
_) a
a = do
TVarList stm a
listhead <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
readT
TVarList stm a
head' <- TList stm a -> stm (TVarList stm a)
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar (a -> TVarList stm a -> TList stm a
forall (stm :: * -> *) a. a -> TVarList stm a -> TList stm a
TCons a
a TVarList stm a
listhead)
TVar stm (TVarList stm a) -> TVarList stm a -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm (TVarList stm a)
readT TVarList stm a
head'
isEmptyTChan :: MonadSTM stm => TChan stm a -> stm Bool
isEmptyTChan :: forall (stm :: * -> *) a. MonadSTM stm => TChan stm a -> stm Bool
isEmptyTChan (TChan TVar stm (TVarList stm a)
readT TVar stm (TVarList stm a)
_) = do
TVarList stm a
listhead <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
readT
TList stm a
hd <- TVarList stm a -> stm (TList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVarList stm a
listhead
Bool -> stm Bool
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> stm Bool) -> Bool -> stm Bool
forall a b. (a -> b) -> a -> b
$ case TList stm a
hd of
TList stm a
TNil -> Bool
True
TCons a
_ TVarList stm a
_ -> Bool
False
cloneTChan :: MonadSTM stm => TChan stm a -> stm (TChan stm a)
cloneTChan :: forall (stm :: * -> *) a.
MonadSTM stm =>
TChan stm a -> stm (TChan stm a)
cloneTChan (TChan TVar stm (TVarList stm a)
readT TVar stm (TVarList stm a)
writeT) = do
TVarList stm a
readpos <- TVar stm (TVarList stm a) -> stm (TVarList stm a)
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm (TVarList stm a)
readT
TVar stm (TVarList stm a)
readT' <- TVarList stm a -> stm (TVar stm (TVarList stm a))
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar TVarList stm a
readpos
TChan stm a -> stm (TChan stm a)
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TVar stm (TVarList stm a)
-> TVar stm (TVarList stm a) -> TChan stm a
forall (stm :: * -> *) a.
TVar stm (TVarList stm a)
-> TVar stm (TVarList stm a) -> TChan stm a
TChan TVar stm (TVarList stm a)
readT' TVar stm (TVarList stm a)
writeT)