-- | The dynamically dispatched variant of the 'Writer' effect.
--
-- /Note:/ unless you plan to change interpretations at runtime, it's
-- recommended to use one of the statically dispatched variants,
-- i.e. "Effectful.Writer.Static.Local" or "Effectful.Writer.Static.Shared".
module Effectful.Writer.Dynamic
  ( -- * Effect
    Writer(..)

    -- ** Handlers

    -- *** Local
  , runWriterLocal
  , execWriterLocal

    -- *** Shared
  , runWriterShared
  , execWriterShared

    -- * Operations
  , tell
  , listen
  , listens
  ) where

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Writer.Static.Local qualified as L
import Effectful.Writer.Static.Shared qualified as S

-- | Provide access to a write only value of type @w@.
data Writer w :: Effect where
  Tell   :: w   -> Writer w m ()
  Listen :: m a -> Writer w m (a, w)

type instance DispatchOf (Writer w) = Dynamic

----------------------------------------
-- Local

-- | Run the 'Writer' effect and return the final value along with the final
-- output (via "Effectful.Writer.Static.Local").
runWriterLocal :: (HasCallStack, Monoid w) => Eff (Writer w : es) a -> Eff es (a, w)
runWriterLocal :: forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es (a, w)
runWriterLocal = (Eff (Writer w : es) a -> Eff es (a, w))
-> EffectHandler (Writer w) (Writer w : es)
-> Eff (Writer w : es) a
-> Eff es (a, w)
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Writer w : es) a -> Eff es (a, w)
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es (a, w)
L.runWriter LocalEnv localEs (Writer w : es)
-> Writer w (Eff localEs) a -> Eff (Writer w : es) a
EffectHandler (Writer w) (Writer w : es)
forall w (es :: [(Type -> Type) -> Type -> Type]).
(Writer w :> es, Monoid w) =>
EffectHandler (Writer w) es
localWriter

-- | Run a 'Writer' effect and return the final output, discarding the final
-- value (via "Effectful.Writer.Static.Local").
execWriterLocal :: (HasCallStack, Monoid w) => Eff (Writer w : es) a -> Eff es w
execWriterLocal :: forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es w
execWriterLocal = (Eff (Writer w : es) a -> Eff es w)
-> EffectHandler (Writer w) (Writer w : es)
-> Eff (Writer w : es) a
-> Eff es w
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Writer w : es) a -> Eff es w
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es w
L.execWriter LocalEnv localEs (Writer w : es)
-> Writer w (Eff localEs) a -> Eff (Writer w : es) a
EffectHandler (Writer w) (Writer w : es)
forall w (es :: [(Type -> Type) -> Type -> Type]).
(Writer w :> es, Monoid w) =>
EffectHandler (Writer w) es
localWriter

localWriter :: (L.Writer w :> es, Monoid w) => EffectHandler (Writer w) es
localWriter :: forall w (es :: [(Type -> Type) -> Type -> Type]).
(Writer w :> es, Monoid w) =>
EffectHandler (Writer w) es
localWriter LocalEnv localEs es
env = \case
  Tell w
w   -> w -> Eff es ()
forall w (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Writer w :> es, Monoid w) =>
w -> Eff es ()
L.tell w
w
  Listen Eff localEs a
