{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Polysemy.ConstraintAbsorber.MonadWriter
( absorbWriter
) where
import qualified Control.Monad.Writer.Class as S
import Polysemy
import Polysemy.ConstraintAbsorber
import Polysemy.Writer
absorbWriter
:: forall w r a
. ( Monoid w
, Member (Writer w) r
)
=> (S.MonadWriter w (Sem r) => Sem r a)
-> Sem r a
absorbWriter :: forall w (r :: EffectRow) a.
(Monoid w, Member (Writer w) r) =>
(MonadWriter w (Sem r) => Sem r a) -> Sem r a
absorbWriter =
let swapTuple :: (b, a) -> (a, b)
swapTuple (b
x,a
y) = (a
y,b
x)
semTell :: w -> Sem r ()
semTell = w -> Sem r ()
forall o (r :: EffectRow). Member (Writer o) r => o -> Sem r ()
tell
semListen :: Member (Writer w) r => Sem r b -> Sem r (b, w)
semListen :: forall b. Member (Writer w) r => Sem r b -> Sem r (b, w)
semListen = ((w, b) -> (b, w)) -> Sem r (w, b) -> Sem r (b, w)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w, b) -> (b, w)
forall {b} {a}. (b, a) -> (a, b)
swapTuple (Sem r (w, b) -> Sem r (b, w))
-> (Sem r b -> Sem r (w, b)) -> Sem r b -> Sem r (b, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o (r :: EffectRow) a.
Member (Writer o) r =>
Sem r a -> Sem r (o, a)
listen @w
semPass :: Member (Writer w) r => Sem r (b, w -> w) -> Sem r b
semPass :: forall b. Member (Writer w) r => Sem r (b, w -> w) -> Sem r b
semPass = forall o (r :: EffectRow) a.
Member (Writer o) r =>
Sem r (o -> o, a) -> Sem r a
pass @w (Sem r (w -> w, b) -> Sem r b)
-> (Sem r (b, w -> w) -> Sem r (w -> w, b))
-> Sem r (b, w -> w)
-> Sem r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, w -> w) -> (w -> w, b))
-> Sem r (b, w -> w) -> Sem r (w -> w, b)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, w -> w) -> (w -> w, b)
forall {b} {a}. (b, a) -> (a, b)
swapTuple
in forall (p :: (* -> *) -> Constraint) (x :: (* -> *) -> * -> * -> *)
d (r :: EffectRow) a.
d
-> (forall s. Reifies s d :- p (x (Sem r) s))
-> (p (Sem r) => Sem r a)
-> Sem r a
absorbWithSem @(S.MonadWriter _) @Action
((w -> Sem r ())
-> (forall a. Sem r a -> Sem r (a, w))
-> (forall a. Sem r (a, w -> w) -> Sem r a)
-> WriterDict w (Sem r)
forall w (m :: * -> *).
(w -> m ())
-> (forall a. m a -> m (a, w))
-> (forall a. m (a, w -> w) -> m a)
-> WriterDict w m
WriterDict w -> Sem r ()
semTell Sem r a -> Sem r (a, w)
forall a. Sem r a -> Sem r (a, w)
forall b. Member (Writer w) r => Sem r b -> Sem r (b, w)
semListen Sem r (a, w -> w) -> Sem r a
forall a. Sem r (a, w -> w) -> Sem r a
forall b. Member (Writer w) r => Sem r (b, w -> w) -> Sem r b
semPass)
((Reifies s (WriterDict w (Sem r)) =>
Dict (MonadWriter w (Action (Sem r) s)))
-> Reifies s (WriterDict w (Sem r))
:- MonadWriter w (Action (Sem r) s)
forall (a :: Constraint) (b :: Constraint). (a => Dict b) -> a :- b
Sub Dict (MonadWriter w (Action (Sem r) s))
Reifies s (WriterDict w (Sem r)) =>
Dict (MonadWriter w (Action (Sem r) s))
forall (a :: Constraint). a => Dict a
Dict)
{-# INLINEABLE absorbWriter #-}
data WriterDict w m = WriterDict
{ forall w (m :: * -> *). WriterDict w m -> w -> m ()
tell_ :: w -> m ()
, forall w (m :: * -> *). WriterDict w m -> forall a. m a -> m (a, w)
listen_ :: forall a. m a -> m (a, w)
, forall w (m :: * -> *).
WriterDict w m -> forall a. m (a, w -> w) -> m a
pass_ :: forall a. m (a, w -> w) -> m a
}
newtype Action m s' a = Action { forall {k} {k} (m :: k -> *) (s' :: k) (a :: k).
Action m s' a -> m a
action :: m a }
deriving ((forall a b. (a -> b) -> Action m s' a -> Action m s' b)
-> (forall a b. a -> Action m s' b -> Action m s' a)
-> Functor (Action m s')
forall a b. a -> Action m s' b -> Action m s' a
forall a b. (a -> b) -> Action m s' a -> Action m s' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
a -> Action m s' b -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
(a -> b) -> Action m s' a -> Action m s' b
$cfmap :: forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
(a -> b) -> Action m s' a -> Action m s' b
fmap :: forall a b. (a -> b) -> Action m s' a -> Action m s' b
$c<$ :: forall (m :: * -> *) k (s' :: k) a b.
Functor m =>
a -> Action m s' b -> Action m s' a
<$ :: forall a b. a -> Action m s' b -> Action m s' a
Functor, Functor (Action m s')
Functor (Action m s')
-> (forall a. a -> Action m s' a)
-> (forall a b.
Action m s' (a -> b) -> Action m s' a -> Action m s' b)
-> (forall a b c.
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c)
-> (forall a b. Action m s' a -> Action m s' b -> Action m s' b)
-> (forall a b. Action m s' a -> Action m s' b -> Action m s' a)
-> Applicative (Action m s')
forall a. a -> Action m s' a
forall a b. Action m s' a -> Action m s' b -> Action m s' a
forall a b. Action m s' a -> Action m s' b -> Action m s' b
forall a b. Action m s' (a -> b) -> Action m s' a -> Action m s' b
forall a b c.
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *} {k} {s' :: k}.
Applicative m =>
Functor (Action m s')
forall (m :: * -> *) k (s' :: k) a.
Applicative m =>
a -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' b
forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' (a -> b) -> Action m s' a -> Action m s' b
forall (m :: * -> *) k (s' :: k) a b c.
Applicative m =>
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
$cpure :: forall (m :: * -> *) k (s' :: k) a.
Applicative m =>
a -> Action m s' a
pure :: forall a. a -> Action m s' a
$c<*> :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' (a -> b) -> Action m s' a -> Action m s' b
<*> :: forall a b. Action m s' (a -> b) -> Action m s' a -> Action m s' b
$cliftA2 :: forall (m :: * -> *) k (s' :: k) a b c.
Applicative m =>
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
liftA2 :: forall a b c.
(a -> b -> c) -> Action m s' a -> Action m s' b -> Action m s' c
$c*> :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' b
*> :: forall a b. Action m s' a -> Action m s' b -> Action m s' b
$c<* :: forall (m :: * -> *) k (s' :: k) a b.
Applicative m =>
Action m s' a -> Action m s' b -> Action m s' a
<* :: forall a b. Action m s' a -> Action m s' b -> Action m s' a
Applicative, Applicative (Action m s')
Applicative (Action m s')
-> (forall a b.
Action m s' a -> (a -> Action m s' b) -> Action m s' b)
-> (forall a b. Action m s' a -> Action m s' b -> Action m s' b)
-> (forall a. a -> Action m s' a)
-> Monad (Action m s')
forall a. a -> Action m s' a
forall a b. Action m s' a -> Action m s' b -> Action m s' b
forall a b. Action m s' a -> (a -> Action m s' b) -> Action m s' b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall {m :: * -> *} {k} {s' :: k}.
Monad m =>
Applicative (Action m s')
forall (m :: * -> *) k (s' :: k) a. Monad m => a -> Action m s' a
forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> Action m s' b -> Action m s' b
forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> (a -> Action m s' b) -> Action m s' b
$c>>= :: forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> (a -> Action m s' b) -> Action m s' b
>>= :: forall a b. Action m s' a -> (a -> Action m s' b) -> Action m s' b
$c>> :: forall (m :: * -> *) k (s' :: k) a b.
Monad m =>
Action m s' a -> Action m s' b -> Action m s' b
>> :: forall a b. Action m s' a -> Action m s' b -> Action m s' b
$creturn :: forall (m :: * -> *) k (s' :: k) a. Monad m => a -> Action m s' a
return :: forall a. a -> Action m s' a
Monad)
instance ( Monad m
, Monoid w
, Reifies s' (WriterDict w m)
) => S.MonadWriter w (Action m s') where
tell :: w -> Action m s' ()
tell w
w = m () -> Action m s' ()
forall {k} {k} (m :: k -> *) (s' :: k) (a :: k).
m a -> Action m s' a
Action (m () -> Action m s' ()) -> m () -> Action m s' ()
forall a b. (a -> b) -> a -> b
$ WriterDict w m -> w -> m ()
forall w (m :: * -> *). WriterDict w m -> w -> m ()
tell_ (Proxy s' -> WriterDict w m
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s' -> WriterDict w m
reflect (Proxy s' -> WriterDict w m) -> Proxy s' -> WriterDict w m
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @s') w
w
{-# INLINEABLE tell #-}
listen :: forall a. Action m s' a -> Action m s' (a, w)
listen Action m s' a
x = m (a, w) -> Action m s' (a, w)
forall {k} {k} (m :: k -> *) (s' :: k) (a :: k).
m a -> Action m s' a
Action (m (a, w) -> Action m s' (a, w)) -> m (a, w) -> Action m s' (a, w)
forall a b. (a -> b) -> a -> b
$ WriterDict w m -> forall a. m a -> m (a, w)
forall w (m :: * -> *). WriterDict w m -> forall a. m a -> m (a, w)
listen_ (Proxy s' -> WriterDict w m
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s' -> WriterDict w m
reflect (Proxy s' -> WriterDict w m) -> Proxy s' -> WriterDict w m
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @s') (Action m s' a -> m a
forall {k} {k} (m :: k -> *) (s' :: k) (a :: k).
Action m s' a -> m a
action Action m s' a
x)
{-# INLINEABLE listen #-}
pass :: forall a. Action m s' (a, w -> w) -> Action m s' a
pass Action m s' (a, w -> w)
x = m a -> Action m s' a
forall {k} {k} (m :: k -> *) (s' :: k) (a :: k).
m a -> Action m s' a
Action (m a -> Action m s' a) -> m a -> Action m s' a
forall a b. (a -> b) -> a -> b
$ WriterDict w m -> forall a. m (a, w -> w) -> m a
forall w (m :: * -> *).
WriterDict w m -> forall a. m (a, w -> w) -> m a
pass_ (Proxy s' -> WriterDict w m
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s' -> WriterDict w m
reflect (Proxy s' -> WriterDict w m) -> Proxy s' -> WriterDict w m
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @s') (Action m s' (a, w -> w) -> m (a, w -> w)
forall {k} {k} (m :: k -> *) (s' :: k) (a :: k).
Action m s' a -> m a
action Action m s' (a, w -> w)
x)
{-# INLINEABLE pass #-}