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

    #if __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE Safe #-}
    #endif
    ----------------------------------------------------------------
    --                                                    2021.10.17
    -- |
    -- Module      :  Control.Concurrent.STM.TMQueue
    -- 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
    -- closeable. This is similar to a @TQueue (Maybe a)@ with a
    -- monotonicity guarantee that once there's a @Nothing@ there will
    -- always be @Nothing@.
    --
    -- /Since: 2.0.0/
    ----------------------------------------------------------------
    module Control.Concurrent.STM.TMQueue
        (
        -- * The TMQueue type
          TMQueue()
        -- ** Creating TMQueues
        , newTMQueue
        , newTMQueueIO
        -- ** Reading from TMQueues
        , readTMQueue
        , tryReadTMQueue
        , peekTMQueue
        , tryPeekTMQueue
        -- ** Writing to TMQueues
        , writeTMQueue
        , unGetTMQueue
        -- ** Closing TMQueues
        , closeTMQueue
        -- ** Predicates
        , isClosedTMQueue
        , isEmptyTMQueue
        ) where

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

    -- | @TMQueue@ is an abstract type representing a closeable FIFO
    -- queue.
    data TMQueue a = TMQueue
        {-# UNPACK #-} !(TVar Bool)
        {-# UNPACK #-} !(TQueue a)
        deriving Typeable

    -- | Build and returns a new instance of @TMQueue@.
    newTMQueue :: STM (TMQueue a)
    newTMQueue :: forall a. STM (TMQueue a)
    newTMQueue = do
        TVar Bool
    closed <- Bool -> STM (TVar Bool)
    forall a. a -> STM (TVar a)
    newTVar Bool
    False
        TQueue a
    queue  <- STM (TQueue a)
    forall a. STM (TQueue a)
    newTQueue
        TMQueue a -> STM (TMQueue a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TQueue a -> TMQueue a
    forall a. TVar Bool -> TQueue a -> TMQueue a
    TMQueue TVar Bool
    closed TQueue a
    queue)

    -- | @IO@ version of 'newTMQueue'. This is useful for creating
    -- top-level @TMQueue@s using 'System.IO.Unsafe.unsafePerformIO',
    -- because using 'Control.Monad.STM.atomically' inside
    -- 'System.IO.Unsafe.unsafePerformIO' isn't possible.
    newTMQueueIO :: IO (TMQueue a)
    newTMQueueIO :: forall a. IO (TMQueue a)
    newTMQueueIO = do
        TVar Bool
    closed <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        TQueue a
    queue  <- IO (TQueue a)
    forall a. IO (TQueue a)
    newTQueueIO
        TMQueue a -> IO (TMQueue a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TQueue a -> TMQueue a
    forall a. TVar Bool -> TQueue a -> TMQueue a
    TMQueue TVar Bool
    closed TQueue a
    queue)

    -- | Read the next value from the @TMQueue@, retrying if the queue
    -- is empty (and not closed). We return @Nothing@ immediately if
    -- the queue is closed and empty.
    readTMQueue :: TMQueue a -> STM (Maybe a)
    readTMQueue :: forall a. TMQueue a -> STM (Maybe a)
    readTMQueue (TMQueue TVar Bool
    closed TQueue a
    queue) = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then TQueue a -> STM (Maybe a)
    forall a. TQueue a -> STM (Maybe a)
    tryReadTQueue TQueue a
    queue
            else a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> STM a -> STM (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM a
    forall a. TQueue a -> STM a
    readTQueue TQueue a
    queue
    {-
    -- The above is lazier reading from @queue@, and slightly optimized, compared to the clearer:
    readTMQueue (TMQueue closed queue) = do
        b  <- isEmptyTQueue queue
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> readTQueue queue
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | A version of 'readTMQueue' 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.
    tryReadTMQueue :: TMQueue a -> STM (Maybe (Maybe a))
    tryReadTMQueue :: forall a. TMQueue a -> STM (Maybe (Maybe a))
    tryReadTMQueue (TMQueue TVar Bool
    closed TQueue a
    queue) = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Maybe a
    forall a. a -> Maybe a
    Just (Maybe a -> Maybe (Maybe a))
    -> STM (Maybe a) -> STM (Maybe (Maybe a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM (Maybe a)
    forall a. TQueue a -> STM (Maybe a)
    tryReadTQueue TQueue a
    queue
            else Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just (Maybe a -> Maybe (Maybe a))
    -> STM (Maybe a) -> STM (Maybe (Maybe a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM (Maybe a)
    forall a. TQueue a -> STM (Maybe a)
    tryReadTQueue TQueue a
    queue
    {-
    -- The above is lazier reading from @queue@ (and removes an extraneous isEmptyTQueue when using the compatibility layer) than the clearer:
    tryReadTMQueue (TMQueue closed queue) = do
        b  <- isEmptyTQueue queue
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> tryReadTQueue queue
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | Get the next value from the @TMQueue@ without removing it,
    -- retrying if the queue is empty.
    peekTMQueue :: TMQueue a -> STM (Maybe a)
    peekTMQueue :: forall a. TMQueue a -> STM (Maybe a)
    peekTMQueue (TMQueue TVar Bool
    closed TQueue a
    queue) = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then do
                Bool
    b' <- TQueue a -> STM Bool
    forall a. TQueue a -> STM Bool
    isEmptyTQueue TQueue a
    queue
                if Bool
    b'
                    then Maybe a -> STM (Maybe a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
                    else a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> STM a -> STM (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM a
    forall a. TQueue a -> STM a
    peekTQueue TQueue a
    queue
            else a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> STM a -> STM (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM a
    forall a. TQueue a -> STM a
    peekTQueue TQueue a
    queue
    {-
    -- The above is lazier reading from @queue@ than the clearer:
    peekTMQueue (TMQueue closed 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 'peekTMQueue' 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.
    tryPeekTMQueue :: TMQueue a -> STM (Maybe (Maybe a))
    tryPeekTMQueue :: forall a. TMQueue a -> STM (Maybe (Maybe a))
    tryPeekTMQueue (TMQueue TVar Bool
    closed TQueue a
    queue) = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Maybe a
    forall a. a -> Maybe a
    Just (Maybe a -> Maybe (Maybe a))
    -> STM (Maybe a) -> STM (Maybe (Maybe a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM (Maybe a)
    forall a. TQueue a -> STM (Maybe a)
    tryPeekTQueue TQueue a
    queue
            else Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just (Maybe a -> Maybe (Maybe a))
    -> STM (Maybe a) -> STM (Maybe (Maybe a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TQueue a -> STM (Maybe a)
    forall a. TQueue a -> STM (Maybe a)
    tryPeekTQueue TQueue a
    queue
    {-
    -- The above is lazier reading from @queue@ (and removes an extraneous isEmptyTQueue when using the compatibility layer) than the clearer:
    tryPeekTMQueue (TMQueue closed 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 @TMQueue@. If the queue is closed then the
    -- value is silently discarded. Use 'isClosedTMQueue' to determine
    -- if the queue is closed before writing, as needed.
    writeTMQueue :: TMQueue a -> a -> STM ()
    writeTMQueue :: forall a. TMQueue a -> a -> STM ()
    writeTMQueue (TMQueue TVar Bool
    closed TQueue a
    queue) a
    x = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- discard silently
            else TQueue a -> a -> STM ()
    forall a. TQueue a -> a -> STM ()
    writeTQueue TQueue a
    queue a
    x

    -- | 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 'peekTMQueue' to circumvent this in certain
    -- circumstances.
    unGetTMQueue :: TMQueue a -> a -> STM ()
    unGetTMQueue :: forall a. TMQueue a -> a -> STM ()
    unGetTMQueue (TMQueue TVar Bool
    closed TQueue a
    queue) a
    x = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- discard silently
            else TQueue a -> a -> STM ()
    forall a. TQueue a -> a -> STM ()
    unGetTQueue TQueue a
    queue a
    x

    -- | Closes the @TMQueue@, preventing any further writes.
    closeTMQueue :: TMQueue a -> STM ()
    closeTMQueue :: forall a. TMQueue a -> STM ()
    closeTMQueue (TMQueue TVar Bool
    closed TQueue a
    _queue) =
        TVar Bool -> Bool -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Bool
    closed Bool
    True

    -- | Returns @True@ if the supplied @TMQueue@ has been closed.
    isClosedTMQueue :: TMQueue a -> STM Bool
    isClosedTMQueue :: forall a. TMQueue a -> STM Bool
    isClosedTMQueue (TMQueue TVar Bool
    closed TQueue a
    _queue) =
        TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed

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

    -- | Returns @True@ if the supplied @TMQueue@ is empty.
    isEmptyTMQueue :: TMQueue a -> STM Bool
    isEmptyTMQueue :: forall a. TMQueue a -> STM Bool
    isEmptyTMQueue (TMQueue TVar Bool
    _closed TQueue a
    queue) =
        TQueue a -> STM Bool
    forall a. TQueue a -> STM Bool
    isEmptyTQueue TQueue a
    queue

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