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

import Control.Concurrent.STM
 ( STM
 , TMVar
 , takeTMVar
 , putTMVar
 , newEmptyTMVar
 , newTMVar
 , readTMVar
 , isEmptyTMVar
 , retry )

newtype TStack a = TStack (TMVar [a])

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

writeTStack :: TStack a -> a -> STM ()
writeTStack (TStack s) v = do
  vs <- takeTMVar s
  putTMVar s $ v:vs

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

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