module Control.Concurrent.STM.TStack
 ( TStack
 , newTStack
 , writeTStack
 , readTStack
 , isEmptyTStack )
where

import Control.Concurrent.STM
 ( STM
 , TVar
 , newTVar
 , readTVar
 , writeTVar
 , modifyTVar
 , retry )

newtype TStack a = TStack (TVar [a])

newTStack :: STM (TStack a)
newTStack = do
  hd <- newTVar []
  return $ TStack hd

writeTStack :: TStack a -> a -> STM ()
writeTStack (TStack s) v =
  modifyTVar s (v:)

readTStack :: TStack a -> STM a
readTStack (TStack s) = do
  vss <- readTVar s
  case vss of
    [] -> retry
    v:vs -> do
      writeTVar s vs
      return v

isEmptyTStack :: TStack a -> STM Bool
isEmptyTStack (TStack s) = do
  st <- readTVar s
  case st of
    [] -> return True
    _  -> return False