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
instance ReadRef (STM a) STM a where
readReference = id
instance MonadIO m => ReadRef (STM a) m a where
readReference = liftIO . atomically
instance HasRef STM where
newRef x = do
sr <- newTVar x
return (Ref sr)
instance NewRef (TVar a) STM a where
newReference = newTVar
instance ReadRef (TVar a) STM a where
readReference = readTVar
instance WriteRef (TVar a) STM a where
writeReference = writeTVar
instance ModifyRef (TVar a) STM a where
atomicModifyReference = defaultAtomicModifyReference
modifyReference = defaultModifyReference
instance MonadIO m => NewRef (TVar a) m a where
newReference = liftIO . newTVarIO
instance MonadIO m => ReadRef (TVar a) m a where
readReference = liftIO . atomically . readReference
instance MonadIO m => WriteRef (TVar a) m a where
writeReference ref = liftIO . atomically . writeReference ref
instance MonadIO m => ModifyRef (TVar a) m a where
modifyReference ref = liftIO . atomically . modifyReference ref
atomicModifyReference ref = liftIO . atomically . atomicModifyReference ref
instance MonadIO m => NewRef (Ref STM a) m a where
newReference x = do
sr <- liftIO (newTVarIO x)
return (Ref sr)
instance MonadIO m => ReadRef (Ref STM a) m a where
readReference (Ref sr) = liftIO (atomically (readReference sr))
instance MonadIO m => WriteRef (Ref STM a) m a where
writeReference (Ref sr) = liftIO . atomically . writeReference sr
instance MonadIO m => ModifyRef (Ref STM a) m a where
modifyReference (Ref sr) = liftIO . atomically . modifyReference sr
atomicModifyReference (Ref sr) = liftIO . atomically . atomicModifyReference sr
#ifdef useTMVar
instance NewRef (TMVar a) STM (Maybe a) where
newReference Nothing = newEmptyTMVar
newReference (Just x) = newTMVar x
instance ReadRef (TMVar a) STM (Maybe a) where
readReference tmv = fmap Just (readTMVar tmv) `orElse` return Nothing
instance MonadIO m => NewRef (TMVar a) m (Maybe a) where
newReference Nothing = liftIO newEmptyTMVarIO
newReference (Just x) = liftIO (newTMVarIO x)
instance MonadIO m => ReadRef (TMVar a) m (Maybe a) where
readReference = liftIO . atomically . readReference
#endif