Stack.hs

-- | Provides a synchronized stack container for use in the 'STM' monad
--
-- See also "Control.Concurrent.Stack"
module Control.Concurrent.STM.Stack (
    Stack,
    stackNew,
    stackPush,
    stackPeek,
    stackTryPeek,
    stackPop,
    stackTryPop,
    stackIsEmpty,
    stackSize,
  )
  where

import Control.Concurrent.STM.TVar
import Control.Monad.STM
import qualified Data.Stack as Pure
import Numeric.Natural

-- | Synchronized stack data type
newtype Stack a = Stack (TVar (Pure.Stack a))

-- | Create new empty Stack
stackNew :: STM (Stack a)
stackNew = do
    stackRef <- newTVar Pure.stackNew
    return (Stack stackRef)

-- | Push item onto Stack
stackPush :: Stack a -> a -> STM ()
stackPush (Stack stackRef) item = modifyTVar' stackRef (\stack -> Pure.stackPush stack item)

-- | Pop most recently added item without removing from the Stack
stackTryPeek :: Stack a -> STM (Maybe a)
stackTryPeek (Stack stackRef) = do
    stack <- readTVar stackRef
    return (Pure.stackPeek stack)

-- | Pop most recently added item without removing from the Stack
--
-- Automatically retries if stack is empty
stackPeek :: Stack a -> STM a
stackPeek (Stack stackRef) = do
    stack <- readTVar stackRef
    case Pure.stackPeek stack of
      Just item -> return item
      Nothing   -> retry

-- | Pop most recently added item from Stack
stackTryPop :: Stack a -> STM (Maybe a)
stackTryPop (Stack stackRef) = do
    stack <- readTVar stackRef
    case Pure.stackPop stack of
      Just (stack1,item) -> do writeTVar stackRef stack1
                               return (Just item)
      Nothing -> return Nothing

-- | Pop most recently added item from Stack
--
-- Automatically retries if stack is empty
stackPop :: Stack a -> STM a
stackPop (Stack stackRef) = do
    stack <- readTVar stackRef
    case Pure.stackPop stack of
      Just (stack1,item) -> do writeTVar stackRef stack1
                               return item
      Nothing -> retry

-- | Test if stack is empty
stackIsEmpty :: Stack a -> STM Bool
stackIsEmpty (Stack stackRef) = do
    stack <- readTVar stackRef
    return (Pure.stackIsEmpty stack)

-- | Compute number of elements contained in the Stack
stackSize :: Stack a -> STM Natural
stackSize (Stack stackRef) = do
    stack <- readTVar stackRef
    return (Pure.stackSize stack)