module Control.Concurrent.STM.TStack
( TStack ()
, newTStack
, writeTStack
, readTStack
, isEmptyTStack
, tryReadTStack )
where
import Control.Concurrent.STM
( STM
, TVar
, newTVar
, readTVar
, writeTVar
, modifyTVar
, retry )
import Control.Monad (liftM)
newtype TStack a = TStack (TVar [a])
newTStack :: STM (TStack a)
newTStack = do
hd <- newTVar []
return $ TStack hd
readTStack :: TStack a -> STM a
readTStack (TStack s) = do
vss <- readTVar s
case vss of
[] -> retry
v:vs -> do
writeTVar s vs
return v
writeTStack :: TStack a -> a -> STM ()
writeTStack (TStack s) v =
modifyTVar s (v:)
isEmptyTStack :: TStack a -> STM Bool
isEmptyTStack (TStack s) = do
st <- readTVar s
case st of
[] -> return True
_ -> return False
tryReadTStack :: TStack a -> STM (Maybe a)
tryReadTStack stack = do
empty <- isEmptyTStack stack
if empty
then return Nothing
else (liftM Just) $ readTStack stack