content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  {- | A high-performance, strict, church-encoded carrier for 'Writer'.
  
  This carrier issues left-associated 'mappend's, meaning that 'Monoid's such as @[]@ with poor performance for left-associated 'mappend's are ill-suited for use with this carrier. Alternatives such as 'Data.Monoid.Endo', @Seq@, or @DList@ may be preferred.
  
  @since 1.1.0.0
  -}
  module Control.Carrier.Writer.Church
  ( -- * Writer carrier
    runWriter
  , execWriter
  , WriterC(WriterC)
    -- * Writer effect
  , module Control.Effect.Writer
  ) where
  
  import Control.Algebra
  import Control.Applicative (Alternative)
  import Control.Carrier.State.Church
  import Control.Effect.Writer
  import Control.Monad (MonadPlus)
  import Control.Monad.Fail as Fail
  import Control.Monad.Fix
  import Control.Monad.IO.Class
  import Control.Monad.Trans.Class
  
  -- | Run a 'Writer' effect with a 'Monoid'al log, applying a continuation to the final log and result.
  --
  -- @
  -- 'runWriter' k ('pure' a) = k 'mempty' a
  -- @
  -- @
  -- 'runWriter' k ('tell' w) = k w ()
  -- @
  -- @
  -- 'runWriter' k ('listen' ('tell' w)) = k w (w, ())
  -- @
  -- @
  -- 'runWriter' k ('censor' f ('tell' w)) = k (f w) ()
  -- @
  --
  -- @since 1.1.0.0
  runWriter :: Monoid w => (w -> a -> m b) -> WriterC w m a -> m b
  runWriter k = runState k mempty . runWriterC
  {-# INLINE runWriter #-}
  
  -- | Run a 'Writer' effect with a 'Monoid'al log, producing the final log and discarding the result value.
  --
  -- @
  -- 'execWriter' = 'runWriter' ('const' '.' 'pure')
  -- @
  --
  -- @since 1.1.0.0
  execWriter :: (Monoid w, Applicative m) => WriterC w m a -> m w
  execWriter = runWriter (const . pure)
  {-# INLINE execWriter #-}
  
  -- | @since 1.1.0.0
  newtype WriterC w m a = WriterC { runWriterC :: StateC w m a }
    deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus, MonadTrans)
  
  instance (Algebra sig m, Monoid w) => Algebra (Writer w :+: sig) (WriterC w m) where
    alg hdl sig ctx = WriterC $ case sig of
      L writer -> StateC $ \ k w -> case writer of
        Tell w'    -> do
          let !w'' = mappend w w'
          k w'' ctx
        Listen   m -> runWriter (\ w' a -> do
          let !w'' = mappend w w'
          k w'' ((,) w' <$> a)) (hdl (m <$ ctx))
        Censor f m -> runWriter (\ w' a -> do
          let !w'' = mappend w (f w')
          k w'' a) (hdl (m <$ ctx))
      R other  -> alg (runWriterC . hdl) (R other) ctx
    {-# INLINE alg #-}
  