-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2023 Sayo contributors
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Interpreters for the [Writer]("Data.Effect.Writer") effects.
-}
module Control.Monad.Hefty.Writer (
    module Control.Monad.Hefty.Writer,
    module Data.Effect.Writer,
)
where

import Control.Monad.Hefty (
    Eff,
    FOEs,
    In,
    StateHandler,
    interposeStateInBy,
    interpret,
    interpretStateBy,
    send,
 )
import Data.Effect.Writer

-- | Interpret the [Writer]("Data.Effect.Writer") effects with post-applying censor semantics.
runWriterPost :: (Monoid w, FOEs es) => Eff (WriterH w ': Tell w ': es) a -> Eff es (w, a)
runWriterPost :: forall w (es :: [Effect]) a.
(Monoid w, FOEs es) =>
Eff (WriterH w : Tell w : es) a -> Eff es (w, a)
runWriterPost = Eff (Tell w : es) a -> Eff es (w, a)
forall w (es :: [Effect]) a.
(Monoid w, FOEs es) =>
Eff (Tell w : es) a -> Eff es (w, a)
runTell (Eff (Tell w : es) a -> Eff es (w, a))
-> (Eff (WriterH w : Tell w : es) a -> Eff (Tell w : es) a)
-> Eff (WriterH w : Tell w : es) a
-> Eff es (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (WriterH w : Tell w : es) a -> Eff (Tell w : es) a
forall w (es :: [Effect]) a.
(Monoid w, In (Tell w) es, FOEs es) =>
Eff (WriterH w : es) a -> Eff es a
runWriterHPost

-- | Interpret the [Writer]("Data.Effect.Writer") effects with pre-applying censor semantics.
runWriterPre :: (Monoid w, FOEs es) => Eff (WriterH w ': Tell w ': es) a -> Eff es (w, a)
runWriterPre :: forall w (es :: [Effect]) a.
(Monoid w, FOEs es) =>
Eff (WriterH w : Tell w : es) a -> Eff es (w, a)
runWriterPre = Eff (Tell w : es) a -> Eff es (w, a)
forall w (es :: [Effect]) a.
(Monoid w, FOEs es) =>
Eff (Tell w : es) a -> Eff es (w, a)
runTell (Eff (Tell w : es) a -> Eff es (w, a))
-> (Eff (WriterH w : Tell w : es) a -> Eff (Tell w : es) a)
-> Eff (WriterH w : Tell w : es) a
-> Eff es (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (WriterH w : Tell w : es) a -> Eff (Tell w : es) a
forall w (es :: [Effect]) a.
(Monoid w, In (Tell w) es, FOEs es) =>
Eff (WriterH w : es) a -> Eff es a
runWriterHPre

-- | Interpret the t'Tell' effect.
runTell :: (Monoid w, FOEs es) => Eff (Tell w ': es) a -> Eff es (w, a)
runTell :: forall w (es :: [Effect]) a.
(Monoid w, FOEs es) =>
Eff (Tell w : es) a -> Eff es (w, a)
runTell = w
-> (w -> a -> Eff es (w, a))
-> StateHandler
     w (Tell w) (Eff (Tell w : es)) (Eff Freer es) (w, a)
-> Eff (Tell w : es) a
-> Eff es (w, a)
forall s (e :: Effect) (es :: [Effect]) ans a.
(KnownOrder e, FOEs es) =>
s
-> (s -> a -> Eff es ans)
-> StateHandler s e (Eff (e : es)) (Eff es) ans
-> Eff (e : es) a
-> Eff es ans
interpretStateBy w
forall a. Monoid a => a
mempty (((w, a) -> Eff es (w, a)) -> w -> a -> Eff es (w, a)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (w, a) -> Eff es (w, a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Tell w (Eff (Tell w : es)) x
-> w -> (w -> x -> Eff es (w, a)) -> Eff es (w, a)
StateHandler w (Tell w) (Eff (Tell w : es)) (Eff Freer es) (w, a)
forall w (f :: * -> *) (g :: * -> *) a.
Monoid w =>
StateHandler w (Tell w) f g (w, a)
handleTell

-- | A handler function for the t'Tell' effect.
handleTell :: (Monoid w) => StateHandler w (Tell w) f g (w, a)
handleTell :: forall w (f :: * -> *) (g :: * -> *) a.
Monoid w =>
StateHandler w (Tell w) f g (w, a)
handleTell (Tell w
w') w
w w -> x -> g (w, a)
k = w -> x -> g (w, a)
k (w
w w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w') ()
{-# INLINE handleTell #-}

-- | Interpret the 'WriterH' effect with post-applying censor semantics.
runWriterHPost :: (Monoid w, Tell w `In` es, FOEs es) => Eff (WriterH w ': es) a -> Eff es a
runWriterHPost :: forall w (es :: [Effect]) a.
(Monoid w, In (Tell w) es, FOEs es) =>
Eff (WriterH w : es) a -> Eff es a
runWriterHPost = (WriterH w ~~> Eff Freer es)
-> Eff Freer (WriterH w : es) a -> Eff Freer es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \case
    Listen Eff Freer es a1
m -> Eff Freer es a1 -> Eff es (w, a1)
forall w (es :: [Effect]) a.
(In (Tell w) es, Monoid w, FOEs es) =>
Eff es a -> Eff es (w, a)
intercept Eff Freer es a1
m
    Censor w -> w
f Eff Freer es x
m -> (w -> w) -> Eff Freer es x -> Eff Freer es x
forall w a (es :: [Effect]).
(In (Tell w) es, Monoid w, FOEs es) =>
(w -> w) -> Eff es a -> Eff es a
censorPost w -> w
f Eff Freer es x
m

-- | Interpret the 'WriterH' effect with pre-applying censor semantics.
runWriterHPre :: (Monoid w, Tell w `In` es, FOEs es) => Eff (WriterH w ': es) a -> Eff es a
runWriterHPre :: forall w (es :: [Effect]) a.
(Monoid w, In (Tell w) es, FOEs es) =>
Eff (WriterH w : es) a -> Eff es a
runWriterHPre = (WriterH w ~~> Eff Freer es)
-> Eff Freer (WriterH w : es) a -> Eff Freer es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \case
    Listen Eff Freer es a1
m -> Eff Freer es a1 -> Eff es (w, a1)
forall w (es :: [Effect]) a.
(In (Tell w) es, Monoid w, FOEs es) =>
Eff es a -> Eff es (w, a)
intercept Eff Freer es a1
m
    Censor w -> w
f Eff Freer es x
m -> (w -> w) -> Eff Freer es x -> Eff Freer es x
forall w (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(In (Tell w) es, Free c ff) =>
(w -> w) -> Eff ff es a -> Eff ff es a
censorPre w -> w
f Eff Freer es x
m

{- | Retrieves the monoidal value accumulated by v'tell' within the given action.
The v'tell' effect is not consumed and remains intact.
-}
intercept
    :: forall w es a
     . (Tell w `In` es, Monoid w, FOEs es)
    => Eff es a
    -> Eff es (w, a)
intercept :: forall w (es :: [Effect]) a.
(In (Tell w) es, Monoid w, FOEs es) =>
Eff es a -> Eff es (w, a)
intercept =
    forall s (e :: Effect) (es :: [Effect]) ans a.
(In e es, FOEs es) =>
s
-> (s -> a -> Eff es ans)
-> StateHandler s e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeStateInBy @_ @(Tell w)
        w
forall a. Monoid a => a
mempty
        (((w, a) -> Eff es (w, a)) -> w -> a -> Eff es (w, a)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (w, a) -> Eff es (w, a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        \e :: Tell w (Eff Freer es) x
e@(Tell w
_) w
w w -> x -> Eff es (w, a)
k -> do
            () <- Tell w (Eff Freer es) x -> Eff Freer es x
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(In e es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
send Tell w (Eff Freer es) x
e
            Tell w (Eff Freer es) x
-> w -> (w -> x -> Eff es (w, a)) -> Eff es (w, a)
StateHandler w (Tell w) (Eff Freer es) (Eff Freer es) (w, a)
forall w (f :: * -> *) (g :: * -> *) a.
Monoid w =>
StateHandler w (Tell w) f g (w, a)
handleTell Tell w (Eff Freer es) x
e w
w w -> x -> Eff es (w, a)
k

{- | Consumes all the v'tell' effects from the specified @Tell w@ slot within the
given action and returns the accumulated monoidal value along with the result.
-}
confiscate
    :: forall w es a
     . (Tell w `In` es, Monoid w, FOEs es)
    => Eff es a
    -> Eff es (w, a)
confiscate :: forall w (es :: [Effect]) a.
(In (Tell w) es, Monoid w, FOEs es) =>
Eff es a -> Eff es (w, a)
confiscate = w
-> (w -> a -> Eff es (w, a))
-> StateHandler w (Tell w) (Eff Freer es) (Eff Freer es) (w, a)
-> Eff es a
-> Eff es (w, a)
forall s (e :: Effect) (es :: [Effect]) ans a.
(In e es, FOEs es) =>
s
-> (s -> a -> Eff es ans)
-> StateHandler s e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeStateInBy w
forall a. Monoid a => a
mempty (((w, a) -> Eff es (w, a)) -> w -> a -> Eff es (w, a)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (w, a) -> Eff es (w, a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Tell w (Eff Freer es) x
-> w -> (w -> x -> Eff es (w, a)) -> Eff es (w, a)
StateHandler w (Tell w) (Eff Freer es) (Eff Freer es) (w, a)
forall w (f :: * -> *) (g :: * -> *) a.
Monoid w =>
StateHandler w (Tell w) f g (w, a)
handleTell

-- | 'censor' with post-applying semantics.
censorPost
    :: forall w a es
     . (Tell w `In` es, Monoid w, FOEs es)
    => (w -> w)
    -> Eff es a
    -> Eff es a
censorPost :: forall w a (es :: [Effect]).
(In (Tell w) es, Monoid w, FOEs es) =>
(w -> w) -> Eff es a -> Eff es a
censorPost w -> w
f Eff es a
m = do
    (w
w, a
a) <- Eff es a -> Eff es (w, a)
forall w (es :: [Effect]) a.
(In (Tell w) es, Monoid w, FOEs es) =>
Eff es a -> Eff es (w, a)
confiscate Eff es a
m
    w -> Eff Freer es ()
forall w (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, In (Tell w) es) =>
w -> a ()
tell'_ (w -> Eff Freer es ()) -> w -> Eff Freer es ()
forall a b. (a -> b) -> a -> b
$ w -> w
f w
w
    a -> Eff es a
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a