-- | Provides a synchronized stack 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 Numeric.Natural

-- | Synchronized stack data type
data Stack a = Stack (TVar [a])

-- | Create new Stack
stackNew :: STM (Stack a)
stackNew = do
    items <- newTVar []
    return (Stack items)

-- | Push item onto Stack
stackPush :: Stack a -> a -> STM ()
stackPush (Stack itemsVar) item = do
    items <- readTVar itemsVar
    writeTVar itemsVar (item:items)

-- | Pop most recently added item without removing from the Stack
stackTryPeek :: Stack a -> STM (Maybe a)
stackTryPeek (Stack itemsVar) = do
    items <- readTVar itemsVar
    if null items
        then return Nothing
        else return (Just (head items))

-- | Pop most recently added item without removing from the Stack
--
-- Automatically retries if stack is empty
stackPeek :: Stack a -> STM a
stackPeek (Stack itemsVar) = do
    items <- readTVar itemsVar
    if null items
        then retry
        else return (head items)

-- | Pop most recently added item from Stack
stackTryPop :: Stack a -> STM (Maybe a)
stackTryPop (Stack itemsVar) = do
    items <- readTVar itemsVar
    if null items
        then return Nothing
        else do writeTVar itemsVar (tail items)
                return (Just (head items))

-- | Pop most recently added item from Stack
--
-- Automatically retries if stack is empty
stackPop :: Stack a -> STM a
stackPop (Stack itemsVar) = do
    items <- readTVar itemsVar
    if null items
        then retry
        else do writeTVar itemsVar (tail items)
                return (head items)

-- | Test if stack is empty
stackIsEmpty :: Stack a -> STM Bool
stackIsEmpty (Stack itemsVar) = do
    items <- readTVar itemsVar
    if null items then return True else return False

-- | Compute number of elements contained in the Stack
stackSize :: Stack a -> STM Natural
stackSize (Stack itemsVar) = do
    items <- readTVar itemsVar
    return (fromIntegral (length items))