-- SPDX-License-Identifier: MPL-2.0

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

Interpreters for the t'Output' effect.
-}
module Control.Monad.Hefty.Output (
    module Control.Monad.Hefty.Output,
    module Data.Effect.Output,
)
where

import Control.Arrow ((>>>))
import Control.Monad.Hefty (Eff, FOEs, interpret, interpretStateBy, raiseUnder)
import Control.Monad.Hefty.State (runState)
import Control.Monad.Hefty.Writer (handleTell)
import Data.Effect.Output
import Data.Effect.State (modify)
import Data.Effect.Writer (Tell (Tell))

-- | Interprets the t'Output' effect by accumulating the outputs into a list.
runOutputList
    :: forall o a es
     . (FOEs es)
    => Eff (Output o ': es) a
    -> Eff es ([o], a)
runOutputList :: forall o a (es :: [Effect]).
FOEs es =>
Eff (Output o : es) a -> Eff es ([o], a)
runOutputList =
    Eff (Output o : es) a -> Eff Freer (Output o : State [o] : es) a
forall (e0 :: Effect) (e1 :: Effect) (es :: [Effect]) a
       (ff :: Effect) (c :: (* -> *) -> Constraint).
Free c ff =>
Eff ff (e0 : es) a -> Eff ff (e0 : e1 : es) a
raiseUnder
        (Eff (Output o : es) a -> Eff Freer (Output o : State [o] : es) a)
-> (Eff Freer (Output o : State [o] : es) a -> Eff es ([o], a))
-> Eff (Output o : es) a
-> Eff es ([o], a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Output o ~~> Eff Freer (State [o] : es))
-> Eff Freer (Output o : State [o] : es) a
-> Eff Freer (State [o] : 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 (\(Output o
o) -> ([o] -> [o]) -> Eff Freer (State [o] : es) ()
forall s (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(State s :> es, Monad (Eff ff es), Free c ff) =>
(s -> s) -> Eff ff es ()
modify (o
o :))
        (Eff Freer (Output o : State [o] : es) a
 -> Eff Freer (State [o] : es) a)
-> (Eff Freer (State [o] : es) a -> Eff es ([o], a))
-> Eff Freer (Output o : State [o] : es) a
-> Eff es ([o], a)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [o] -> Eff Freer (State [o] : es) a -> Eff es ([o], a)
forall s (es :: [Effect]) a.
FOEs es =>
s -> Eff (State s : es) a -> Eff es (s, a)
runState []

-- | Interprets the t'Output' effect by accumulating the outputs into a monoid.
runOutputMonoid
    :: forall o w a es
     . (Monoid w, FOEs es)
    => (o -> w)
    -> Eff (Output o ': es) a
    -> Eff es (w, a)
runOutputMonoid :: forall o w a (es :: [Effect]).
(Monoid w, FOEs es) =>
(o -> w) -> Eff (Output o : es) a -> Eff es (w, a)
runOutputMonoid o -> w
f =
    w
-> (w -> a -> Eff es (w, a))
-> StateHandler
     w (Output o) (Eff (Output o : es)) (Eff Freer es) (w, a)
-> Eff (Output o : 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) \(Output o
o) ->
        Tell w Any x -> w -> (w -> x -> Eff es (w, a)) -> Eff es (w, a)
StateHandler w (Tell w) Any (Eff Freer es) (w, a)
forall w (f :: * -> *) (g :: * -> *) a.
Monoid w =>
StateHandler w (Tell w) f g (w, a)
handleTell (Tell w Any x -> w -> (w -> x -> Eff es (w, a)) -> Eff es (w, a))
-> Tell w Any x -> w -> (w -> x -> Eff es (w, a)) -> Eff es (w, a)
forall a b. (a -> b) -> a -> b
$ w -> Tell w Any ()
forall w (a :: * -> *). w -> Tell w a ()
Tell (w -> Tell w Any ()) -> w -> Tell w Any ()
forall a b. (a -> b) -> a -> b
$ o -> w
f o
o