m -> LocalEnv localEs es
-> ((forall {r}. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type])
       (handlerEs :: [(Type -> Type) -> Type -> Type])
       (localEs :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs es
env (((forall {r}. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a)
-> ((forall {r}. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff es r
unlift -> Eff es a -> Eff es (a, w)
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Writer w :> es, Monoid w) =>
Eff es a -> Eff es (a, w)
L.listen (Eff localEs a -> Eff es a
forall {r}. Eff localEs r -> Eff es r
unlift Eff localEs a
m)

----------------------------------------
-- Shared

-- | Run the 'Writer' effect and return the final value along with the final
-- output (via "Effectful.Writer.Static.Shared").
runWriterShared :: (HasCallStack, Monoid w) => Eff (Writer w : es) a -> Eff es (a, w)
runWriterShared :: forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es (a, w)
runWriterShared = (Eff (Writer w : es) a -> Eff es (a, w))
-> EffectHandler (Writer w) (Writer w : es)
-> Eff (Writer w : es) a
-> Eff es (a, w)
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Writer w : es) a -> Eff es (a, w)
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es (a, w)
S.runWriter LocalEnv localEs (Writer w : es)
-> Writer w (Eff localEs) a -> Eff (Writer w : es) a
EffectHandler (Writer w) (Writer w : es)
forall w (es :: [(Type -> Type) -> Type -> Type]).
(Writer w :> es, Monoid w) =>
EffectHandler (Writer w) es
sharedWriter

-- | Run the 'Writer' effect and return the final output, discarding the final
-- value (via "Effectful.Writer.Static.Shared").
execWriterShared :: (HasCallStack, Monoid w) => Eff (Writer w : es) a -> Eff es w
execWriterShared :: forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es w
execWriterShared = (Eff (Writer w : es) a -> Eff es w)
-> EffectHandler (Writer w) (Writer w : es)
-> Eff (Writer w : es) a
-> Eff es w
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Writer w : es) a -> Eff es w
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es w
S.execWriter LocalEnv localEs (Writer w : es)
-> Writer w (Eff localEs) a -> Eff (Writer w : es) a
EffectHandler (Writer w) (Writer w : es)
forall w (es :: [(Type -> Type) -> Type -> Type]).
(Writer w :> es, Monoid w) =>
EffectHandler (Writer w) es
sharedWriter

sharedWriter :: (S.Writer w :> es, Monoid w) => EffectHandler (Writer w) es
sharedWriter :: forall w (es :: [(Type -> Type) -> Type -> Type]).
(Writer w :> es, Monoid w) =>
EffectHandler (Writer w) es
sharedWriter LocalEnv localEs es
env = \case
  Tell w
w    -> w -> Eff es ()
forall w (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Writer w :> es, Monoid w) =>
w -> Eff es ()
S.tell w
w
  Listen Eff localEs a
m  -> LocalEnv localEs es
-> ((forall {r}. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type])
       (handlerEs :: [(Type -> Type) -> Type -> Type])
       (localEs :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs es
env (((forall {r}. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a)
-> ((forall {r}. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff es r
unlift -> Eff es a -> Eff es (a, w)
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Writer w :> es, Monoid w) =>
Eff es a -> Eff es (a, w)
S.listen (Eff localEs a -> Eff es a
forall {r}. Eff localEs r -> Eff es r
unlift Eff localEs a
m)

----------------------------------------
-- Operations

-- | Append the given output to the overall output of the 'Writer'.
tell
  :: (HasCallStack, Writer w :> es)
  => w
  -> Eff es ()
tell :: forall w (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Writer w :> es) =>
w -> Eff es ()
tell = Writer w (Eff es) () -> Eff es ()
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Writer w (Eff es) () -> Eff es ())
-> (w -> Writer w (Eff es) ()) -> w -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Writer w (Eff es) ()
forall w (m :: Type -> Type). w -> Writer w m ()
Tell

-- | Execute an action and append its output to the overall output of the
-- 'Writer'.
listen
  :: (HasCallStack, Writer w :> es)
  => Eff es a
  -> Eff es (a, w)
listen :: forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Writer w :> es) =>
Eff es a -> Eff es (a, w)
listen = Writer w (Eff es) (a, w) -> Eff es (a, w)
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Writer w (Eff es) (a, w) -> Eff es (a, w))
-> (Eff es a -> Writer w (Eff es) (a, w))
-> Eff es a
-> Eff es (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> Writer w (Eff es) (a, w)
forall (m :: Type -> Type) a w. m a -> Writer w m (a, w)
Listen

-- | Execute an action and append its output to the overall output of the
-- 'Writer', then return the final value along with a function of the recorded
-- output.
--
-- @'listens' f m ≡ 'Data.Bifunctor.second' f '<$>' 'listen' m@
listens
  :: (HasCallStack, Writer w :> es)
  => (w -> b)
  -> Eff es a
  -> Eff es (a, b)
listens :: forall w (es :: [(Type -> Type) -> Type -> Type]) b a.
(HasCallStack, Writer w :> es) =>
(w -> b) -> Eff es a -> Eff es (a, b)
listens w -> b
f Eff es a
m = do
  (a
a, w
w) <- Eff es a -> Eff es (a, w)
forall w (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Writer w :> es) =>
Eff es a -> Eff es (a, w)
listen Eff es a
m
  (a, b) -> Eff es (a, b)
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a
a, w -> b
f w
w)