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

    -- HACK: in GHC 7.10, Haddock complains about Control.Monad.STM and
    -- System.IO.Unsafe being imported but unused. However, if we use
    -- CPP to avoid including them under Haddock, then it will fail to
    -- compile!
    #ifdef __HADDOCK__
    {-# OPTIONS_GHC -fno-warn-unused-imports #-}
    #endif

    #if __GLASGOW_HASKELL__ >= 701
    #  ifdef __HADDOCK__
    {-# LANGUAGE Trustworthy #-}
    #  else
    {-# LANGUAGE Safe #-}
    #  endif
    #endif
    ----------------------------------------------------------------
    --                                                    2015.03.29
    -- |
    -- Module      :  Control.Concurrent.STM.TMChan
    -- Copyright   :  Copyright (c) 2011--2015 wren gayle romano
    -- License     :  BSD
    -- Maintainer  :  wren@community.haskell.org
    -- Stability   :  provisional
    -- Portability :  non-portable (GHC STM, DeriveDataTypeable)
    --
    -- A version of "Control.Concurrent.STM.TChan" where the queue is
    -- closeable. This is similar to a @TChan (Maybe a)@ with a
    -- monotonicity guarantee that once there's a @Nothing@ there will
    -- always be @Nothing@.
    ----------------------------------------------------------------
    module Control.Concurrent.STM.TMChan
        (
        -- * The TMChan type
          TMChan()
        -- ** Creating TMChans
        , newTMChan
        , newTMChanIO
        , dupTMChan
        , newBroadcastTMChan
        , newBroadcastTMChanIO
        -- ** Reading from TMChans
        , readTMChan
        , tryReadTMChan
        , peekTMChan
        , tryPeekTMChan
        -- ** Writing to TMChans
        , writeTMChan
        , unGetTMChan
        -- ** Closing TMChans
        , closeTMChan
        -- ** Predicates
        , isClosedTMChan
        , isEmptyTMChan
        ) 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.TChan -- N.B., GHC only

    -- N.B., we need a Custom cabal build-type for this to work.
    #ifdef __HADDOCK__
    import Control.Monad.STM   (atomically)
    import System.IO.Unsafe    (unsafePerformIO)
    #endif
    ----------------------------------------------------------------

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

    -- | Build and returns a new instance of @TMChan@.
    newTMChan :: STM (TMChan a)
    newTMChan :: STM (TMChan a)
    newTMChan = do
        TVar Bool
    closed <- Bool -> STM (TVar Bool)
    forall a. a -> STM (TVar a)
    newTVar Bool
    False
        TChan a
    chan   <- STM (TChan a)
    forall a. STM (TChan a)
    newTChan
        TMChan a -> STM (TMChan a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TChan a -> TMChan a
    forall a. TVar Bool -> TChan a -> TMChan a
    TMChan TVar Bool
    closed TChan a
    chan)

    -- | @IO@ version of 'newTMChan'. This is useful for creating
    -- top-level @TMChan@s using 'unsafePerformIO', because using
    -- 'atomically' inside 'unsafePerformIO' isn't possible.
    newTMChanIO :: IO (TMChan a)
    newTMChanIO :: IO (TMChan a)
    newTMChanIO = do
        TVar Bool
    closed <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        TChan a
    chan   <- IO (TChan a)
    forall a. IO (TChan a)
    newTChanIO
        TMChan a -> IO (TMChan a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TChan a -> TMChan a
    forall a. TVar Bool -> TChan a -> TMChan a
    TMChan TVar Bool
    closed TChan a
    chan)

    -- | Like 'newBroadcastTChan'.
    --
    -- /Since: 2.1.0/
    newBroadcastTMChan :: STM (TMChan a)
    newBroadcastTMChan :: STM (TMChan a)
    newBroadcastTMChan = do
        TVar Bool
    closed <- Bool -> STM (TVar Bool)
    forall a. a -> STM (TVar a)
    newTVar Bool
    False
        TChan a
    chan   <- STM (TChan a)
    forall a. STM (TChan a)
    newBroadcastTChan
        TMChan a -> STM (TMChan a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TChan a -> TMChan a
    forall a. TVar Bool -> TChan a -> TMChan a
    TMChan TVar Bool
    closed TChan a
    chan)

    -- | @IO@ version of 'newBroadcastTMChan'.
    --
    -- /Since: 2.1.0/
    newBroadcastTMChanIO :: IO (TMChan a)
    newBroadcastTMChanIO :: IO (TMChan a)
    newBroadcastTMChanIO = do
        TVar Bool
    closed <- Bool -> IO (TVar Bool)
    forall a. a -> IO (TVar a)
    newTVarIO Bool
    False
        TChan a
    chan   <- IO (TChan a)
    forall a. IO (TChan a)
    newBroadcastTChanIO
        TMChan a -> IO (TMChan a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TChan a -> TMChan a
    forall a. TVar Bool -> TChan a -> TMChan a
    TMChan TVar Bool
    closed TChan a
    chan)

    -- | Duplicate a @TMChan@: the duplicate channel begins empty, but
    -- data written to either channel from then on will be available
    -- from both, and closing one copy will close them all. Hence this
    -- creates a kind of broadcast channel, where data written by anyone
    -- is seen by everyone else.
    dupTMChan :: TMChan a -> STM (TMChan a)
    dupTMChan :: TMChan a -> STM (TMChan a)
    dupTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) = do
        TChan a
    new_chan <- TChan a -> STM (TChan a)
    forall a. TChan a -> STM (TChan a)
    dupTChan TChan a
    chan
        TMChan a -> STM (TMChan a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar Bool -> TChan a -> TMChan a
    forall a. TVar Bool -> TChan a -> TMChan a
    TMChan TVar Bool
    closed TChan a
    new_chan)

    -- | Read the next value from the @TMChan@, retrying if the channel
    -- is empty (and not closed). We return @Nothing@ immediately if
    -- the channel is closed and empty.
    readTMChan :: TMChan a -> STM (Maybe a)
    readTMChan :: TMChan a -> STM (Maybe a)
    readTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then TChan a -> STM (Maybe a)
    forall a. TChan a -> STM (Maybe a)
    tryReadTChan TChan a
    chan
            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
    <$> TChan a -> STM a
    forall a. TChan a -> STM a
    readTChan TChan a
    chan
    {-
    -- The above is lazier reading from @chan@, and slightly optimized, compared to the clearer:
    readTMChan (TMChan closed chan) = do
        b  <- isEmptyTChan chan
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> readTChan chan
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | A version of 'readTMChan' which does not retry. Instead it
    -- returns @Just Nothing@ if the channel is open but no value is
    -- available; it still returns @Nothing@ if the channel is closed
    -- and empty.
    tryReadTMChan :: TMChan a -> STM (Maybe (Maybe a))
    tryReadTMChan :: TMChan a -> STM (Maybe (Maybe a))
    tryReadTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) = 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 (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
    <$> TChan a -> STM (Maybe a)
    forall a. TChan a -> STM (Maybe a)
    tryReadTChan TChan a
    chan
            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
    <$> TChan a -> STM (Maybe a)
    forall a. TChan a -> STM (Maybe a)
    tryReadTChan TChan a
    chan
    {-
    -- The above is lazier reading from @chan@ (and removes an extraneous isEmptyTChan when using the compatibility layer) than the clearer:
    tryReadTMChan (TMChan closed chan) = do
        b  <- isEmptyTChan chan
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> tryReadTChan chan
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | Get the next value from the @TMChan@ without removing it,
    -- retrying if the channel is empty.
    peekTMChan :: TMChan a -> STM (Maybe a)
    peekTMChan :: TMChan a -> STM (Maybe a)
    peekTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) = do
        Bool
    b <- TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed
        if Bool
    b
            then do
                Bool
    b' <- TChan a -> STM Bool
    forall a. TChan a -> STM Bool
    isEmptyTChan TChan a
    chan
                if Bool
    b'
                    then Maybe a -> STM (Maybe 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
    <$> TChan a -> STM a
    forall a. TChan a -> STM a
    peekTChan TChan a
    chan
            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
    <$> TChan a -> STM a
    forall a. TChan a -> STM a
    peekTChan TChan a
    chan
    {-
    -- The above is lazier reading from @chan@ than the clearer:
    peekTMChan (TMChan closed chan) = do
        b  <- isEmptyTChan chan
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> peekTChan chan
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | A version of 'peekTMChan' which does not retry. Instead it
    -- returns @Just Nothing@ if the channel is open but no value is
    -- available; it still returns @Nothing@ if the channel is closed
    -- and empty.
    tryPeekTMChan :: TMChan a -> STM (Maybe (Maybe a))
    tryPeekTMChan :: TMChan a -> STM (Maybe (Maybe a))
    tryPeekTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) = 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 (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
    <$> TChan a -> STM (Maybe a)
    forall a. TChan a -> STM (Maybe a)
    tryPeekTChan TChan a
    chan
            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
    <$> TChan a -> STM (Maybe a)
    forall a. TChan a -> STM (Maybe a)
    tryPeekTChan TChan a
    chan
    {-
    -- The above is lazier reading from @chan@ (and removes an extraneous isEmptyTChan when using the compatibility layer) than the clearer:
    tryPeekTMChan (TMChan closed chan) = do
        b  <- isEmptyTChan chan
        b' <- readTVar closed
        if b && b'
            then return Nothing
            else Just <$> tryPeekTChan chan
    -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
    -}

    -- | Write a value to a @TMChan@. If the channel is closed then the
    -- value is silently discarded. Use 'isClosedTMChan' to determine
    -- if the channel is closed before writing, as needed.
    writeTMChan :: TMChan a -> a -> STM ()
    writeTMChan :: TMChan a -> a -> STM ()
    writeTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) x :: 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 (m :: * -> *) a. Monad m => a -> m a
    return () -- discard silently
            else TChan a -> a -> STM ()
    forall a. TChan a -> a -> STM ()
    writeTChan TChan a
    chan a
    x

    -- | Put a data item back onto a channel, where it will be the next
    -- item read. If the channel is closed then the value is silently
    -- discarded; you can use 'peekTMChan' to circumvent this in certain
    -- circumstances.
    unGetTMChan :: TMChan a -> a -> STM ()
    unGetTMChan :: TMChan a -> a -> STM ()
    unGetTMChan (TMChan closed :: TVar Bool
    closed chan :: TChan a
    chan) x :: 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 (m :: * -> *) a. Monad m => a -> m a
    return () -- discard silently
            else TChan a -> a -> STM ()
    forall a. TChan a -> a -> STM ()
    unGetTChan TChan a
    chan a
    x

    -- | Closes the @TMChan@, preventing any further writes.
    closeTMChan :: TMChan a -> STM ()
    closeTMChan :: TMChan a -> STM ()
    closeTMChan (TMChan closed :: TVar Bool
    closed _chan :: TChan a
    _chan) =
        TVar Bool -> Bool -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Bool
    closed Bool
    True

    -- | Returns @True@ if the supplied @TMChan@ has been closed.
    isClosedTMChan :: TMChan a -> STM Bool
    isClosedTMChan :: TMChan a -> STM Bool
    isClosedTMChan (TMChan closed :: TVar Bool
    closed _chan :: TChan a
    _chan) =
        TVar Bool -> STM Bool
    forall a. TVar a -> STM a
    readTVar TVar Bool
    closed

    {-
    -- | Returns @True@ if the supplied @TMChan@ has been closed.
    isClosedTMChanIO :: TMChan a -> IO Bool
    isClosedTMChanIO (TMChan closed _chan) =
        readTVarIO closed
    -}

    -- | Returns @True@ if the supplied @TMChan@ is empty.
    isEmptyTMChan :: TMChan a -> STM Bool
    isEmptyTMChan :: TMChan a -> STM Bool
    isEmptyTMChan (TMChan _closed :: TVar Bool
    _closed chan :: TChan a
    chan) =
        TChan a -> STM Bool
    forall a. TChan a -> STM Bool
    isEmptyTChan TChan a
    chan

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