    {-# LANGUAGE
            CPP,
            MultiParamTypeClasses,
            FlexibleInstances
      #-}

    -- |This module exports no new symbols of its own.  It defines
    --  basic class instances for creating, reading, and writing 'TVar's and
    --  (if available) 'TMVar's, and re-exports the types for which it defines
    --  instances as well as the 'atomically' function, which is indispensible
    --  when playing with this stuff in ghci.
    module Data.MRef.Instances.STM
        ( STM
    #ifdef useTMVar
        , TMVar
    #endif
        , TVar

        , atomically
        ) where

    import Data.MRef.Types
    import Data.StateRef (readReference, writeReference, newReference)
    import Data.StateRef.Instances.STM ()

    import Control.Concurrent.STM

    -- MRef STM in IO monad
    instance NewMRef (MRef STM a) IO a where
    #ifdef useTMVar
        newMReference :: a -> IO (MRef STM a)
    newMReference = (TMVar a -> MRef STM a) -> IO (TMVar a) -> IO (MRef STM a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TMVar a -> MRef STM a
    forall sr (m :: * -> *) a.
    (TakeMRef sr m a, PutMRef sr m a) =>
    sr -> MRef m a
    MRef (IO (TMVar a) -> IO (MRef STM a))
    -> (a -> IO (TMVar a)) -> a -> IO (MRef STM a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> IO (TMVar a)
    forall a. a -> IO (TMVar a)
    newTMVarIO
        newEmptyMReference :: IO (MRef STM a)
    newEmptyMReference = (TMVar a -> MRef STM a) -> IO (TMVar a) -> IO (MRef STM a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TMVar a -> MRef STM a
    forall sr (m :: * -> *) a.
    (TakeMRef sr m a, PutMRef sr m a) =>
    sr -> MRef m a
    MRef IO (TMVar a)
    forall a. IO (TMVar a)
    newEmptyTMVarIO
    #else
        newMReference = fmap MRef . newTVarIO . Just
        newEmptyMReference = fmap MRef (newTVarIO Nothing)
    #endif

    instance TakeMRef (MRef STM a) IO a where
        takeMReference :: MRef STM a -> IO a
    takeMReference (MRef sr
    ref) = STM a -> IO a
    forall a. STM a -> IO a
    atomically (sr -> STM a
    forall sr (m :: * -> *) a. TakeMRef sr m a => sr -> m a
    takeMReference sr
    ref)
    instance PutMRef (MRef STM a) IO a where
        putMReference :: MRef STM a -> a -> IO ()
    putMReference (MRef sr
    ref) = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> (a -> STM ()) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . sr -> a -> STM ()
    forall sr (m :: * -> *) a. PutMRef sr m a => sr -> a -> m ()
    putMReference sr
    ref

    #ifdef useTMVar
    --TMVar in STM monad
    instance HasMRef STM where
        newMRef :: forall a. a -> STM (MRef STM a)
    newMRef a
    x    = (TMVar a -> MRef STM a) -> STM (TMVar a) -> STM (MRef STM a)
    forall a b. (a -> b) -> STM a -> STM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TMVar a -> MRef STM a
    forall sr (m :: * -> *) a.
    (TakeMRef sr m a, PutMRef sr m a) =>
    sr -> MRef m a
    MRef (a -> STM (TMVar a)
    forall a. a -> STM (TMVar a)
    newTMVar a
    x)
        newEmptyMRef :: forall a. STM (MRef STM a)
    newEmptyMRef = (TMVar a -> MRef STM a) -> STM (TMVar a) -> STM (MRef STM a)
    forall a b. (a -> b) -> STM a -> STM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TMVar a -> MRef STM a
    forall sr (m :: * -> *) a.
    (TakeMRef sr m a, PutMRef sr m a) =>
    sr -> MRef m a
    MRef STM (TMVar a)
    forall a. STM (TMVar a)
    newEmptyTMVar
    instance NewMRef (TMVar a) STM a where
        newMReference :: a -> STM (TMVar a)
    newMReference = a -> STM (TMVar a)
    forall a. a -> STM (TMVar a)
    newTMVar
        newEmptyMReference :: STM (TMVar a)
    newEmptyMReference = STM (TMVar a)
    forall a. STM (TMVar a)
    newEmptyTMVar

    instance TakeMRef (TMVar a) STM a where
        takeMReference :: TMVar a -> STM a
    takeMReference = TMVar a -> STM a
    forall a. TMVar a -> STM a
    takeTMVar
    instance PutMRef (TMVar a) STM a where
        putMReference :: TMVar a -> a -> STM ()
    putMReference = TMVar a -> a -> STM ()
    forall a. TMVar a -> a -> STM ()
    putTMVar

    -- TMVar in IO monad
    instance NewMRef (TMVar a) IO a where
        newMReference :: a -> IO (TMVar a)
    newMReference = a -> IO (TMVar a)
    forall a. a -> IO (TMVar a)
    newTMVarIO
        newEmptyMReference :: IO (TMVar a)
    newEmptyMReference = IO (TMVar a)
    forall a. IO (TMVar a)
    newEmptyTMVarIO

    instance TakeMRef (TMVar a) IO a where
        takeMReference :: TMVar a -> IO a
    takeMReference = STM a -> IO a
    forall a. STM a -> IO a
    atomically (STM a -> IO a) -> (TMVar a -> STM a) -> TMVar a -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TMVar a -> STM a
    forall sr (m :: * -> *) a. TakeMRef sr m a => sr -> m a
    takeMReference
    instance PutMRef (TMVar a) IO a where
        putMReference :: TMVar a -> a -> IO ()
    putMReference TMVar a
    ref = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> (a -> STM ()) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TMVar a -> a -> STM ()
    forall sr (m :: * -> *) a. PutMRef sr m a => sr -> a -> m ()
    putMReference TMVar a
    ref
    #endif

    -- incidental instances, which may occasionally be handy in a pinch
    -- TVars containing "Maybe" values in STM monad.
    -- Also use as default if TMVar isn't available.
    #ifndef useTMVar
    instance HasMRef STM where
        newMRef x    = fmap MRef (newTVar (Just x))
        newEmptyMRef = fmap MRef (newTVar Nothing)
    #endif
    instance NewMRef (TVar (Maybe a)) STM a where
        newMReference :: a -> STM (TVar (Maybe a))
    newMReference = Maybe a -> STM (TVar (Maybe a))
    forall sr (m :: * -> *) a. NewRef sr m a => a -> m sr
    newReference (Maybe a -> STM (TVar (Maybe a)))
    -> (a -> Maybe a) -> a -> STM (TVar (Maybe a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    forall a. a -> Maybe a
    Just
        newEmptyMReference :: STM (TVar (Maybe a))
    newEmptyMReference = Maybe a -> STM (TVar (Maybe a))
    forall sr (m :: * -> *) a. NewRef sr m a => a -> m sr
    newReference Maybe a
    forall a. Maybe a
    Nothing

    instance TakeMRef (TVar (Maybe a)) STM a where
        takeMReference :: TVar (Maybe a) -> STM a
    takeMReference TVar (Maybe a)
    ref = do
            x <- TVar (Maybe a) -> STM (Maybe a)
    forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
    readReference TVar (Maybe a)
    ref
            case x of
                Maybe a
    Nothing -> STM a
    forall a. STM a
    retry
                Just a
    x -> do
                    TVar (Maybe a) -> Maybe a -> STM ()
    forall sr (m :: * -> *) a. WriteRef sr m a => sr -> a -> m ()
    writeReference TVar (Maybe a)
    ref 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
    x
    instance PutMRef (TVar (Maybe a)) STM a where
        putMReference :: TVar (Maybe a) -> a -> STM ()
    putMReference TVar (Maybe a)
    ref a
    val = do
            x <- TVar (Maybe a) -> STM (Maybe a)
    forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
    readReference TVar (Maybe a)
    ref
            case x of
                Maybe a
    Nothing -> TVar (Maybe a) -> Maybe a -> STM ()
    forall sr (m :: * -> *) a. WriteRef sr m a => sr -> a -> m ()
    writeReference TVar (Maybe a)
    ref (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    val)
                Just a
    x -> STM ()
    forall a. STM a
    retry

    -- TVars containing "Maybe" values in IO monad
    instance NewMRef (TVar (Maybe a)) IO a where
        newMReference :: a -> IO (TVar (Maybe a))
    newMReference = Maybe a -> IO (TVar (Maybe a))
    forall sr (m :: * -> *) a. NewRef sr m a => a -> m sr
    newReference (Maybe a -> IO (TVar (Maybe a)))
    -> (a -> Maybe a) -> a -> IO (TVar (Maybe a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    forall a. a -> Maybe a
    Just
        newEmptyMReference :: IO (TVar (Maybe a))
    newEmptyMReference = Maybe a -> IO (TVar (Maybe a))
    forall sr (m :: * -> *) a. NewRef sr m a => a -> m sr
    newReference Maybe a
    forall a. Maybe a
    Nothing
    instance TakeMRef (TVar (Maybe a)) IO a where
        takeMReference :: TVar (Maybe a) -> IO a
    takeMReference = STM a -> IO a
    forall a. STM a -> IO a
    atomically (STM a -> IO a)
    -> (TVar (Maybe a) -> STM a) -> TVar (Maybe a) -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar (Maybe a) -> STM a
    forall sr (m :: * -> *) a. TakeMRef sr m a => sr -> m a
    takeMReference
    instance PutMRef (TVar (Maybe a)) IO a where
        putMReference :: TVar (Maybe a) -> a -> IO ()
    putMReference TVar (Maybe a)
    ref = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> (a -> STM ()) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar (Maybe a) -> a -> STM ()
    forall sr (m :: * -> *) a. PutMRef sr m a => sr -> a -> m ()
    putMReference TVar (Maybe a)
    ref