    {-# OPTIONS_GHC -Wall -fwarn-tabs #-}
    {-# LANGUAGE CPP, DeriveDataTypeable #-}

    #if __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE Safe #-}
    #endif
    ----------------------------------------------------------------
    --                                                    2021.10.17
    -- |
    -- Module      :  Control.Concurrent.STM.TBMQueue
    -- Copyright   :  Copyright (c) 2011--2021 wren gayle romano
    -- License     :  BSD
    -- Maintainer  :  wren@cpan.org
    -- Stability   :  provisional
    -- Portability :  non-portable (GHC STM, DeriveDataTypeable)
    --
    -- A version of "Control.Concurrent.STM.TQueue" where the queue is
    -- bounded in length and closeable. This combines the abilities of
    -- "Control.Concurrent.STM.TBQueue" and "Control.Concurrent.STM.TMQueue".
    --
    -- /Since: 2.0.0/
    ----------------------------------------------------------------
    module Control.Concurrent.STM.TBMQueue
        (
        -- * The TBMQueue type
          TBMQueue()
        -- ** Creating TBMQueues
        , newTBMQueue
        , newTBMQueueIO
        -- ** Reading from TBMQueues
        , readTBMQueue
        , tryReadTBMQueue
        , peekTBMQueue
        , tryPeekTBMQueue
        -- ** Writing to TBMQueues
        , writeTBMQueue
        , tryWriteTBMQueue
        , unGetTBMQueue
        -- ** Closing TBMQueues
        , closeTBMQueue
        -- ** Predicates
        , isClosedTBMQueue
        , isEmptyTBMQueue
        , isFullTBMQueue
        -- ** Other functionality
        , estimateFreeSlotsTBMQueue
        , freeSlotsTBMQueue
        ) where

    import Prelude             hiding (reads)
    import Data.Typeable       (Typeable)
    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative ((<$>))
    #endif
    import Control.Monad.STM   (STM, retry)
    import Control.Concurrent.STM.TVar
    import Control.Concurrent.STM.TQueue -- N.B., GHC only
    ----------------------------------------------------------------

    -- | @TBMQueue@ is an abstract type representing a bounded closeable
    -- FIFO queue.
    data TBMQueue a = TBMQueue
        {-# UNPACK #-} !(TVar Bool)
        {-# UNPACK #-} !(TVar Int)
        {-# UNPACK #-} !(TVar Int)
        {-# UNPACK #-} !(TQueue a)
        deriving (Typeable)
    -- The components are:
    -- * Whether the queue has been closed.
    -- * How many free slots we /know/ we have available.
    -- * How many slots have been freed up by successful reads since
    --   the last time the slot count was synchronized by 'isFullTBQueue'.
    -- * The underlying TQueue.

    -- | Build and returns a new instance of @TBMQueue@ with the given
    -- capacity. /N.B./, we do not verify the capacity is positive, but
    -- if it is non-positive then 'writeTBMQueue' will always retry and
    -- 'isFullTBMQueue' will always be true.
    newTBMQueue :: Int -> STM (TBMQueue a)
    newTBMQueue :: forall a. Int -> STM (TBMQueue a)
    newTBMQueue Int
    n = do
        closed <- Bool -> STM (TVar Bool)
    forall a. a -> STM (TVar a)
    newTVar Bool
    False
        slots  <- newTVar n
        reads  <- newTVar 0
        queue  <- newTQueue
        return (TBMQueue closed slots reads queue)

    -- | @IO@ version of 'newTBMQueue'. This is useful for creating
    -- top-level @TBMQueue@s using 'System.IO.Unsafe.unsafePerformIO',
    -- because using 'Control.Monad.STM.atomically' inside
    -- 'System.IO.Unsafe.unsafePerformIO' isn't possible.
    newTBMQueueIO :: Int -> IO (TBMQueue a)
    newTBMQueueIO :: forall a. Int -> IO (TBMQueue a)
    newTBMQueueIO Int
    n = do
        closed <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        slots  <- newTVarIO n
        reads  <- newTVarIO 0
        queue  <- newTQueueIO
        return (TBMQueue closed slots reads queue)

    -- | Read the next value from the @TBMQueue@, retrying if the queue
    -- is empty (and not closed). We return @Nothing@ immediately if
    -- the queue is closed and empty.
    readTBMQueue :: TBMQueue a -> STM (Maybe a)
    readTBMQueue :: forall a. TBMQueue a -> STM (Maybe a)
    readTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    _slots TVar Int
    reads TQueue a
    queue) = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then do
                mx <- tryReadTQueue queue
                case mx of
                    Maybe a
    Nothing -> Maybe a -> STM (Maybe a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    mx
                    Just a
    _x -> do
                        TVar Int -> (Int -> Int) -> STM ()
    forall a. TVar a -> (a -> a) -> STM ()
    modifyTVar' TVar Int
    reads (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
                        Maybe a -> STM (Maybe a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    mx
            else do
                x <- readTQueue queue
                modifyTVar' reads (1 +)
                return (Just x)
    {-
    -- The above is slightly optimized over the clearer:
    readTBMQueue (TBMQueue closed _slots reads queue) =
        b  <- readTVar closed
        b' <- isEmptyTQueue queue
        if b && b'
            then return Nothing
            else do
                x <- readTQueue queue
                modifyTVar' reads (1 +)
                return (Just x)
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | A version of 'readTBMQueue' which does not retry. Instead it
    -- returns @Just Nothing@ if the queue is open but no value is
    -- available; it still returns @Nothing@ if the queue is closed
    -- and empty.
    tryReadTBMQueue :: TBMQueue a -> STM (Maybe (Maybe a))
    tryReadTBMQueue :: forall a. TBMQueue a -> STM (Maybe (Maybe a))
    tryReadTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    _slots TVar Int
    reads TQueue a
    queue) = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then do
                mx <- tryReadTQueue queue
                case mx of
                    Maybe a
    Nothing -> Maybe (Maybe a) -> STM (Maybe (Maybe a))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Maybe a)
    forall a. Maybe a
    Nothing
                    Just a
    _x -> do
                        TVar Int -> (Int -> Int) -> STM ()
    forall a. TVar a -> (a -> a) -> STM ()
    modifyTVar' TVar Int
    reads (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
                        Maybe (Maybe a) -> STM (Maybe (Maybe a))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just Maybe a
    mx)
            else do
                mx <- tryReadTQueue queue
                case mx of
                    Maybe a
    Nothing -> Maybe (Maybe a) -> STM (Maybe (Maybe a))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just Maybe a
    mx)
                    Just a
    _x -> do
                        TVar Int -> (Int -> Int) -> STM ()
    forall a. TVar a -> (a -> a) -> STM ()
    modifyTVar' TVar Int
    reads (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
                        Maybe (Maybe a) -> STM (Maybe (Maybe a))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just Maybe a
    mx)
    {-
    -- The above is slightly optimized over the clearer:
    tryReadTBMQueue (TBMQueue closed _slots reads queue) =
        b  <- readTVar closed
        b' <- isEmptyTQueue queue
        if b && b'
            then return Nothing
            else do
                mx <- tryReadTBMQueue queue
                case mx of
                    Nothing -> return (Just mx)
                    Just _x -> do
                        modifyTVar' reads (1 +)
                        return (Just mx)
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | Get the next value from the @TBMQueue@ without removing it,
    -- retrying if the queue is empty.
    peekTBMQueue :: TBMQueue a -> STM (Maybe a)
    peekTBMQueue :: forall a. TBMQueue a -> STM (Maybe a)
    peekTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    _slots TVar Int
    _reads TQueue a
    queue) = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then do
                b' <- isEmptyTQueue queue
                if b'
                    then return Nothing
                    else Just <$> peekTQueue queue
            else Just <$> peekTQueue queue
    {-
    -- The above is lazier reading from @queue@ than the clearer:
    peekTBMQueue (TBMQueue closed _slots _reads queue) = do
        b  <- isEmptyTQueue queue
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> peekTQueue queue
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | A version of 'peekTBMQueue' which does not retry. Instead it
    -- returns @Just Nothing@ if the queue is open but no value is
    -- available; it still returns @Nothing@ if the queue is closed
    -- and empty.
    tryPeekTBMQueue :: TBMQueue a -> STM (Maybe (Maybe a))
    tryPeekTBMQueue :: forall a. TBMQueue a -> STM (Maybe (Maybe a))
    tryPeekTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    _slots TVar Int
    _reads TQueue a
    queue) = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then fmap Just <$> tryPeekTQueue queue
            else Just <$> tryPeekTQueue queue
    {-
    -- The above is lazier reading from @queue@ (and removes an extraneous isEmptyTQueue when using the compatibility layer) than the clearer:
    tryPeekTBMQueue (TBMQueue closed _slots _reads queue) = do
        b  <- isEmptyTQueue queue
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> tryPeekTQueue queue
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | Write a value to a @TBMQueue@, retrying if the queue is full.
    -- If the queue is closed then the value is silently discarded.
    -- Use 'isClosedTBMQueue' to determine if the queue is closed
    -- before writing, as needed.
    writeTBMQueue :: TBMQueue a -> a -> STM ()
    writeTBMQueue :: forall a. TBMQueue a -> a -> STM ()
    writeTBMQueue self :: TBMQueue a
    self@(TBMQueue TVar Bool
    closed TVar Int
    slots TVar Int
    _reads TQueue a
    queue) a
    x = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then return () -- Discard silently
            else do
                n <- estimateFreeSlotsTBMQueue self
                if n <= 0
                    then retry
                    else do
                        writeTVar slots $! n - 1
                        writeTQueue queue x

    -- | A version of 'writeTBMQueue' which does not retry. Returns @Just
    -- True@ if the value was successfully written, @Just False@ if it
    -- could not be written (but the queue was open), and @Nothing@
    -- if it was discarded (i.e., the queue was closed).
    tryWriteTBMQueue :: TBMQueue a -> a -> STM (Maybe Bool)
    tryWriteTBMQueue :: forall a. TBMQueue a -> a -> STM (Maybe Bool)
    tryWriteTBMQueue self :: TBMQueue a
    self@(TBMQueue TVar Bool
    closed TVar Int
    slots TVar Int
    _reads TQueue a
    queue) a
    x = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then return Nothing
            else do
                n <- estimateFreeSlotsTBMQueue self
                if n <= 0
                    then return (Just False)
                    else do
                        writeTVar slots $! n - 1
                        writeTQueue queue x
                        return (Just True)

    -- | Put a data item back onto a queue, where it will be the next
    -- item read. If the queue is closed then the value is silently
    -- discarded; you can use 'peekTBMQueue' to circumvent this in certain
    -- circumstances. /N.B./, this could allow the queue to temporarily
    -- become longer than the specified limit, which is necessary to
    -- ensure that the item is indeed the next one read.
    unGetTBMQueue :: TBMQueue a -> a -> STM ()
    unGetTBMQueue :: forall a. TBMQueue a -> a -> STM ()
    unGetTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    slots TVar Int
    _reads TQueue a
    queue) a
    x = do
        b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if b
            then return () -- Discard silently
            else do
                modifyTVar' slots (subtract 1)
                unGetTQueue queue x

    -- | Closes the @TBMQueue@, preventing any further writes.
    closeTBMQueue :: TBMQueue a -> STM ()
    closeTBMQueue :: forall a. TBMQueue a -> STM ()
    closeTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    _slots TVar Int
    _reads TQueue a
    _queue) =
        TVar Bool -> Bool -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Bool
    closed Bool
    True

    -- | Returns @True@ if the supplied @TBMQueue@ has been closed.
    isClosedTBMQueue :: TBMQueue a -> STM Bool
    isClosedTBMQueue :: forall a. TBMQueue a -> STM Bool
    isClosedTBMQueue (TBMQueue TVar Bool
    closed TVar Int
    _slots TVar Int
    _reads TQueue a
    _queue) =
        TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed

    {-
    -- | Returns @True@ if the supplied @TBMQueue@ has been closed.
    isClosedTBMQueueIO :: TBMQueue a -> IO Bool
    isClosedTBMQueueIO (TBMQueue closed _slots _reads _queue) =
        readTVarIO closed
    -}

    -- | Returns @True@ if the supplied @TBMQueue@ is empty (i.e., has
    -- no elements). /N.B./, a @TBMQueue@ can be both \"empty\" and
    -- \"full\" at the same time, if the initial limit was non-positive.
    isEmptyTBMQueue :: TBMQueue a -> STM Bool
    isEmptyTBMQueue :: forall a. TBMQueue a -> STM Bool
    isEmptyTBMQueue (TBMQueue TVar Bool
    _closed TVar Int
    _slots TVar Int
    _reads TQueue a
    queue) =
        TQueue a -> STM Bool
    forall a. TQueue a -> STM Bool
    isEmptyTQueue TQueue a
    queue

    -- | Returns @True@ if the supplied @TBMQueue@ is full (i.e., is
    -- over its limit). /N.B./, a @TBMQueue@ can be both \"empty\" and
    -- \"full\" at the same time, if the initial limit was non-positive.
    -- /N.B./, a @TBMQueue@ may still be full after reading, if
    -- 'unGetTBMQueue' was used to go over the initial limit.
    --
    -- This is equivalent to: @liftM (<= 0) estimateFreeSlotsTBMQueue@
    isFullTBMQueue :: TBMQueue a -> STM Bool
    isFullTBMQueue :: forall a. TBMQueue a -> STM Bool
    isFullTBMQueue (TBMQueue TVar Bool
    _closed TVar Int
    slots TVar Int
    reads TQueue a
    _queue) = do
        n <- TVar Int -> STM Int
    forall a. TVar a -> STM a
    readTVar TVar Int
    slots
        if n <= 0
            then do
                m <- readTVar reads
                let n' = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m
                writeTVar slots $! n'
                writeTVar reads 0
                return $! n' <= 0
            else return False

    -- | Estimate the number of free slots. If the result is positive,
    -- then it's a minimum bound; if it's non-positive then it's exact.
    -- It will only be negative if the initial limit was negative or
    -- if 'unGetTBMQueue' was used to go over the initial limit.
    --
    -- This function always contends with writers, but only contends
    -- with readers when it has to; compare against 'freeSlotsTBMQueue'.
    estimateFreeSlotsTBMQueue :: TBMQueue a -> STM Int
    estimateFreeSlotsTBMQueue :: forall a. TBMQueue a -> STM Int
    estimateFreeSlotsTBMQueue (TBMQueue TVar Bool
    _closed TVar Int
    slots TVar Int
    reads TQueue a
    _queue) = do
        n <- TVar Int -> STM Int
    forall a. TVar a -> STM a
    readTVar TVar Int
    slots
        if n > 0
            then return n
            else do
                m <- readTVar reads
                let n' = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m
                writeTVar slots $! n'
                writeTVar reads 0
                return n'

    -- | Return the exact number of free slots. The result can be
    -- negative if the initial limit was negative or if 'unGetTBMQueue'
    -- was used to go over the initial limit.
    --
    -- This function always contends with both readers and writers;
    -- compare against 'estimateFreeSlotsTBMQueue'.
    freeSlotsTBMQueue :: TBMQueue a -> STM Int
    freeSlotsTBMQueue :: forall a. TBMQueue a -> STM Int
    freeSlotsTBMQueue (TBMQueue TVar Bool
    _closed TVar Int
    slots TVar Int
    reads TQueue a
    _queue) = do
        n <- TVar Int -> STM Int
    forall a. TVar a -> STM a
    readTVar TVar Int
    slots
        m <- readTVar reads
        let n' = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m
        writeTVar slots $! n'
        writeTVar reads 0
        return n'

    ----------------------------------------------------------------
    ----------------------------------------------------------- fin.