{-# 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 = fmap MRef . newTMVarIO
newEmptyMReference = fmap MRef newEmptyTMVarIO
#else
newMReference = fmap MRef . newTVarIO . Just
newEmptyMReference = fmap MRef (newTVarIO Nothing)
#endif
instance TakeMRef (MRef STM a) IO a where
takeMReference (MRef ref) = atomically (takeMReference ref)
instance PutMRef (MRef STM a) IO a where
putMReference (MRef ref) = atomically . putMReference ref
#ifdef useTMVar
instance HasMRef STM where
newMRef x = fmap MRef (newTMVar x)
newEmptyMRef = fmap MRef newEmptyTMVar
instance NewMRef (TMVar a) STM a where
newMReference = newTMVar
newEmptyMReference = newEmptyTMVar
instance TakeMRef (TMVar a) STM a where
takeMReference = takeTMVar
instance PutMRef (TMVar a) STM a where
putMReference = putTMVar
instance NewMRef (TMVar a) IO a where
newMReference = newTMVarIO
newEmptyMReference = newEmptyTMVarIO
instance TakeMRef (TMVar a) IO a where
takeMReference = atomically . takeMReference
instance PutMRef (TMVar a) IO a where
putMReference ref = atomically . putMReference 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 = newReference . Just
newEmptyMReference = newReference Nothing
instance TakeMRef (TVar (Maybe a)) STM a where
takeMReference ref = do
x <- readReference ref
case x of
Nothing -> retry
Just x -> do
writeReference ref Nothing
return x
instance PutMRef (TVar (Maybe a)) STM a where
putMReference ref val = do
x <- readReference ref
case x of
Nothing -> writeReference ref (Just val)
Just x -> retry
instance NewMRef (TVar (Maybe a)) IO a where
newMReference = newReference . Just
newEmptyMReference = newReference Nothing
instance TakeMRef (TVar (Maybe a)) IO a where
takeMReference = atomically . takeMReference
instance PutMRef (TVar (Maybe a)) IO a where
putMReference ref = atomically . putMReference ref