{-# LANGUAGE
CPP,
MultiParamTypeClasses,
FlexibleInstances,
IncoherentInstances
#-}
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 :: 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 (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
instance HasRef STM where
newRef :: a -> STM (Ref STM a)
newRef a
x = do
TVar a
sr <- a -> STM (TVar a)
forall a. a -> STM (TVar a)
newTVar a
x
Ref STM a -> STM (Ref STM a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar a -> Ref STM a
forall sr (m :: * -> *) a. ModifyRef sr m a => sr -> Ref m a
Ref TVar a
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 :: 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
instance MonadIO m => NewRef (TVar a) m a where
newReference :: a -> m (TVar a)
newReference = IO (TVar a) -> m (TVar 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 (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 (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 (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 :: TVar a -> (a -> (a, b)) -> m b
atomicModifyReference TVar a
ref = IO b -> m b
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 sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference TVar a
ref
instance MonadIO m => NewRef (Ref STM a) m a where
newReference :: a -> m (Ref STM a)
newReference a
x = do
TVar a
sr <- IO (TVar a) -> m (TVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO (TVar a)
forall a. a -> IO (TVar a)
newTVarIO a
x)
Ref STM a -> m (Ref STM a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar a -> Ref STM a
forall sr (m :: * -> *) a. ModifyRef sr m a => sr -> Ref m a
Ref TVar a
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 (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 (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 (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 :: Ref STM a -> (a -> (a, b)) -> m b
atomicModifyReference (Ref sr
sr) = IO b -> m b
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 sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference sr
sr
#ifdef useTMVar
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
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 (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 (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 (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