{-|
Module      : Control.Concurrent.STM.TStack
Description : Simple stack with concurrent access through STM
Copyright   : (c) Bastian Holst, 2014
License     : BSD3
Maintainer  : bastianholst@gmx.de
Stability   : experimental
Portability : POSIX

A simple stack implementation with an concurrent STM access functions similar to
that of 'TChan'. In contrast to 'TChan', which is a FIFO buffer,
'TStack' is a LIFO buffer.
-}
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)

-- | Concurrent STM stakc.
newtype TStack a = TStack (TVar [a])

-- | Build and return a new instance of 'TStack'.
newTStack :: STM (TStack a)
newTStack = do
  hd <- newTVar []
  return $ TStack hd

-- | Read the next value from the 'TStack'.
readTStack :: TStack a -> STM a
readTStack (TStack s) = do
  vss <- readTVar s
  case vss of
    [] -> retry
    v:vs -> do
      writeTVar s vs
      return v

-- | Write a value into the 'TStack'.
writeTStack :: TStack a -> a -> STM ()
writeTStack (TStack s) v =
  modifyTVar s (v:)

-- | Check whether the 'TStack' is empty.
isEmptyTStack :: TStack a -> STM Bool
isEmptyTStack (TStack s) = do
  st <- readTVar s
  case st of
    [] -> return True
    _  -> return False

-- | Try to read the next value from the 'TStack'.
tryReadTStack :: TStack a -> STM (Maybe a)
tryReadTStack stack = do
  empty <- isEmptyTStack stack
  if empty
    then return Nothing
    else (liftM Just) $ readTStack stack