{-# LANGUAGE DeriveFunctor, ExistentialQuantification, RankNTypes, StandaloneDeriving #-}

{- | An effect allowing writes to an accumulated quantity alongside a computed value. A 'Writer' @w@ effect keeps track of a monoidal datum of type @w@ and strictly appends to that monoidal value with the 'tell' effect. Writes to that value can be detected and intercepted with the 'listen' and 'censor' effects.

Predefined carriers:

* "Control.Carrier.Writer.Strict". (A lazy carrier is not provided due to the inherent space leaks associated with lazy writer monads.)
* "Control.Monad.Trans.RWS.Lazy"
* "Control.Monad.Trans.RWS.Strict"
* "Control.Monad.Trans.Writer.Lazy"
* "Control.Monad.Trans.Writer.Strict"
* If 'Writer' @w@ is the last effect in a stack, it can be interpreted to a tuple @(w, a)@ given some result type @a@ and the presence of a 'Monoid' instance for @w@.

@since 0.1.0.0
-}

module Control.Effect.Writer
( -- * Writer effect
  Writer(..)
, tell
, listen
, listens
, censor
  -- * Re-exports
, Algebra
, Effect
, Has
, run
) where

import Control.Algebra
import Control.Effect.Writer.Internal (Writer(..))

-- | Write a value to the log.
--
-- @
-- runWriter ('tell' w '>>' m) = 'Data.Bifunctor.first' ('mappend' w) '<$>' runWriter m
-- @
--
-- @since 0.1.0.0
tell :: Has (Writer w) sig m => w -> m ()
tell :: w -> m ()
tell w :: w
w = Writer w m () -> m ()
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (w -> m () -> Writer w m ()
forall w (m :: * -> *) k. w -> m k -> Writer w m k
Tell w
w (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
{-# INLINE tell #-}

-- | Run a computation, returning the pair of its output and its result.
--
-- @
-- runWriter ('listen' m) = 'fmap' ('fst' 'Control.Arrow.&&&' 'id') (runWriter m)
-- @
--
-- @since 0.2.0.0
listen :: Has (Writer w) sig m => m a -> m (w, a)
listen :: m a -> m (w, a)
listen m :: m a
m = Writer w m (w, a) -> m (w, a)
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (m a -> (w -> a -> m (w, a)) -> Writer w m (w, a)
forall w (m :: * -> *) k a. m a -> (w -> a -> m k) -> Writer w m k
Listen m a
m (((w, a) -> m (w, a)) -> w -> a -> m (w, a)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (w, a) -> m (w, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure))
{-# INLINE listen #-}

-- | Run a computation, applying a function to its output and returning the pair of the modified output and its result.
--
-- @
-- 'listens' f m = 'fmap' ('Data.Bifunctor.first' f) ('listen' m)
-- @
--
-- @since 0.2.0.0
listens :: Has (Writer w) sig m => (w -> b) -> m a -> m (b, a)
listens :: (w -> b) -> m a -> m (b, a)
listens f :: w -> b
f m :: m a
m = Writer w m (b, a) -> m (b, a)
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (m a -> (w -> a -> m (b, a)) -> Writer w m (b, a)
forall w (m :: * -> *) k a. m a -> (w -> a -> m k) -> Writer w m k
Listen m a
m (((b, a) -> m (b, a)) -> b -> a -> m (b, a)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (b, a) -> m (b, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> a -> m (b, a)) -> (w -> b) -> w -> a -> m (b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> b
f))
{-# INLINE listens #-}

-- | Run a computation, modifying its output with the passed function.
--
-- @
-- runWriter ('censor' f m) = 'fmap' ('Data.Bifunctor.first' f) (runWriter m)
-- @
--
-- @since 0.2.0.0
censor :: Has (Writer w) sig m => (w -> w) -> m a -> m a
censor :: (w -> w) -> m a -> m a
censor f :: w -> w
f m :: m a
m = Writer w m a -> m a
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send ((w -> w) -> m a -> (a -> m a) -> Writer w m a
forall w (m :: * -> *) k a.
(w -> w) -> m a -> (a -> m k) -> Writer w m k
Censor w -> w
f m a
m a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
{-# INLINE censor #-}