{-# LANGUAGE TemplateHaskell #-}
module Calamity.Internal.LocalWriter
( LocalWriter(..)
, ltell
, llisten
, runLocalWriter ) where
import qualified Polysemy as P
import qualified Polysemy.State as P
data LocalWriter o m a where
Ltell :: o -> LocalWriter o m ()
Llisten :: m a -> LocalWriter o m (o, a)
P.makeSem ''LocalWriter
runLocalWriter :: Monoid o => P.Sem (LocalWriter o ': r) a -> P.Sem r (o, a)
runLocalWriter :: forall o (r :: EffectRow) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter = forall s (r :: EffectRow) a.
s -> Sem (State s : r) a -> Sem r (s, a)
P.runState forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e1 :: Effect) (e2 :: Effect) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpretH
(\case
Ltell o
o -> do
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' (forall a. Semigroup a => a -> a -> a
<> o
o) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
(r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
P.pureT
Llisten Sem rInitial a
m -> do
Sem (LocalWriter o : State o : r) (f a)
mm <- forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
(r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
P.runT Sem rInitial a
m
(o
o, f a
fa) <- forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise forall a b. (a -> b) -> a -> b
$ forall o (r :: EffectRow) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter Sem (LocalWriter o : State o : r) (f a)
mm
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (o
o, ) f a
fa)