    {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
    {-# LANGUAGE CPP, DeriveDataTypeable #-}

    #if __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE Trustworthy #-}
    #endif

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Concurrent.STM.TQueue
    -- Copyright   :  (c) The University of Glasgow 2012
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  experimental
    -- Portability :  non-portable (requires STM)
    --
    -- A 'TQueue' is like a 'TChan', with two important differences:
    --
    --  * it has faster throughput than both 'TChan' and 'Chan' (although
    --    the costs are amortised, so the cost of individual operations
    --    can vary a lot).
    --
    --  * it does /not/ provide equivalents of the 'dupTChan' and
    --    'cloneTChan' operations.
    --
    -- The implementation is based on the traditional purely-functional
    -- queue representation that uses two lists to obtain amortised /O(1)/
    -- enqueue and dequeue operations.
    --
    -- @since 2.4
    -----------------------------------------------------------------------------

    module Control.Concurrent.STM.TQueue (
            -- * TQueue
            TQueue,
            newTQueue,
            newTQueueIO,
            readTQueue,
            tryReadTQueue,
            flushTQueue,
            peekTQueue,
            tryPeekTQueue,
            writeTQueue,
            unGetTQueue,
            isEmptyTQueue,
      ) where

    import GHC.Conc
    import Control.Monad (unless)
    import Data.Typeable (Typeable)

    -- | 'TQueue' is an abstract type representing an unbounded FIFO channel.
    --
    -- @since 2.4
    data TQueue a = TQueue {-# UNPACK #-} !(TVar [a])
                           {-# UNPACK #-} !(TVar [a])
      deriving Typeable

    instance Eq (TQueue a) where
      TQueue TVar [a]
    a TVar [a]
    _ == :: TQueue a -> TQueue a -> Bool
    == TQueue TVar [a]
    b TVar [a]
    _ = TVar [a]
    a TVar [a] -> TVar [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == TVar [a]
    b

    -- |Build and returns a new instance of 'TQueue'
    newTQueue :: STM (TQueue a)
    newTQueue :: forall a. STM (TQueue a)
    newTQueue = do
      TVar [a]
    read  <- [a] -> STM (TVar [a])
    forall a. a -> STM (TVar a)
    newTVar []
      TVar [a]
    write <- [a] -> STM (TVar [a])
    forall a. a -> STM (TVar a)
    newTVar []
      TQueue a -> STM (TQueue a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar [a] -> TVar [a] -> TQueue a
    forall a. TVar [a] -> TVar [a] -> TQueue a
    TQueue TVar [a]
    read TVar [a]
    write)

    -- |@IO@ version of 'newTQueue'.  This is useful for creating top-level
    -- 'TQueue's using 'System.IO.Unsafe.unsafePerformIO', because using
    -- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
    -- possible.
    newTQueueIO :: IO (TQueue a)
    newTQueueIO :: forall a. IO (TQueue a)
    newTQueueIO = do
      TVar [a]
    read  <- [a] -> IO (TVar [a])
    forall a. a -> IO (TVar a)
    newTVarIO []
      TVar [a]
    write <- [a] -> IO (TVar [a])
    forall a. a -> IO (TVar a)
    newTVarIO []
      TQueue a -> IO (TQueue a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar [a] -> TVar [a] -> TQueue a
    forall a. TVar [a] -> TVar [a] -> TQueue a
    TQueue TVar [a]
    read TVar [a]
    write)

    -- |Write a value to a 'TQueue'.
    writeTQueue :: TQueue a -> a -> STM ()
    writeTQueue :: forall a. TQueue a -> a -> STM ()
    writeTQueue (TQueue TVar [a]
    _read TVar [a]
    write) a
    a = do
      [a]
    listend <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    write
      TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    write (a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    listend)

    -- |Read the next value from the 'TQueue'.
    readTQueue :: TQueue a -> STM a
    readTQueue :: forall a. TQueue a -> STM a
    readTQueue (TQueue TVar [a]
    read TVar [a]
    write) = do
      [a]
    xs <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    read
      case [a]
    xs of
        (a
    x:[a]
    xs') -> do
          TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    read [a]
    xs'
          a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
        [] -> do
          [a]
    ys <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    write
          case [a]
    ys of
            [] -> STM a
    forall a. STM a
    retry
            [a]
    _  -> do
              let (a
    z:[a]
    zs) = [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ys -- NB. lazy: we want the transaction to be
                                      -- short, otherwise it will conflict
              TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    write []
              TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    read [a]
    zs
              a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    z

    -- | A version of 'readTQueue' which does not retry. Instead it
    -- returns @Nothing@ if no value is available.
    tryReadTQueue :: TQueue a -> STM (Maybe a)
    tryReadTQueue :: forall a. TQueue a -> STM (Maybe a)
    tryReadTQueue TQueue a
    c = (a -> Maybe a) -> STM a -> STM (Maybe a)
    forall a b. (a -> b) -> STM a -> STM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Maybe a
    forall a. a -> Maybe a
    Just (TQueue a -> STM a
    forall a. TQueue a -> STM a
    readTQueue TQueue a
    c) STM (Maybe a) -> STM (Maybe a) -> STM (Maybe a)
    forall a. STM a -> STM a -> STM a
    `orElse` 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

    -- | Efficiently read the entire contents of a 'TQueue' into a list. This
    -- function never retries.
    --
    -- @since 2.4.5
    flushTQueue :: TQueue a -> STM [a]
    flushTQueue :: forall a. TQueue a -> STM [a]
    flushTQueue (TQueue TVar [a]
    read TVar [a]
    write) = do
      [a]
    xs <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    read
      [a]
    ys <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    write
      Bool -> STM () -> STM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    xs) (STM () -> STM ()) -> STM () -> STM ()
    forall a b. (a -> b) -> a -> b
    $ TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    read []
      Bool -> STM () -> STM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    ys) (STM () -> STM ()) -> STM () -> STM ()
    forall a b. (a -> b) -> a -> b
    $ TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    write []
      [a] -> STM [a]
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([a]
    xs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ys)

    -- | Get the next value from the @TQueue@ without removing it,
    -- retrying if the channel is empty.
    peekTQueue :: TQueue a -> STM a
    peekTQueue :: forall a. TQueue a -> STM a
    peekTQueue (TQueue TVar [a]
    read TVar [a]
    write) = do
      [a]
    xs <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    read
      case [a]
    xs of
        (a
    x:[a]
    _) -> a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
        [] -> do
          [a]
    ys <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    write
          case [a]
    ys of
            [] -> STM a
    forall a. STM a
    retry
            [a]
    _  -> do
              let (a
    z:[a]
    zs) = [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    ys -- NB. lazy: we want the transaction to be
                                      -- short, otherwise it will conflict
              TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    write []
              TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    read (a
    za -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    zs)
              a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    z

    -- | A version of 'peekTQueue' which does not retry. Instead it
    -- returns @Nothing@ if no value is available.
    tryPeekTQueue :: TQueue a -> STM (Maybe a)
    tryPeekTQueue :: forall a. TQueue a -> STM (Maybe a)
    tryPeekTQueue TQueue a
    c = do
      Maybe a
    m <- TQueue a -> STM (Maybe a)
    forall a. TQueue a -> STM (Maybe a)
    tryReadTQueue TQueue a
    c
      case Maybe a
    m 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
    forall a. Maybe a
    Nothing
        Just a
    x  -> do
          TQueue a -> a -> STM ()
    forall a. TQueue a -> a -> STM ()
    unGetTQueue TQueue a
    c a
    x
          Maybe a -> STM (Maybe a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    m

    -- |Put a data item back onto a channel, where it will be the next item read.
    unGetTQueue :: TQueue a -> a -> STM ()
    unGetTQueue :: forall a. TQueue a -> a -> STM ()
    unGetTQueue (TQueue TVar [a]
    read TVar [a]
    _write) a
    a = do
      [a]
    xs <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    read
      TVar [a] -> [a] -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar [a]
    read (a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs)

    -- |Returns 'True' if the supplied 'TQueue' is empty.
    isEmptyTQueue :: TQueue a -> STM Bool
    isEmptyTQueue :: forall a. TQueue a -> STM Bool
    isEmptyTQueue (TQueue TVar [a]
    read TVar [a]
    write) = do
      [a]
    xs <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    read
      case [a]
    xs of
        (a
    _:[a]
    _) -> Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        [] -> do [a]
    ys <- TVar [a] -> STM [a]
    forall a. TVar a -> STM a
    readTVar TVar [a]
    write
                 case [a]
    ys of
                   [] -> Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                   [a]
    _  -> Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False