    {-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}

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

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Concurrent.STM.TMVar
    -- Copyright   :  (c) The University of Glasgow 2004
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  experimental
    -- Portability :  non-portable (requires STM)
    --
    -- TMVar: Transactional MVars, for use in the STM monad
    -- (GHC only)
    --
    -----------------------------------------------------------------------------

    module Control.Concurrent.STM.TMVar (
    #ifdef __GLASGOW_HASKELL__
            -- * TMVars
            TMVar,
            newTMVar,
            newEmptyTMVar,
            newTMVarIO,
            newEmptyTMVarIO,
            takeTMVar,
            putTMVar,
            readTMVar,
            writeTMVar,
            tryReadTMVar,
            swapTMVar,
            tryTakeTMVar,
            tryPutTMVar,
            isEmptyTMVar,
            mkWeakTMVar
    #endif
      ) where

    #ifdef __GLASGOW_HASKELL__
    import GHC.Base
    import GHC.Conc
    import GHC.Weak

    import Data.Typeable (Typeable)

    newtype TMVar a = TMVar (TVar (Maybe a)) deriving (TMVar a -> TMVar a -> Bool
    (TMVar a -> TMVar a -> Bool)
    -> (TMVar a -> TMVar a -> Bool) -> Eq (TMVar a)
    forall a. TMVar a -> TMVar a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. TMVar a -> TMVar a -> Bool
    == :: TMVar a -> TMVar a -> Bool
    $c/= :: forall a. TMVar a -> TMVar a -> Bool
    /= :: TMVar a -> TMVar a -> Bool
    Eq, Typeable)
    {- ^
    A 'TMVar' is a synchronising variable, used
    for communication between concurrent threads.  It can be thought of
    as a box, which may be empty or full.
    -}

    -- |Create a 'TMVar' which contains the supplied value.
    newTMVar :: a -> STM (TMVar a)
    newTMVar :: forall a. a -> STM (TMVar a)
    newTMVar a
    a = do
      TVar (Maybe a)
    t <- Maybe a -> STM (TVar (Maybe a))
    forall a. a -> STM (TVar a)
    newTVar (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a)
      TMVar a -> STM (TMVar a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar (Maybe a) -> TMVar a
    forall a. TVar (Maybe a) -> TMVar a
    TMVar TVar (Maybe a)
    t)

    -- |@IO@ version of 'newTMVar'.  This is useful for creating top-level
    -- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
    -- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
    -- possible.
    newTMVarIO :: a -> IO (TMVar a)
    newTMVarIO :: forall a. a -> IO (TMVar a)
    newTMVarIO a
    a = do
      TVar (Maybe a)
    t <- Maybe a -> IO (TVar (Maybe a))
    forall a. a -> IO (TVar a)
    newTVarIO (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a)
      TMVar a -> IO (TMVar a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar (Maybe a) -> TMVar a
    forall a. TVar (Maybe a) -> TMVar a
    TMVar TVar (Maybe a)
    t)

    -- |Create a 'TMVar' which is initially empty.
    newEmptyTMVar :: STM (TMVar a)
    newEmptyTMVar :: forall a. STM (TMVar a)
    newEmptyTMVar = do
      TVar (Maybe a)
    t <- Maybe a -> STM (TVar (Maybe a))
    forall a. a -> STM (TVar a)
    newTVar Maybe a
    forall a. Maybe a
    Nothing
      TMVar a -> STM (TMVar a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar (Maybe a) -> TMVar a
    forall a. TVar (Maybe a) -> TMVar a
    TMVar TVar (Maybe a)
    t)

    -- |@IO@ version of 'newEmptyTMVar'.  This is useful for creating top-level
    -- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
    -- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
    -- possible.
    newEmptyTMVarIO :: IO (TMVar a)
    newEmptyTMVarIO :: forall a. IO (TMVar a)
    newEmptyTMVarIO = do
      TVar (Maybe a)
    t <- Maybe a -> IO (TVar (Maybe a))
    forall a. a -> IO (TVar a)
    newTVarIO Maybe a
    forall a. Maybe a
    Nothing
      TMVar a -> IO (TMVar a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TVar (Maybe a) -> TMVar a
    forall a. TVar (Maybe a) -> TMVar a
    TMVar TVar (Maybe a)
    t)

    -- |Return the contents of the 'TMVar'.  If the 'TMVar' is currently
    -- empty, the transaction will 'retry'.  After a 'takeTMVar',
    -- the 'TMVar' is left empty.
    takeTMVar :: TMVar a -> STM a
    takeTMVar :: forall a. TMVar a -> STM a
    takeTMVar (TMVar TVar (Maybe a)
    t) = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      case Maybe a
    m of
        Maybe a
    Nothing -> STM a
    forall a. STM a
    retry
        Just a
    a  -> do TVar (Maybe a) -> Maybe a -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Maybe a)
    t Maybe a
    forall a. Maybe a
    Nothing; a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- | A version of 'takeTMVar' that does not 'retry'.  The 'tryTakeTMVar'
    -- function returns 'Nothing' if the 'TMVar' was empty, or @'Just' a@ if
    -- the 'TMVar' was full with contents @a@.  After 'tryTakeTMVar', the
    -- 'TMVar' is left empty.
    tryTakeTMVar :: TMVar a -> STM (Maybe a)
    tryTakeTMVar :: forall a. TMVar a -> STM (Maybe a)
    tryTakeTMVar (TMVar TVar (Maybe a)
    t) = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      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
    a  -> do TVar (Maybe a) -> Maybe a -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Maybe a)
    t Maybe a
    forall a. Maybe a
    Nothing; Maybe a -> STM (Maybe a)
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a)

    -- |Put a value into a 'TMVar'.  If the 'TMVar' is currently full,
    -- 'putTMVar' will 'retry'.
    putTMVar :: TMVar a -> a -> STM ()
    putTMVar :: forall a. TMVar a -> a -> STM ()
    putTMVar (TMVar TVar (Maybe a)
    t) a
    a = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      case Maybe a
    m of
        Maybe a
    Nothing -> do TVar (Maybe a) -> Maybe a -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Maybe a)
    t (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a); () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just a
    _  -> STM ()
    forall a. STM a
    retry

    -- | A version of 'putTMVar' that does not 'retry'.  The 'tryPutTMVar'
    -- function attempts to put the value @a@ into the 'TMVar', returning
    -- 'True' if it was successful, or 'False' otherwise.
    tryPutTMVar :: TMVar a -> a -> STM Bool
    tryPutTMVar :: forall a. TMVar a -> a -> STM Bool
    tryPutTMVar (TMVar TVar (Maybe a)
    t) a
    a = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      case Maybe a
    m of
        Maybe a
    Nothing -> do TVar (Maybe a) -> Maybe a -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Maybe a)
    t (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a); Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        Just a
    _  -> Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | This is a combination of 'takeTMVar' and 'putTMVar'; ie. it
    -- takes the value from the 'TMVar', puts it back, and also returns
    -- it.
    readTMVar :: TMVar a -> STM a
    readTMVar :: forall a. TMVar a -> STM a
    readTMVar (TMVar TVar (Maybe a)
    t) = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      case Maybe a
    m of
        Maybe a
    Nothing -> STM a
    forall a. STM a
    retry
        Just a
    a  -> a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- | A version of 'readTMVar' which does not retry. Instead it
    -- returns @Nothing@ if no value is available.
    --
    -- @since 2.3
    tryReadTMVar :: TMVar a -> STM (Maybe a)
    tryReadTMVar :: forall a. TMVar a -> STM (Maybe a)
    tryReadTMVar (TMVar TVar (Maybe a)
    t) = TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t

    -- |Swap the contents of a 'TMVar' for a new value.
    swapTMVar :: TMVar a -> a -> STM a
    swapTMVar :: forall a. TMVar a -> a -> STM a
    swapTMVar (TMVar TVar (Maybe a)
    t) a
    new = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      case Maybe a
    m of
        Maybe a
    Nothing -> STM a
    forall a. STM a
    retry
        Just a
    old -> do TVar (Maybe a) -> Maybe a -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Maybe a)
    t (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    new); a -> STM a
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    old

    -- | Non-blocking write of a new value to a 'TMVar'
    -- Puts if empty. Replaces if populated.
    writeTMVar :: TMVar a -> a -> STM ()
    writeTMVar :: forall a. TMVar a -> a -> STM ()
    writeTMVar TMVar a
    t a
    new = TMVar a -> STM (Maybe a)
    forall a. TMVar a -> STM (Maybe a)
    tryTakeTMVar TMVar a
    t STM (Maybe a) -> STM () -> STM ()
    forall a b. STM a -> STM b -> STM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TMVar a -> a -> STM ()
    forall a. TMVar a -> a -> STM ()
    putTMVar TMVar a
    t a
    new

    -- |Check whether a given 'TMVar' is empty.
    isEmptyTMVar :: TMVar a -> STM Bool
    isEmptyTMVar :: forall a. TMVar a -> STM Bool
    isEmptyTMVar (TMVar TVar (Maybe a)
    t) = do
      Maybe a
    m <- TVar (Maybe a) -> STM (Maybe a)
    forall a. TVar a -> STM a
    readTVar TVar (Maybe a)
    t
      case Maybe a
    m of
        Maybe a
    Nothing -> Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        Just a
    _  -> Bool -> STM Bool
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | Make a 'Weak' pointer to a 'TMVar', using the second argument as
    -- a finalizer to run when the 'TMVar' is garbage-collected.
    --
    -- @since 2.4.4
    mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a))
    mkWeakTMVar :: forall a. TMVar a -> IO () -> IO (Weak (TMVar a))
    mkWeakTMVar tmv :: TMVar a
    tmv@(TMVar (TVar TVar# RealWorld (Maybe a)
    t#)) (IO State# RealWorld -> (# State# RealWorld, () #)
    finalizer) = (State# RealWorld -> (# State# RealWorld, Weak (TMVar a) #))
    -> IO (Weak (TMVar a))
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, Weak (TMVar a) #))
     -> IO (Weak (TMVar a)))
    -> (State# RealWorld -> (# State# RealWorld, Weak (TMVar a) #))
    -> IO (Weak (TMVar a))
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    s ->
        case TVar# RealWorld (Maybe a)
    -> TMVar a
    -> (State# RealWorld -> (# State# RealWorld, () #))
    -> State# RealWorld
    -> (# State# RealWorld, Weak# (TMVar a) #)
    forall a b c.
    a
    -> b
    -> (State# RealWorld -> (# State# RealWorld, c #))
    -> State# RealWorld
    -> (# State# RealWorld, Weak# b #)
    mkWeak# TVar# RealWorld (Maybe a)
    t# TMVar a
    tmv State# RealWorld -> (# State# RealWorld, () #)
    finalizer State# RealWorld
    s of (# State# RealWorld
    s1, Weak# (TMVar a)
    w #) -> (# State# RealWorld
    s1, Weak# (TMVar a) -> Weak (TMVar a)
    forall v. Weak# v -> Weak v
    Weak Weak# (TMVar a)
    w #)
    #endif