{-# LANGUAGE CPP #-}

-- |
-- Module:       Control.Monad.Freer.Writer
-- Description:  Composable Writer effects.
-- Copyright:    (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
-- License:      BSD3
-- Maintainer:   Alexis King <lexi.lambda@gmail.com>
-- Stability:    experimental
-- Portability:  GHC specific language extensions.
--
-- 'Writer' effects, for writing\/appending values (line count, list of
-- messages, etc.) to an output. Current value of 'Writer' effect output is not
-- accessible to the computation.
--
-- Using <http://okmij.org/ftp/Haskell/extensible/Eff1.hs> as a starting point.
module Control.Monad.Freer.Writer
  ( Writer(..)
  , tell
  , runWriter
  ) where

import Control.Arrow (second)

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif

import Control.Monad.Freer.Internal (Eff, Member, handleRelay, send)

-- | Writer effects - send outputs to an effect environment.
data Writer w r where
  Tell :: w -> Writer w ()

-- | Send a change to the attached environment.
tell :: forall w effs. Member (Writer w) effs => w -> Eff effs ()
tell :: w -> Eff effs ()
tell w
w = Writer w () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (w -> Writer w ()
forall w. w -> Writer w ()
Tell w
w)

-- | Simple handler for 'Writer' effects.
runWriter :: forall w effs a. Monoid w => Eff (Writer w ': effs) a -> Eff effs (a, w)
runWriter :: Eff (Writer w : effs) a -> Eff effs (a, w)
runWriter = (a -> Eff effs (a, w))
-> (forall v. Writer w v -> Arr effs v (a, w) -> Eff effs (a, w))
-> Eff (Writer w : effs) a
-> Eff effs (a, w)
forall a (effs :: [* -> *]) b (eff :: * -> *).
(a -> Eff effs b)
-> (forall v. eff v -> Arr effs v b -> Eff effs b)
-> Eff (eff : effs) a
-> Eff effs b
handleRelay (\a
a -> (a, w) -> Eff effs (a, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, w
forall a. Monoid a => a
mempty)) ((forall v. Writer w v -> Arr effs v (a, w) -> Eff effs (a, w))
 -> Eff (Writer w : effs) a -> Eff effs (a, w))
-> (forall v. Writer w v -> Arr effs v (a, w) -> Eff effs (a, w))
-> Eff (Writer w : effs) a
-> Eff effs (a, w)
forall a b. (a -> b) -> a -> b
$ \(Tell w) Arr effs v (a, w)
k ->
  (w -> w) -> (a, w) -> (a, w)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (w
w w -> w -> w
forall a. Semigroup a => a -> a -> a
<>) ((a, w) -> (a, w)) -> Eff effs (a, w) -> Eff effs (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arr effs v (a, w)
k ()