{-# LANGUAGE
CPP,
MultiParamTypeClasses,
FlexibleInstances
#-}
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
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 (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 (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 ref :: 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 ref :: 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
instance HasMRef STM where
newMRef :: a -> STM (MRef STM a)
newMRef x :: a
x = (TMVar a -> MRef STM a) -> STM (TMVar a) -> STM (MRef STM a)
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 :: STM (MRef STM a)
newEmptyMRef = (TMVar a -> MRef STM a) -> STM (TMVar a) -> STM (MRef STM a)
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
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 ref :: 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
#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 ref :: TVar (Maybe a)
ref = do
Maybe a
x <- TVar (Maybe a) -> STM (Maybe a)
forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
readReference TVar (Maybe a)
ref
case Maybe a
x of
Nothing -> STM a
forall a. STM a
retry
Just x :: 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 (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 ref :: TVar (Maybe a)
ref val :: a
val = do
Maybe a
x <- TVar (Maybe a) -> STM (Maybe a)
forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
readReference TVar (Maybe a)
ref
case Maybe a
x of
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 x :: a
x -> STM ()
forall a. STM a
retry
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 ref :: 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