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

    -- |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.
    --
    --  Note that this module declares incoherent instances.  The universe should
    --  refrain from imploding on itself as long as you don't define
    --  \"instance MonadIO STM\".  However, hugs doesn't seem to support
    --  overlapping instances, so I may have to give up on the dream of MonadIO
    --  everywhere, or introduce some major conditional compilation stuff. (or
    --  abandon hugs support)

    module Data.StateRef.Instances.STM
        ( STM
        , TVar
    #ifdef useTMVar
        , TMVar
    #endif

        , atomically
        ) where

    import Data.StateRef.Types
    import Control.Monad.Trans
    import Control.Concurrent.STM

    -- (STM a) in STM and IO-compatible monads
    instance ReadRef (STM a) STM a where
        readReference :: STM a -> STM a
    readReference = STM a -> STM a
    forall a. a -> a
    id
    instance MonadIO m => ReadRef (STM a) m a where
        readReference :: STM a -> m a
    readReference = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> (STM a -> IO a) -> STM a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM a -> IO a
    forall a. STM a -> IO a
    atomically

    -- TVar in STM monad
    instance HasRef STM where
        newRef :: forall a. a -> STM (Ref STM a)
    newRef a
    x = do
            sr <- a -> STM (TVar a)
    forall a. a -> STM (TVar a)
    newTVar a
    x
            return (Ref sr)
    instance NewRef (TVar a) STM a where
        newReference :: a -> STM (TVar a)
    newReference = a -> STM (TVar a)
    forall a. a -> STM (TVar a)
    newTVar
    instance ReadRef (TVar a) STM a where
        readReference :: TVar a -> STM a
    readReference = TVar a -> STM a
    forall a. TVar a -> STM a
    readTVar
    instance WriteRef (TVar a) STM a where
        writeReference :: TVar a -> a -> STM ()
    writeReference = TVar a -> a -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar
    instance ModifyRef (TVar a) STM a where
        atomicModifyReference :: forall b. TVar a -> (a -> (a, b)) -> STM b
    atomicModifyReference   = TVar a -> (a -> (a, b)) -> STM b
    forall {m :: * -> *} {sr} {t} {a} {b}.
    (Monad m, ReadRef sr m t, WriteRef sr m a) =>
    sr -> (t -> (a, b)) -> m b
    defaultAtomicModifyReference
        modifyReference :: TVar a -> (a -> a) -> STM ()
    modifyReference         = TVar a -> (a -> a) -> STM ()
    forall {m :: * -> *} {sr} {t} {a}.
    (Monad m, ReadRef sr m t, WriteRef sr m a) =>
    sr -> (t -> a) -> m ()
    defaultModifyReference

    -- TVar in IO-compatible monads
    instance MonadIO m => NewRef (TVar a) m a where
        newReference :: a -> m (TVar a)
    newReference = IO (TVar a) -> m (TVar a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (TVar a) -> m (TVar a))
    -> (a -> IO (TVar a)) -> a -> m (TVar a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> IO (TVar a)
    forall a. a -> IO (TVar a)
    newTVarIO
    instance MonadIO m => ReadRef (TVar a) m a where
        readReference :: TVar a -> m a
    readReference = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> (TVar a -> IO a) -> TVar a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM a -> IO a
    forall a. STM a -> IO a
    atomically (STM a -> IO a) -> (TVar a -> STM a) -> TVar a -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar a -> STM a
    forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
    readReference
    instance MonadIO m => WriteRef (TVar a) m a where
        writeReference :: TVar a -> a -> m ()
    writeReference TVar a
    ref = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 a -> a -> STM ()
    forall sr (m :: * -> *) a. WriteRef sr m a => sr -> a -> m ()
    writeReference TVar a
    ref
    instance MonadIO m => ModifyRef (TVar a) m a where
        modifyReference :: TVar a -> (a -> a) -> m ()
    modifyReference TVar a
    ref         = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> ((a -> a) -> IO ()) -> (a -> a) -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> ((a -> a) -> STM ()) -> (a -> a) -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar a -> (a -> a) -> STM ()
    forall sr (m :: * -> *) a.
    ModifyRef sr m a =>
    sr -> (a -> a) -> m ()
    modifyReference TVar a
    ref
        atomicModifyReference :: forall b. TVar a -> (a -> (a, b)) -> m b
    atomicModifyReference TVar a
    ref   = IO b -> m b
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO b -> m b) -> ((a -> (a, b)) -> IO b) -> (a -> (a, b)) -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM b -> IO b
    forall a. STM a -> IO a
    atomically (STM b -> IO b)
    -> ((a -> (a, b)) -> STM b) -> (a -> (a, b)) -> IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar a -> (a -> (a, b)) -> STM b
    forall b. TVar a -> (a -> (a, b)) -> STM b
    forall sr (m :: * -> *) a b.
    ModifyRef sr m a =>
    sr -> (a -> (a, b)) -> m b
    atomicModifyReference TVar a
    ref

    -- @Ref STM@ in IO-compatible monads
    instance MonadIO m => NewRef (Ref STM a) m a where
        newReference :: a -> m (Ref STM a)
    newReference a
    x = do
            sr <- IO (TVar a) -> m (TVar a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (a -> IO (TVar a)
    forall a. a -> IO (TVar a)
    newTVarIO a
    x)
            return (Ref sr)
    instance MonadIO m => ReadRef (Ref STM a) m a where
        readReference :: Ref STM a -> m a
    readReference (Ref sr
    sr) = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (STM a -> IO a
    forall a. STM a -> IO a
    atomically (sr -> STM a
    forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
    readReference sr
    sr))
    instance MonadIO m => WriteRef (Ref STM a) m a where
        writeReference :: Ref STM a -> a -> m ()
    writeReference (Ref sr
    sr) = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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. WriteRef sr m a => sr -> a -> m ()
    writeReference sr
    sr
    instance MonadIO m => ModifyRef (Ref STM a) m a where
        modifyReference :: Ref STM a -> (a -> a) -> m ()
    modifyReference (Ref sr
    sr)        = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> ((a -> a) -> IO ()) -> (a -> a) -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> ((a -> a) -> STM ()) -> (a -> a) -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . sr -> (a -> a) -> STM ()
    forall sr (m :: * -> *) a.
    ModifyRef sr m a =>
    sr -> (a -> a) -> m ()
    modifyReference sr
    sr
        atomicModifyReference :: forall b. Ref STM a -> (a -> (a, b)) -> m b
    atomicModifyReference (Ref sr
    sr)  = IO b -> m b
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO b -> m b) -> ((a -> (a, b)) -> IO b) -> (a -> (a, b)) -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM b -> IO b
    forall a. STM a -> IO a
    atomically (STM b -> IO b)
    -> ((a -> (a, b)) -> STM b) -> (a -> (a, b)) -> IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . sr -> (a -> (a, b)) -> STM b
    forall b. sr -> (a -> (a, b)) -> STM b
    forall sr (m :: * -> *) a b.
    ModifyRef sr m a =>
    sr -> (a -> (a, b)) -> m b
    atomicModifyReference sr
    sr

    #ifdef useTMVar
    -- TMVar in STM monad
    instance NewRef (TMVar a) STM (Maybe a) where
        newReference :: Maybe a -> STM (TMVar a)
    newReference Maybe a
    Nothing = STM (TMVar a)
    forall a. STM (TMVar a)
    newEmptyTMVar
        newReference (Just a
    x) = a -> STM (TMVar a)
    forall a. a -> STM (TMVar a)
    newTMVar a
    x
    instance ReadRef (TMVar a) STM (Maybe a) where
        readReference :: TMVar a -> STM (Maybe a)
    readReference TMVar a
    tmv = (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 (TMVar a -> STM a
    forall a. TMVar a -> STM a
    readTMVar TMVar a
    tmv) 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

    -- TMVar in IO-compatible monad
    instance MonadIO m => NewRef (TMVar a) m (Maybe a) where
        newReference :: Maybe a -> m (TMVar a)
    newReference Maybe a
    Nothing = IO (TMVar a) -> m (TMVar a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (TMVar a)
    forall a. IO (TMVar a)
    newEmptyTMVarIO
        newReference (Just a
    x) = IO (TMVar a) -> m (TMVar a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (a -> IO (TMVar a)
    forall a. a -> IO (TMVar a)
    newTMVarIO a
    x)
    instance MonadIO m => ReadRef (TMVar a) m (Maybe a) where
        readReference :: TMVar a -> m (Maybe a)
    readReference = IO (Maybe a) -> m (Maybe a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe a) -> m (Maybe a))
    -> (TMVar a -> IO (Maybe a)) -> TMVar a -> m (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM (Maybe a) -> IO (Maybe a)
    forall a. STM a -> IO a
    atomically (STM (Maybe a) -> IO (Maybe a))
    -> (TMVar a -> STM (Maybe a)) -> TMVar a -> IO (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TMVar a -> STM (Maybe a)
    forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
    readReference
    #endif