{-# LANGUAGE AllowAmbiguousTypes #-}
module Control.Effect.Interpreter.Heftia.Writer where
import Control.Arrow ((>>>))
import Control.Effect (type (~>))
import Control.Effect.Hefty (
Eff,
Elab,
injectF,
interposeFin,
interposeT,
interpretFin,
interpretK,
interpretRecH,
interpretT,
rewrite,
)
import Control.Freer (Freer)
import Control.Monad.Freer (MonadFreer)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Writer.CPS qualified as CPS
import Control.Monad.Trans.Writer.Strict qualified as Strict
import Data.Effect.HFunctor (HFunctor)
import Data.Effect.Writer (LTell, Tell (Tell), WriterH (Censor, Listen), tell)
import Data.Function ((&))
import Data.Hefty.Union (Member, Union)
import Data.Tuple (swap)
runWriterPost ::
forall w a r fr u c.
( Monoid w
, Freer c fr
, Union u
, HFunctor (u '[])
, Monad (Eff u fr '[] r)
, c (CPS.WriterT w (Eff u fr '[] r))
, Member u (Tell w) (LTell w ': r)
, Monad (Eff u fr '[] (LTell w ': r))
, c (CPS.WriterT w (Eff u fr '[] (LTell w ': r)))
, HFunctor (u '[WriterH w])
) =>
Eff u fr '[WriterH w] (LTell w ': r) a ->
Eff u fr '[] r (w, a)
runWriterPost :: forall w a (r :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, HFunctor (u '[]),
Monad (Eff u fr '[] r), c (WriterT w (Eff u fr '[] r)),
Member u (Tell w) (LTell w : r),
Monad (Eff u fr '[] (LTell w : r)),
c (WriterT w (Eff u fr '[] (LTell w : r))),
HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] (LTell w : r) a -> Eff u fr '[] r (w, a)
runWriterPost = forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef)), HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPost forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]) a.
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) a -> Eff u fr '[] r (w, a)
runTell
{-# INLINE runWriterPost #-}
elaborateWriterPost ::
forall w ef fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) ef
, HFunctor (u '[])
, Monad (Eff u fr '[] ef)
, c (CPS.WriterT w (Eff u fr '[] ef))
, HFunctor (u '[WriterH w])
) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPost :: forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef)), HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPost = forall (e :: SigClass) (rs :: [SigClass]) (efs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, HFunctor e, HFunctor (u rs),
HFunctor (u (e : rs))) =>
(e (Eff u fr rs efs) ~> Eff u fr rs efs)
-> Eff u fr (e : rs) efs ~> Eff u fr rs efs
interpretRecH forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef))) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPost
{-# INLINE elaborateWriterPost #-}
elabWriterPost ::
forall w ef fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) ef
, HFunctor (u '[])
, Monad (Eff u fr '[] ef)
, c (CPS.WriterT w (Eff u fr '[] ef))
) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPost :: forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef))) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPost = \case
Listen Eff u fr '[] ef a1
m -> forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> Eff u fr '[] es (w, a)
listenT Eff u fr '[] ef a1
m
Censor w -> w
f Eff u fr '[] ef x
m -> forall w (es :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Member u (Tell w) es, Union u,
HFunctor (u '[]), Monad (Eff u fr '[] es),
c (WriterT w (Eff u fr '[] es))) =>
(w -> w) -> Eff u fr '[] es ~> Eff u fr '[] es
postCensor w -> w
f Eff u fr '[] ef x
m
postCensor ::
forall w es fr u c.
( Monoid w
, Freer c fr
, Member u (Tell w) es
, Union u
, HFunctor (u '[])
, Monad (Eff u fr '[] es)
, c (CPS.WriterT w (Eff u fr '[] es))
) =>
(w -> w) ->
Eff u fr '[] es ~> Eff u fr '[] es
postCensor :: forall w (es :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Member u (Tell w) es, Union u,
HFunctor (u '[]), Monad (Eff u fr '[] es),
c (WriterT w (Eff u fr '[] es))) =>
(w -> w) -> Eff u fr '[] es ~> Eff u fr '[] es
postCensor w -> w
f Eff u fr '[] es x
m = do
(x
a, w
w) <- forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT forall a b. (a -> b) -> a -> b
$ forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> WriterT w (Eff u fr '[] es) a
confiscateT Eff u fr '[] es x
m
forall w (f :: * -> *). SendIns (Tell w) f => w -> f ()
tell forall a b. (a -> b) -> a -> b
$ w -> w
f w
w
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
a
runWriterPre ::
forall w a r fr u c.
( Monoid w
, Freer c fr
, Union u
, HFunctor (u '[])
, Monad (Eff u fr '[] r)
, c (CPS.WriterT w (Eff u fr '[] r))
, Member u (Tell w) (LTell w ': r)
, Monad (Eff u fr '[] (LTell w ': r))
, c (CPS.WriterT w (Eff u fr '[] (LTell w ': r)))
, HFunctor (u '[WriterH w])
) =>
Eff u fr '[WriterH w] (LTell w ': r) a ->
Eff u fr '[] r (w, a)
runWriterPre :: forall w a (r :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, HFunctor (u '[]),
Monad (Eff u fr '[] r), c (WriterT w (Eff u fr '[] r)),
Member u (Tell w) (LTell w : r),
Monad (Eff u fr '[] (LTell w : r)),
c (WriterT w (Eff u fr '[] (LTell w : r))),
HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] (LTell w : r) a -> Eff u fr '[] r (w, a)
runWriterPre = forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef)), HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPre forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]) a.
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) a -> Eff u fr '[] r (w, a)
runTell
{-# INLINE runWriterPre #-}
elaborateWriterPre ::
forall w ef fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) ef
, HFunctor (u '[])
, Monad (Eff u fr '[] ef)
, c (CPS.WriterT w (Eff u fr '[] ef))
, HFunctor (u '[WriterH w])
) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPre :: forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef)), HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPre = forall (e :: SigClass) (rs :: [SigClass]) (efs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, HFunctor e, HFunctor (u rs),
HFunctor (u (e : rs))) =>
(e (Eff u fr rs efs) ~> Eff u fr rs efs)
-> Eff u fr (e : rs) efs ~> Eff u fr rs efs
interpretRecH forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef))) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPre
{-# INLINE elaborateWriterPre #-}
elabWriterPre ::
forall w ef fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) ef
, HFunctor (u '[])
, Monad (Eff u fr '[] ef)
, c (CPS.WriterT w (Eff u fr '[] ef))
) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPre :: forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Monad (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef))) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPre = \case
Listen Eff u fr '[] ef a1
m -> forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> Eff u fr '[] es (w, a)
listenT Eff u fr '[] ef a1
m
Censor w -> w
f Eff u fr '[] ef x
m -> forall w (es :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Freer c fr, Member u (Tell w) es, Union u, HFunctor (u '[])) =>
(w -> w) -> Eff u fr '[] es ~> Eff u fr '[] es
preCensor w -> w
f Eff u fr '[] ef x
m
runWriterPreA ::
forall w a r fr u c.
( Monoid w
, Freer c fr
, Union u
, HFunctor (u '[])
, Monad (Eff u fr '[] r)
, c (Strict.WriterT w (Eff u fr '[] r))
, Member u (Tell w) (LTell w ': r)
, Monad (Eff u fr '[] (LTell w ': r))
, c (Strict.WriterT w (Eff u fr '[] (LTell w ': r)))
, HFunctor (u '[WriterH w])
) =>
Eff u fr '[WriterH w] (LTell w ': r) a ->
Eff u fr '[] r (w, a)
runWriterPreA :: forall w a (r :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, HFunctor (u '[]),
Monad (Eff u fr '[] r), c (WriterT w (Eff u fr '[] r)),
Member u (Tell w) (LTell w : r),
Monad (Eff u fr '[] (LTell w : r)),
c (WriterT w (Eff u fr '[] (LTell w : r))),
HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] (LTell w : r) a -> Eff u fr '[] r (w, a)
runWriterPreA = forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Applicative (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef)), HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPreA forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]) a.
(Monoid w, Freer c fr, Union u, Applicative (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) a -> Eff u fr '[] r (w, a)
runTellA
{-# INLINE runWriterPreA #-}
elaborateWriterPreA ::
forall w ef fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) ef
, HFunctor (u '[])
, Applicative (Eff u fr '[] ef)
, c (Strict.WriterT w (Eff u fr '[] ef))
, HFunctor (u '[WriterH w])
) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPreA :: forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Applicative (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef)), HFunctor (u '[WriterH w])) =>
Eff u fr '[WriterH w] ef ~> Eff u fr '[] ef
elaborateWriterPreA = forall (e :: SigClass) (rs :: [SigClass]) (efs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, HFunctor e, HFunctor (u rs),
HFunctor (u (e : rs))) =>
(e (Eff u fr rs efs) ~> Eff u fr rs efs)
-> Eff u fr (e : rs) efs ~> Eff u fr rs efs
interpretRecH forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Applicative (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef))) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPre'
{-# INLINE elaborateWriterPreA #-}
elabWriterPre' ::
forall w ef fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) ef
, HFunctor (u '[])
, Applicative (Eff u fr '[] ef)
, c (Strict.WriterT w (Eff u fr '[] ef))
) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPre' :: forall w (ef :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) ef,
HFunctor (u '[]), Applicative (Eff u fr '[] ef),
c (WriterT w (Eff u fr '[] ef))) =>
Elab (WriterH w) (Eff u fr '[] ef)
elabWriterPre' = \case
Listen Eff u fr '[] ef a1
m -> forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Applicative (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> Eff u fr '[] es (w, a)
listenTA Eff u fr '[] ef a1
m
Censor w -> w
f Eff u fr '[] ef x
m -> forall w (es :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Freer c fr, Member u (Tell w) es, Union u, HFunctor (u '[])) =>
(w -> w) -> Eff u fr '[] es ~> Eff u fr '[] es
preCensor w -> w
f Eff u fr '[] ef x
m
preCensor ::
forall w es fr u c.
(Freer c fr, Member u (Tell w) es, Union u, HFunctor (u '[])) =>
(w -> w) ->
Eff u fr '[] es ~> Eff u fr '[] es
preCensor :: forall w (es :: [SigClass]) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Freer c fr, Member u (Tell w) es, Union u, HFunctor (u '[])) =>
(w -> w) -> Eff u fr '[] es ~> Eff u fr '[] es
preCensor w -> w
f = forall (e :: * -> *) (efs :: [SigClass]) (ehs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, HFunctor (u ehs), Member u e efs) =>
(e ~> e) -> Eff u fr ehs efs ~> Eff u fr ehs efs
rewrite @(Tell w) \(Tell w
w) -> forall w. w -> Tell w ()
Tell forall a b. (a -> b) -> a -> b
$ w -> w
f w
w
listenT ::
forall w es a fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) es
, Monad (Eff u fr '[] es)
, c (CPS.WriterT w (Eff u fr '[] es))
) =>
Eff u fr '[] es a ->
Eff u fr '[] es (w, a)
listenT :: forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> Eff u fr '[] es (w, a)
listenT Eff u fr '[] es a
m =
forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT do
Eff u fr '[] es a
m forall a b. a -> (a -> b) -> b
& forall (e :: * -> *) (t :: SigClass) (efs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, MonadTrans t, Member u e efs,
Monad (Eff u fr '[] efs), c (t (Eff u fr '[] efs))) =>
(e ~> t (Eff u fr '[] efs))
-> Eff u fr '[] efs ~> t (Eff u fr '[] efs)
interposeT @(Tell w) \(Tell w
w) -> do
forall (t :: SigClass) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall w (f :: * -> *). SendIns (Tell w) f => w -> f ()
tell w
w
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
CPS.tell w
w
listenTA ::
forall w es a fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) es
, Applicative (Eff u fr '[] es)
, c (Strict.WriterT w (Eff u fr '[] es))
) =>
Eff u fr '[] es a ->
Eff u fr '[] es (w, a)
listenTA :: forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Applicative (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> Eff u fr '[] es (w, a)
listenTA Eff u fr '[] es a
m =
forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT do
Eff u fr '[] es a
m forall a b. a -> (a -> b) -> b
& forall (e :: * -> *) (f :: * -> *) (efs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, Member u e efs, c f) =>
(u efs Nop ~> f) -> (e ~> f) -> Eff u fr '[] efs ~> f
interposeFin @(Tell w) (forall w (f :: * -> *). (Monoid w, Functor f) => f ~> WriterT w f
liftStrictWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: (* -> *) -> Constraint) (f :: SigClass)
(u :: [SigClass] -> SigClass) (efs :: [SigClass])
(ehs :: [SigClass]).
Freer c f =>
u efs Nop ~> Eff u f ehs efs
injectF) \(Tell w
w) -> do
forall w (f :: * -> *). (Monoid w, Functor f) => f ~> WriterT w f
liftStrictWriterT (forall w (f :: * -> *). SendIns (Tell w) f => w -> f ()
tell w
w) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall w (f :: * -> *). Applicative f => w -> WriterT w f ()
tellStrictWriterT w
w
runTell ::
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r), c (CPS.WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w ': r) a ->
Eff u fr '[] r (w, a)
runTell :: forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]) a.
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) a -> Eff u fr '[] r (w, a)
runTell = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]).
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) ~> WriterT w (Eff u fr '[] r)
runTellT
{-# INLINE runTell #-}
runTellT ::
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r), c (CPS.WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w ': r) ~> CPS.WriterT w (Eff u fr '[] r)
runTellT :: forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]).
(Monoid w, Freer c fr, Union u, Monad (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) ~> WriterT w (Eff u fr '[] r)
runTellT = forall (e :: SigClass) (r :: [SigClass]) (t :: SigClass)
(ehs :: [SigClass]) (fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, MonadTrans t, HeadIns e,
Monad (Eff u fr ehs r), c (t (Eff u fr ehs r))) =>
(UnliftIfSingle e ~> t (Eff u fr ehs r))
-> Eff u fr '[] (e : r) ~> t (Eff u fr ehs r)
interpretT \(Tell w
w) -> forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
CPS.tell w
w
{-# INLINE runTellT #-}
runTellA ::
(Monoid w, Freer c fr, Union u, Applicative (Eff u fr '[] r), c (Strict.WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w ': r) a ->
Eff u fr '[] r (w, a)
runTellA :: forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]) a.
(Monoid w, Freer c fr, Union u, Applicative (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) a -> Eff u fr '[] r (w, a)
runTellA = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]).
(Monoid w, Freer c fr, Union u, Applicative (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) ~> WriterT w (Eff u fr '[] r)
runTellTA
{-# INLINE runTellA #-}
runTellTA ::
(Monoid w, Freer c fr, Union u, Applicative (Eff u fr '[] r), c (Strict.WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w ': r) ~> Strict.WriterT w (Eff u fr '[] r)
runTellTA :: forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]).
(Monoid w, Freer c fr, Union u, Applicative (Eff u fr '[] r),
c (WriterT w (Eff u fr '[] r))) =>
Eff u fr '[] (LTell w : r) ~> WriterT w (Eff u fr '[] r)
runTellTA = forall (e :: SigClass) (r :: [SigClass]) (f :: * -> *)
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, HeadIns e, c f) =>
(u r Nop ~> f)
-> (UnliftIfSingle e ~> f) -> Eff u fr '[] (e : r) ~> f
interpretFin (forall w (f :: * -> *). (Monoid w, Functor f) => f ~> WriterT w f
liftStrictWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: (* -> *) -> Constraint) (f :: SigClass)
(u :: [SigClass] -> SigClass) (efs :: [SigClass])
(ehs :: [SigClass]).
Freer c f =>
u efs Nop ~> Eff u f ehs efs
injectF) \(Tell w
w) -> forall w (f :: * -> *). Applicative f => w -> WriterT w f ()
tellStrictWriterT w
w
{-# INLINE runTellTA #-}
runTellK ::
(Monoid w, MonadFreer c fr, Union u, c (Eff u fr '[] r)) =>
Eff u fr '[] (LTell w ': r) a ->
Eff u fr '[] r (w, a)
runTellK :: forall w (c :: (* -> *) -> Constraint) (fr :: SigClass)
(u :: [SigClass] -> SigClass) (r :: [SigClass]) a.
(Monoid w, MonadFreer c fr, Union u, c (Eff u fr '[] r)) =>
Eff u fr '[] (LTell w : r) a -> Eff u fr '[] r (w, a)
runTellK =
forall (e :: SigClass) (rs :: [SigClass]) r a (ehs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(MonadFreer c fr, Union u, HeadIns e, c (Eff u fr ehs rs)) =>
(a -> Eff u fr ehs rs r)
-> (forall x.
(x -> Eff u fr ehs rs r)
-> UnliftIfSingle e x -> Eff u fr ehs rs r)
-> Eff u fr '[] (e : rs) a
-> Eff u fr ehs rs r
interpretK (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => a
mempty,)) \x -> Eff u fr '[] r (w, a)
k (Tell w
w) -> do
(w
w', a
r) <- x -> Eff u fr '[] r (w, a)
k ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w
w forall a. Semigroup a => a -> a -> a
<> w
w', a
r)
liftStrictWriterT :: forall w f. (Monoid w, Functor f) => f ~> Strict.WriterT w f
liftStrictWriterT :: forall w (f :: * -> *). (Monoid w, Functor f) => f ~> WriterT w f
liftStrictWriterT = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,forall a. Monoid a => a
mempty) <$>)
{-# INLINE liftStrictWriterT #-}
tellStrictWriterT :: forall w f. Applicative f => w -> Strict.WriterT w f ()
tellStrictWriterT :: forall w (f :: * -> *). Applicative f => w -> WriterT w f ()
tellStrictWriterT = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((),)
{-# INLINE tellStrictWriterT #-}
transactWriter ::
forall w es a fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) es
, Monad (Eff u fr '[] es)
, c (CPS.WriterT w (Eff u fr '[] es))
) =>
Eff u fr '[] es a ->
Eff u fr '[] es a
transactWriter :: forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> Eff u fr '[] es a
transactWriter Eff u fr '[] es a
m = do
(a
a, w
w) <- forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT forall a b. (a -> b) -> a -> b
$ forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> WriterT w (Eff u fr '[] es) a
confiscateT Eff u fr '[] es a
m
forall w (f :: * -> *). SendIns (Tell w) f => w -> f ()
tell @w w
w
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
confiscateT ::
forall w es a fr u c.
( Monoid w
, Freer c fr
, Union u
, Member u (Tell w) es
, Monad (Eff u fr '[] es)
, c (CPS.WriterT w (Eff u fr '[] es))
) =>
Eff u fr '[] es a ->
CPS.WriterT w (Eff u fr '[] es) a
confiscateT :: forall w (es :: [SigClass]) a (fr :: SigClass)
(u :: [SigClass] -> SigClass) (c :: (* -> *) -> Constraint).
(Monoid w, Freer c fr, Union u, Member u (Tell w) es,
Monad (Eff u fr '[] es), c (WriterT w (Eff u fr '[] es))) =>
Eff u fr '[] es a -> WriterT w (Eff u fr '[] es) a
confiscateT Eff u fr '[] es a
m =
Eff u fr '[] es a
m forall a b. a -> (a -> b) -> b
& forall (e :: * -> *) (t :: SigClass) (efs :: [SigClass])
(fr :: SigClass) (u :: [SigClass] -> SigClass)
(c :: (* -> *) -> Constraint).
(Freer c fr, Union u, MonadTrans t, Member u e efs,
Monad (Eff u fr '[] efs), c (t (Eff u fr '[] efs))) =>
(e ~> t (Eff u fr '[] efs))
-> Eff u fr '[] efs ~> t (Eff u fr '[] efs)
interposeT @(Tell w) \(Tell w
w) -> forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
CPS.tell w
w