content: module Control.Effect.Writer.Strict
    ( module Control.Effect.Writer
    , runWriter
    , evalWriter
    , execWriter
    ) where
  
  import Control.Category ((>>>))
  import Control.Effect.Base
  import Control.Effect.State.Strict
  import Control.Effect.Writer
  import Data.Function
  
  -- | Handles a @'Writer'@ effect, strictly accumulating the monoidal state.
  --
  -- Note that the state will be accumulated via __left-associated__ uses of '<>'.
  -- This is necessary to be strict, but it can be catastrophically slow on
  -- certain monoids, most notably @[]@. To avoid pathological performance, use a
  -- data structure that supports efficient appends, such as @Data.Sequence.Seq@,
  -- or use 'Data.Semigroup.Dual' to flip the argument order of '<>' (but beware
  -- that this will cause the elements to be accumulated in reverse order).
  runWriter :: Monoid w => Eff (Writer w ': effs) a -> Eff effs (w, a)
  runWriter (m0 :: Eff (Writer w ': effs) a) = lift m0
    & handle pure \case
        Tell w -> liftH $ tellS w
        Listen m -> locally $ runListen m
        Censor f m -> locally $ runCensor f m
    & runState mempty
    where
      tellS :: State w :< effs' => w -> Eff effs' ()
      tellS w = get >>= \ws -> put $! (ws <> w)
  
      runListen :: Writer w :< effs' => Eff (Writer w ': effs') b -> Eff effs' (w, b)
      runListen = lift
        >>> handle pure \case
              Tell w -> liftH do
                tellS w
                lift1 $ tell w
              Listen m -> locally $ runListen m
              Censor f m -> locally $ runCensor f m
        >>> runState mempty
  
      runCensor :: Writer w :< effs' => (w -> w) -> Eff (Writer w ': effs') b -> Eff effs' b
      runCensor f = handle pure \case
        Tell w -> liftH $ lift1 (tell $! f w)
        Listen m -> locally $ runListen m
        Censor g m -> locally $ runCensor g m
  
  evalWriter :: Monoid w => Eff (Writer w ': effs) a -> Eff effs a
  evalWriter = fmap snd . runWriter
  
  execWriter :: Monoid w => Eff (Writer w ': effs) a -> Eff effs w
  execWriter = fmap fst . runWriter
  