{-# LANGUAGE TemplateHaskell #-}

-- | A Writer monad that supports local writing, reverse reader I guess?
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)