{-# LANGUAGE Safe #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Concurrent.RCU.Class
( MonadNew(..)
, MonadReading(..)
, MonadWriting(..)
, MonadRCU(..)
, copySRef
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Prelude
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
class Monad m => MonadNew s m | m -> s where
newSRef :: a -> m (s a)
default newSRef :: (m ~ t n, MonadTrans t, MonadNew s n) => a -> m (s a)
newSRef a
a = n (s a) -> t n (s a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> n (s a)
forall (s :: * -> *) (m :: * -> *) a. MonadNew s m => a -> m (s a)
newSRef a
a)
instance MonadNew s m => MonadNew s (ReaderT e m)
instance (MonadNew s m, Monoid w) => MonadNew s (Strict.WriterT w m)
instance (MonadNew s m, Monoid w) => MonadNew s (Lazy.WriterT w m)
instance MonadNew s' m => MonadNew s' (Strict.StateT s m)
instance MonadNew s' m => MonadNew s' (Lazy.StateT s m)
instance (MonadNew s' m, Monoid w) => MonadNew s' (Strict.RWST r w s m)
instance (MonadNew s' m, Monoid w) => MonadNew s' (Lazy.RWST r w s m)
instance MonadNew s m => MonadNew s (ExceptT e m)
instance MonadNew s m => MonadNew s (MaybeT m)
instance MonadNew s m => MonadNew s (IdentityT m)
class MonadNew s m => MonadReading s m | m -> s where
readSRef :: s a -> m a
default readSRef :: (m ~ t n, MonadTrans t, MonadReading s n) => s a -> m a
readSRef s a
r = n a -> t n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s a -> n a
forall (s :: * -> *) (m :: * -> *) a.
MonadReading s m =>
s a -> m a
readSRef s a
r)
{-# INLINE readSRef #-}
copySRef :: MonadReading s m => s a -> m (s a)
copySRef :: s a -> m (s a)
copySRef s a
r = do
a
a <- s a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadReading s m =>
s a -> m a
readSRef s a
r
a -> m (s a)
forall (s :: * -> *) (m :: * -> *) a. MonadNew s m => a -> m (s a)
newSRef a
a
{-# INLINE copySRef #-}
instance MonadReading s m => MonadReading s (ReaderT e m)
instance (MonadReading s m, Monoid w) => MonadReading s (Strict.WriterT w m)
instance (MonadReading s m, Monoid w) => MonadReading s (Lazy.WriterT w m)
instance MonadReading s' m => MonadReading s' (Strict.StateT s m)
instance MonadReading s' m => MonadReading s' (Lazy.StateT s m)
instance (MonadReading s' m, Monoid w) => MonadReading s' (Strict.RWST r w s m)
instance (MonadReading s' m, Monoid w) => MonadReading s' (Lazy.RWST r w s m)
instance MonadReading s m => MonadReading s (ExceptT e m)
instance MonadReading s m => MonadReading s (MaybeT m)
instance MonadReading s m => MonadReading s (IdentityT m)
class MonadReading s m => MonadWriting s m | m -> s where
writeSRef :: s a -> a -> m ()
default writeSRef :: (m ~ t n, MonadTrans t, MonadWriting s n) => s a -> a -> m ()
writeSRef s a
r a
a = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s a -> a -> n ()
forall (s :: * -> *) (m :: * -> *) a.
MonadWriting s m =>
s a -> a -> m ()
writeSRef s a
r a
a)
synchronize :: m ()
default synchronize :: (m ~ t n, MonadTrans t, MonadWriting s n) => m ()
synchronize = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n ()
forall (s :: * -> *) (m :: * -> *). MonadWriting s m => m ()
synchronize
instance MonadWriting s m => MonadWriting s (ReaderT e m)
instance (MonadWriting s m, Monoid w) => MonadWriting s (Strict.WriterT w m)
instance (MonadWriting s m, Monoid w) => MonadWriting s (Lazy.WriterT w m)
instance MonadWriting s' m => MonadWriting s' (Strict.StateT s m)
instance MonadWriting s' m => MonadWriting s' (Lazy.StateT s m)
instance (MonadWriting s' m, Monoid w) => MonadWriting s' (Strict.RWST r w s m)
instance (MonadWriting s' m, Monoid w) => MonadWriting s' (Lazy.RWST r w s m)
instance MonadWriting s m => MonadWriting s (IdentityT m)
instance MonadWriting s m => MonadWriting s (ExceptT e m)
instance MonadWriting s m => MonadWriting s (MaybeT m)
class
( MonadReading s (Reading m)
, MonadWriting s (Writing m)
, MonadNew s m
) => MonadRCU s m | m -> s where
type Reading m :: * -> *
type Writing m :: * -> *
type Thread m :: * -> *
forking :: m a -> m (Thread m a)
joining :: Thread m a -> m a
reading :: Reading m a -> m a
writing :: Writing m a -> m a
instance MonadRCU s m => MonadRCU s (ReaderT e m) where
type Reading (ReaderT e m) = ReaderT e (Reading m)
type Writing (ReaderT e m) = ReaderT e (Writing m)
type Thread (ReaderT e m) = Thread m
forking :: ReaderT e m a -> ReaderT e m (Thread (ReaderT e m) a)
forking (ReaderT e -> m a
f) = (e -> m (Thread m a)) -> ReaderT e m (Thread m a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m (Thread m a)) -> ReaderT e m (Thread m a))
-> (e -> m (Thread m a)) -> ReaderT e m (Thread m a)
forall a b. (a -> b) -> a -> b
$ \e
a -> m a -> m (Thread m a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
m a -> m (Thread m a)
forking (e -> m a
f e
a)
joining :: Thread (ReaderT e m) a -> ReaderT e m a
joining = m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT e m a)
-> (Thread m a -> m a) -> Thread m a -> ReaderT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread m a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Thread m a -> m a
joining
reading :: Reading (ReaderT e m) a -> ReaderT e m a
reading (ReaderT f) = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m a) -> ReaderT e m a) -> (e -> m a) -> ReaderT e m a
forall a b. (a -> b) -> a -> b
$ \e
a -> Reading m a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Reading m a -> m a
reading (e -> Reading m a
f e
a)
writing :: Writing (ReaderT e m) a -> ReaderT e m a
writing (ReaderT f) = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> m a) -> ReaderT e m a) -> (e -> m a) -> ReaderT e m a
forall a b. (a -> b) -> a -> b
$ \e
a -> Writing m a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Writing m a -> m a
writing (e -> Writing m a
f e
a)
{-# INLINE forking #-}
{-# INLINE joining #-}
{-# INLINE reading #-}
{-# INLINE writing #-}
instance MonadRCU s m => MonadRCU s (IdentityT m) where
type Reading (IdentityT m) = Reading m
type Writing (IdentityT m) = Writing m
type Thread (IdentityT m) = Thread m
forking :: IdentityT m a -> IdentityT m (Thread (IdentityT m) a)
forking (IdentityT m a
m) = m (Thread m a) -> IdentityT m (Thread m a)
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> m (Thread m a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
m a -> m (Thread m a)
forking m a
m)
joining :: Thread (IdentityT m) a -> IdentityT m a
joining = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> (Thread m a -> m a) -> Thread m a -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread m a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Thread m a -> m a
joining
reading :: Reading (IdentityT m) a -> IdentityT m a
reading Reading (IdentityT m) a
m = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (Reading m a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Reading m a -> m a
reading Reading m a
Reading (IdentityT m) a
m)
writing :: Writing (IdentityT m) a -> IdentityT m a
writing Writing (IdentityT m) a
m = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (Writing m a -> m a
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Writing m a -> m a
writing Writing m a
Writing (IdentityT m) a
m)
{-# INLINE forking #-}
{-# INLINE joining #-}
{-# INLINE reading #-}
{-# INLINE writing #-}
instance MonadRCU s m => MonadRCU s (ExceptT e m) where
type Reading (ExceptT e m) = ExceptT e (Reading m)
type Writing (ExceptT e m) = ExceptT e (Writing m)
type Thread (ExceptT e m) = ExceptT e (Thread m)
forking :: ExceptT e m a -> ExceptT e m (Thread (ExceptT e m) a)
forking (ExceptT m (Either e a)
m) = m (ExceptT e (Thread m) a) -> ExceptT e m (ExceptT e (Thread m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ExceptT e (Thread m) a)
-> ExceptT e m (ExceptT e (Thread m) a))
-> m (ExceptT e (Thread m) a)
-> ExceptT e m (ExceptT e (Thread m) a)
forall a b. (a -> b) -> a -> b
$ Thread m (Either e a) -> ExceptT e (Thread m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Thread m (Either e a) -> ExceptT e (Thread m) a)
-> m (Thread m (Either e a)) -> m (ExceptT e (Thread m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either e a) -> m (Thread m (Either e a))
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
m a -> m (Thread m a)
forking m (Either e a)
m
joining :: Thread (ExceptT e m) a -> ExceptT e m a
joining (ExceptT m) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ Thread m (Either e a) -> m (Either e a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Thread m a -> m a
joining Thread m (Either e a)
m
reading :: Reading (ExceptT e m) a -> ExceptT e m a
reading (ExceptT m) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ Reading m (Either e a) -> m (Either e a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Reading m a -> m a
reading Reading m (Either e a)
m
writing :: Writing (ExceptT e m) a -> ExceptT e m a
writing (ExceptT m) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ Writing m (Either e a) -> m (Either e a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Writing m a -> m a
writing Writing m (Either e a)
m
{-# INLINE forking #-}
{-# INLINE joining #-}
{-# INLINE reading #-}
{-# INLINE writing #-}
instance MonadRCU s m => MonadRCU s (MaybeT m) where
type Reading (MaybeT m) = MaybeT (Reading m)
type Writing (MaybeT m) = MaybeT (Writing m)
type Thread (MaybeT m) = MaybeT (Thread m)
forking :: MaybeT m a -> MaybeT m (Thread (MaybeT m) a)
forking (MaybeT m (Maybe a)
m) = m (MaybeT (Thread m) a) -> MaybeT m (MaybeT (Thread m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MaybeT (Thread m) a) -> MaybeT m (MaybeT (Thread m) a))
-> m (MaybeT (Thread m) a) -> MaybeT m (MaybeT (Thread m) a)
forall a b. (a -> b) -> a -> b
$ Thread m (Maybe a) -> MaybeT (Thread m) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Thread m (Maybe a) -> MaybeT (Thread m) a)
-> m (Thread m (Maybe a)) -> m (MaybeT (Thread m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a) -> m (Thread m (Maybe a))
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
m a -> m (Thread m a)
forking m (Maybe a)
m
joining :: Thread (MaybeT m) a -> MaybeT m a
joining (MaybeT m) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ Thread m (Maybe a) -> m (Maybe a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Thread m a -> m a
joining Thread m (Maybe a)
m
reading :: Reading (MaybeT m) a -> MaybeT m a
reading (MaybeT m) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ Reading m (Maybe a) -> m (Maybe a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Reading m a -> m a
reading Reading m (Maybe a)
m
writing :: Writing (MaybeT m) a -> MaybeT m a
writing (MaybeT m) = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ Writing m (Maybe a) -> m (Maybe a)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Writing m a -> m a
writing Writing m (Maybe a)
m
{-# INLINE forking #-}
{-# INLINE joining #-}
{-# INLINE reading #-}
{-# INLINE writing #-}
instance (MonadRCU s m, Monoid e) => MonadRCU s (Strict.WriterT e m) where
type Reading (Strict.WriterT e m) = Strict.WriterT e (Reading m)
type Writing (Strict.WriterT e m) = Strict.WriterT e (Writing m)
type Thread (Strict.WriterT e m) = Strict.WriterT e (Thread m)
forking :: WriterT e m a -> WriterT e m (Thread (WriterT e m) a)
forking (Strict.WriterT m (a, e)
m) = m (WriterT e (Thread m) a) -> WriterT e m (WriterT e (Thread m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (WriterT e (Thread m) a)
-> WriterT e m (WriterT e (Thread m) a))
-> m (WriterT e (Thread m) a)
-> WriterT e m (WriterT e (Thread m) a)
forall a b. (a -> b) -> a -> b
$ Thread m (a, e) -> WriterT e (Thread m) a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (Thread m (a, e) -> WriterT e (Thread m) a)
-> m (Thread m (a, e)) -> m (WriterT e (Thread m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, e) -> m (Thread m (a, e))
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
m a -> m (Thread m a)
forking m (a, e)
m
joining :: Thread (WriterT e m) a -> WriterT e m a
joining (Strict.WriterT m) = m (a, e) -> WriterT e m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, e) -> WriterT e m a) -> m (a, e) -> WriterT e m a
forall a b. (a -> b) -> a -> b
$ Thread m (a, e) -> m (a, e)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Thread m a -> m a
joining Thread m (a, e)
m
reading :: Reading (WriterT e m) a -> WriterT e m a
reading (Strict.WriterT m) = m (a, e) -> WriterT e m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, e) -> WriterT e m a) -> m (a, e) -> WriterT e m a
forall a b. (a -> b) -> a -> b
$ Reading m (a, e) -> m (a, e)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Reading m a -> m a
reading Reading m (a, e)
m
writing :: Writing (WriterT e m) a -> WriterT e m a
writing (Strict.WriterT m) = m (a, e) -> WriterT e m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, e) -> WriterT e m a) -> m (a, e) -> WriterT e m a
forall a b. (a -> b) -> a -> b
$ Writing m (a, e) -> m (a, e)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Writing m a -> m a
writing Writing m (a, e)
m
{-# INLINE forking #-}
{-# INLINE joining #-}
{-# INLINE reading #-}
{-# INLINE writing #-}
instance (MonadRCU s m, Monoid e) => MonadRCU s (Lazy.WriterT e m) where
type Reading (Lazy.WriterT e m) = Lazy.WriterT e (Reading m)
type Writing (Lazy.WriterT e m) = Lazy.WriterT e (Writing m)
type Thread (Lazy.WriterT e m) = Lazy.WriterT e (Thread m)
forking :: WriterT e m a -> WriterT e m (Thread (WriterT e m) a)
forking (Lazy.WriterT m (a, e)
m) = m (WriterT e (Thread m) a) -> WriterT e m (WriterT e (Thread m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (WriterT e (Thread m) a)
-> WriterT e m (WriterT e (Thread m) a))
-> m (WriterT e (Thread m) a)
-> WriterT e m (WriterT e (Thread m) a)
forall a b. (a -> b) -> a -> b
$ Thread m (a, e) -> WriterT e (Thread m) a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (Thread m (a, e) -> WriterT e (Thread m) a)
-> m (Thread m (a, e)) -> m (WriterT e (Thread m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, e) -> m (Thread m (a, e))
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
m a -> m (Thread m a)
forking m (a, e)
m
joining :: Thread (WriterT e m) a -> WriterT e m a
joining (Lazy.WriterT m) = m (a, e) -> WriterT e m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, e) -> WriterT e m a) -> m (a, e) -> WriterT e m a
forall a b. (a -> b) -> a -> b
$ Thread m (a, e) -> m (a, e)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Thread m a -> m a
joining Thread m (a, e)
m
reading :: Reading (WriterT e m) a -> WriterT e m a
reading (Lazy.WriterT m) = m (a, e) -> WriterT e m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, e) -> WriterT e m a) -> m (a, e) -> WriterT e m a
forall a b. (a -> b) -> a -> b
$ Reading m (a, e) -> m (a, e)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Reading m a -> m a
reading Reading m (a, e)
m
writing :: Writing (WriterT e m) a -> WriterT e m a
writing (Lazy.WriterT m) = m (a, e) -> WriterT e m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, e) -> WriterT e m a) -> m (a, e) -> WriterT e m a
forall a b. (a -> b) -> a -> b
$ Writing m (a, e) -> m (a, e)
forall (s :: * -> *) (m :: * -> *) a.
MonadRCU s m =>
Writing m a -> m a
writing Writing m (a, e)
m
{-# INLINE forking #-}
{-# INLINE joining #-}
{-# INLINE reading #-}
{-# INLINE writing #-}