{-# LANGUAGE CPP #-}
module Control.Effect.Type.ListenPrim
(
ListenPrim(..)
, threadListenPrim
, threadListenPrimViaClass
) where
import Control.Monad.Trans
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Except (ExceptT)
import qualified Control.Monad.Trans.State.Strict as SSt
import qualified Control.Monad.Trans.State.Lazy as LSt
import qualified Control.Monad.Trans.Writer.Lazy as LWr
import qualified Control.Monad.Trans.Writer.Strict as SWr
import qualified Control.Monad.Trans.Writer.CPS as CPSWr
import Control.Monad.Writer.Class
import Control.Effect.Internal.ViaAlg
import Control.Effect.Internal.Reflection
import Control.Effect.Internal.Union
data ListenPrim o :: Effect where
ListenPrimTell :: o -> ListenPrim o m ()
ListenPrimListen :: m a -> ListenPrim o m (o, a)
threadListenPrim :: forall o t m a
. (MonadTrans t, Monad m)
=> ( forall x
. (forall y. ListenPrim o m y -> m y)
-> t m x -> t m (o, x)
)
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (t m) a -> t m a
threadListenPrim :: (forall x.
(forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x))
-> (forall y. ListenPrim o m y -> m y)
-> ListenPrim o (t m) a
-> t m a
threadListenPrim forall x.
(forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x)
h forall y. ListenPrim o m y -> m y
alg = \case
ListenPrimTell o
o -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ListenPrim o m () -> m ()
forall y. ListenPrim o m y -> m y
alg (o -> ListenPrim o m ()
forall o (m :: * -> *). o -> ListenPrim o m ()
ListenPrimTell o
o))
ListenPrimListen t m a
m -> (forall y. ListenPrim o m y -> m y) -> t m a -> t m (o, a)
forall x.
(forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x)
h forall y. ListenPrim o m y -> m y
alg t m a
m
{-# INLINE threadListenPrim #-}
instance ( Reifies s (ReifiedEffAlgebra (ListenPrim o) m)
, Monoid o
, Monad m
)
=> MonadWriter o (ViaAlg s (ListenPrim o) m) where
tell :: o -> ViaAlg s (ListenPrim o) m ()
tell o
o = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
ReifiedEffAlgebra forall x. ListenPrim o m x -> m x
alg -> (ListenPrim o m () -> m ())
-> ListenPrim o (ViaAlg s (ListenPrim o) m) ()
-> ViaAlg s (ListenPrim o) m ()
forall (n :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg ListenPrim o m () -> m ()
forall x. ListenPrim o m x -> m x
alg (o -> ListenPrim o (ViaAlg s (ListenPrim o) m) ()
forall o (m :: * -> *). o -> ListenPrim o m ()
ListenPrimTell o
o)
pass :: ViaAlg s (ListenPrim o) m (a, o -> o)
-> ViaAlg s (ListenPrim o) m a
pass = [Char]
-> ViaAlg s (ListenPrim o) m (a, o -> o)
-> ViaAlg s (ListenPrim o) m a
forall a. HasCallStack => [Char] -> a
error "threadListenPrimViaClass: Transformers threading ListenPrim \
\are not allowed to use pass."
listen :: ViaAlg s (ListenPrim o) m a -> ViaAlg s (ListenPrim o) m (a, o)
listen ViaAlg s (ListenPrim o) m a
m = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
ReifiedEffAlgebra forall x. ListenPrim o m x -> m x
alg ->
((o, a) -> (a, o))
-> ViaAlg s (ListenPrim o) m (o, a)
-> ViaAlg s (ListenPrim o) m (a, o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(o
s, a
a) -> (a
a, o
s)) (ViaAlg s (ListenPrim o) m (o, a)
-> ViaAlg s (ListenPrim o) m (a, o))
-> ViaAlg s (ListenPrim o) m (o, a)
-> ViaAlg s (ListenPrim o) m (a, o)
forall a b. (a -> b) -> a -> b
$ (ListenPrim o m (o, a) -> m (o, a))
-> ListenPrim o (ViaAlg s (ListenPrim o) m) (o, a)
-> ViaAlg s (ListenPrim o) m (o, a)
forall (n :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg ListenPrim o m (o, a) -> m (o, a)
forall x. ListenPrim o m x -> m x
alg (ViaAlg s (ListenPrim o) m a
-> ListenPrim o (ViaAlg s (ListenPrim o) m) (o, a)
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen ViaAlg s (ListenPrim o) m a
m)
{-# INLINE listen #-}
threadListenPrimViaClass :: forall o t m a
. (Monoid o, Monad m)
=> ( RepresentationalT t
, MonadTrans t
, forall b. MonadWriter o b => MonadWriter o (t b)
)
=> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (t m) a -> t m a
threadListenPrimViaClass :: (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (t m) a -> t m a
threadListenPrimViaClass forall x. ListenPrim o m x -> m x
alg = \case
ListenPrimTell o
o -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ ListenPrim o m () -> m ()
forall x. ListenPrim o m x -> m x
alg (o -> ListenPrim o m ()
forall o (m :: * -> *). o -> ListenPrim o m ()
ListenPrimTell o
o)
ListenPrimListen t m a
m ->
ReifiedEffAlgebra (ListenPrim o) m
-> (forall s (pr :: * -> *).
(pr ~ Proxy, Reifies s (ReifiedEffAlgebra (ListenPrim o) m)) =>
pr s -> t m a)
-> t m a
forall a r.
a
-> (forall s (pr :: * -> *).
(pr ~ Proxy, Reifies s a) =>
pr s -> r)
-> r
reify ((forall x. ListenPrim o m x -> m x)
-> ReifiedEffAlgebra (ListenPrim o) m
forall k (e :: (k -> *) -> k -> *) (m :: k -> *).
(forall (x :: k). e m x -> m x) -> ReifiedEffAlgebra e m
ReifiedEffAlgebra forall x. ListenPrim o m x -> m x
alg) ((forall s (pr :: * -> *).
(pr ~ Proxy, Reifies s (ReifiedEffAlgebra (ListenPrim o) m)) =>
pr s -> t m a)
-> t m a)
-> (forall s (pr :: * -> *).
(pr ~ Proxy, Reifies s (ReifiedEffAlgebra (ListenPrim o) m)) =>
pr s -> t m a)
-> t m a
forall a b. (a -> b) -> a -> b
$ \(pr s
_ :: pr s) ->
t (ViaAlg s (ListenPrim o) m) (o, a) -> t m (o, a)
forall s (e :: (* -> *) -> * -> *) (t :: (* -> *) -> * -> *)
(m :: * -> *) a.
RepresentationalT t =>
t (ViaAlg s e m) a -> t m a
unViaAlgT
(t (ViaAlg s (ListenPrim o) m) (o, a) -> t m (o, a))
-> t (ViaAlg s (ListenPrim o) m) (o, a) -> t m (o, a)
forall a b. (a -> b) -> a -> b
$ ((a, o) -> (o, a))
-> t (ViaAlg s (ListenPrim o) m) (a, o)
-> t (ViaAlg s (ListenPrim o) m) (o, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a, o
o) -> (o
o, a
a))
(t (ViaAlg s (ListenPrim o) m) (a, o)
-> t (ViaAlg s (ListenPrim o) m) (o, a))
-> t (ViaAlg s (ListenPrim o) m) (a, o)
-> t (ViaAlg s (ListenPrim o) m) (o, a)
forall a b. (a -> b) -> a -> b
$ t (ViaAlg s (ListenPrim o) m) a
-> t (ViaAlg s (ListenPrim o) m) (a, o)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
(t (ViaAlg s (ListenPrim o) m) a
-> t (ViaAlg s (ListenPrim o) m) (a, o))
-> t (ViaAlg s (ListenPrim o) m) a
-> t (ViaAlg s (ListenPrim o) m) (a, o)
forall a b. (a -> b) -> a -> b
$ t m a -> t (ViaAlg s (ListenPrim o) m) a
forall s (e :: (* -> *) -> * -> *) (t :: (* -> *) -> * -> *)
(m :: * -> *) a.
RepresentationalT t =>
t m a -> t (ViaAlg s e m) a
viaAlgT @s @(ListenPrim o) t m a
m
{-# INLINE threadListenPrimViaClass #-}
#define THREAD_LISTENPRIM(monadT) \
instance Monoid threadedMonoid \
=> ThreadsEff (monadT) (ListenPrim threadedMonoid) where \
threadEff = threadListenPrimViaClass; \
{-# INLINE threadEff #-}
THREAD_LISTENPRIM(ReaderT i)
THREAD_LISTENPRIM(ExceptT e)
THREAD_LISTENPRIM(LSt.StateT s)
THREAD_LISTENPRIM(SSt.StateT s)
instance Monoid s => ThreadsEff (LWr.WriterT s) (ListenPrim o) where
threadEff :: (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a -> WriterT s m a
threadEff = (forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a
forall o (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
(forall x.
(forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x))
-> (forall y. ListenPrim o m y -> m y)
-> ListenPrim o (t m) a
-> t m a
threadListenPrim ((forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a)
-> (forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a
forall a b. (a -> b) -> a -> b
$ \forall x. ListenPrim o m x -> m x
alg WriterT s m x
m ->
m ((o, x), s) -> WriterT s m (o, x)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LWr.WriterT
(m ((o, x), s) -> WriterT s m (o, x))
-> m ((o, x), s) -> WriterT s m (o, x)
forall a b. (a -> b) -> a -> b
$ ((o, (x, s)) -> ((o, x), s)) -> m (o, (x, s)) -> m ((o, x), s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(o
s, (x
a, s
o)) -> ((o
s, x
a), s
o))
(m (o, (x, s)) -> m ((o, x), s)) -> m (o, (x, s)) -> m ((o, x), s)
forall a b. (a -> b) -> a -> b
$ ListenPrim o m (o, (x, s)) -> m (o, (x, s))
forall x. ListenPrim o m x -> m x
alg
(ListenPrim o m (o, (x, s)) -> m (o, (x, s)))
-> ListenPrim o m (o, (x, s)) -> m (o, (x, s))
forall a b. (a -> b) -> a -> b
$ m (x, s) -> ListenPrim o m (o, (x, s))
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen
(m (x, s) -> ListenPrim o m (o, (x, s)))
-> m (x, s) -> ListenPrim o m (o, (x, s))
forall a b. (a -> b) -> a -> b
$ WriterT s m x -> m (x, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LWr.runWriterT WriterT s m x
m
{-# INLINE threadEff #-}
instance Monoid s => ThreadsEff (SWr.WriterT s) (ListenPrim o) where
threadEff :: (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a -> WriterT s m a
threadEff = (forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a
forall o (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
(forall x.
(forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x))
-> (forall y. ListenPrim o m y -> m y)
-> ListenPrim o (t m) a
-> t m a
threadListenPrim ((forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a)
-> (forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a
forall a b. (a -> b) -> a -> b
$ \forall x. ListenPrim o m x -> m x
alg WriterT s m x
m ->
m ((o, x), s) -> WriterT s m (o, x)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
SWr.WriterT
(m ((o, x), s) -> WriterT s m (o, x))
-> m ((o, x), s) -> WriterT s m (o, x)
forall a b. (a -> b) -> a -> b
$ ((o, (x, s)) -> ((o, x), s)) -> m (o, (x, s)) -> m ((o, x), s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(o
s, (x
a, s
o)) -> ((o
s, x
a), s
o))
(m (o, (x, s)) -> m ((o, x), s)) -> m (o, (x, s)) -> m ((o, x), s)
forall a b. (a -> b) -> a -> b
$ ListenPrim o m (o, (x, s)) -> m (o, (x, s))
forall x. ListenPrim o m x -> m x
alg
(ListenPrim o m (o, (x, s)) -> m (o, (x, s)))
-> ListenPrim o m (o, (x, s)) -> m (o, (x, s))
forall a b. (a -> b) -> a -> b
$ m (x, s) -> ListenPrim o m (o, (x, s))
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen
(m (x, s) -> ListenPrim o m (o, (x, s)))
-> m (x, s) -> ListenPrim o m (o, (x, s))
forall a b. (a -> b) -> a -> b
$ WriterT s m x -> m (x, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SWr.runWriterT WriterT s m x
m
{-# INLINE threadEff #-}
instance Monoid s => ThreadsEff (CPSWr.WriterT s) (ListenPrim o) where
threadEff :: (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a -> WriterT s m a
threadEff = (forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a
forall o (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
(forall x.
(forall y. ListenPrim o m y -> m y) -> t m x -> t m (o, x))
-> (forall y. ListenPrim o m y -> m y)
-> ListenPrim o (t m) a
-> t m a
threadListenPrim ((forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a)
-> (forall x.
(forall x. ListenPrim o m x -> m x)
-> WriterT s m x -> WriterT s m (o, x))
-> (forall x. ListenPrim o m x -> m x)
-> ListenPrim o (WriterT s m) a
-> WriterT s m a
forall a b. (a -> b) -> a -> b
$ \forall x. ListenPrim o m x -> m x
alg WriterT s m x
m ->
m ((o, x), s) -> WriterT s m (o, x)
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
CPSWr.writerT
(m ((o, x), s) -> WriterT s m (o, x))
-> m ((o, x), s) -> WriterT s m (o, x)
forall a b. (a -> b) -> a -> b
$ ((o, (x, s)) -> ((o, x), s)) -> m (o, (x, s)) -> m ((o, x), s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(o
s, (x
a, s
o)) -> ((o
s, x
a), s
o))
(m (o, (x, s)) -> m ((o, x), s)) -> m (o, (x, s)) -> m ((o, x), s)
forall a b. (a -> b) -> a -> b
$ ListenPrim o m (o, (x, s)) -> m (o, (x, s))
forall x. ListenPrim o m x -> m x
alg
(ListenPrim o m (o, (x, s)) -> m (o, (x, s)))
-> ListenPrim o m (o, (x, s)) -> m (o, (x, s))
forall a b. (a -> b) -> a -> b
$ m (x, s) -> ListenPrim o m (o, (x, s))
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen
(m (x, s) -> ListenPrim o m (o, (x, s)))
-> m (x, s) -> ListenPrim o m (o, (x, s))
forall a b. (a -> b) -> a -> b
$ WriterT s m x -> m (x, s)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPSWr.runWriterT WriterT s m x
m
{-# INLINE threadEff #-}