module Control.Concurrent.Classy.STM.TQueue
(
TQueue
, newTQueue
, readTQueue
, tryReadTQueue
, peekTQueue
, tryPeekTQueue
, writeTQueue
, unGetTQueue
, isEmptyTQueue
) where
import Control.Monad.STM.Class
data TQueue stm a = TQueue (TVar stm [a])
(TVar stm [a])
newTQueue :: MonadSTM stm => stm (TQueue stm a)
newTQueue = do
readT <- newTVar []
writeT <- newTVar []
pure (TQueue readT writeT)
writeTQueue :: MonadSTM stm => TQueue stm a -> a -> stm ()
writeTQueue (TQueue _ writeT) a = do
listend <- readTVar writeT
writeTVar writeT (a:listend)
readTQueue :: MonadSTM stm => TQueue stm a -> stm a
readTQueue (TQueue readT writeT) = do
xs <- readTVar readT
case xs of
(x:xs') -> do
writeTVar readT xs'
pure x
[] -> do
ys <- readTVar writeT
case ys of
[] -> retry
_ -> case reverse ys of
[] -> error "readTQueue"
(z:zs) -> do
writeTVar writeT []
writeTVar readT zs
pure z
tryReadTQueue :: MonadSTM stm => TQueue stm a -> stm (Maybe a)
tryReadTQueue c = (Just <$> readTQueue c) `orElse` pure Nothing
peekTQueue :: MonadSTM stm => TQueue stm a -> stm a
peekTQueue c = do
x <- readTQueue c
unGetTQueue c x
pure x
tryPeekTQueue :: MonadSTM stm => TQueue stm a -> stm (Maybe a)
tryPeekTQueue c = do
m <- tryReadTQueue c
case m of
Nothing -> pure Nothing
Just x -> do
unGetTQueue c x
pure m
unGetTQueue :: MonadSTM stm => TQueue stm a -> a -> stm ()
unGetTQueue (TQueue readT _) a = do
xs <- readTVar readT
writeTVar readT (a:xs)
isEmptyTQueue :: MonadSTM stm => TQueue stm a -> stm Bool
isEmptyTQueue (TQueue readT writeT) = do
xs <- readTVar readT
case xs of
(_:_) -> pure False
[] -> null <$> readTVar writeT