module Control.Concurrent.STM.ETQueue
( ETQueue
, newETQueue
, newETQueueIO
, readETQueue
, tryReadETQueue
, peekETQueue
, tryPeekETQueue
, writeETQueue
, unGetETQueue
, isEmptyETQueue
, awaitEmpty
) where
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
data ETQueue α
= ETQueue
{ etqQueue ∷ TQueue α
, etqVar ∷ TMVar ()
}
newETQueue ∷ STM (ETQueue α)
newETQueue = do
etqQueue ← newTQueue
etqVar ← newTMVar ()
return ETQueue {..}
newETQueueIO ∷ IO (ETQueue α)
newETQueueIO = do
etqQueue ← newTQueueIO
etqVar ← newTMVarIO ()
return ETQueue {..}
readETQueue
∷ ETQueue α
→ STM α
readETQueue ETQueue{..} = do
a ← readTQueue etqQueue
isEmpty ← isEmptyTQueue etqQueue
when isEmpty $
() <$ tryPutTMVar etqVar ()
return a
tryReadETQueue
∷ ETQueue α
→ STM (Maybe α)
tryReadETQueue q =
(Just <$> readETQueue q)
`orElse` return Nothing
peekETQueue
∷ ETQueue α
→ STM α
peekETQueue ETQueue{..} =
peekTQueue etqQueue
tryPeekETQueue
∷ ETQueue α
→ STM (Maybe α)
tryPeekETQueue ETQueue{..} =
tryPeekTQueue etqQueue
writeETQueue
∷ ETQueue α
→ α
→ STM ()
writeETQueue ETQueue{..} a = do
writeTQueue etqQueue a
() <$ tryTakeTMVar etqVar
unGetETQueue
∷ ETQueue α
→ α
→ STM ()
unGetETQueue ETQueue{..} a = do
unGetTQueue etqQueue a
() <$ tryTakeTMVar etqVar
isEmptyETQueue
∷ ETQueue α
→ STM Bool
isEmptyETQueue ETQueue{..} =
isEmptyTQueue etqQueue
awaitEmpty
∷ ETQueue α
→ STM ()
awaitEmpty ETQueue{..} =
readTMVar etqVar