{-# LANGUAGE TupleSections #-}

-- | Extension of a monad with a write-only environment
module Mini.Transformers.WriterT (
  -- * Type
  WriterT,

  -- * Writing
  tell,

  -- * Runners
  runWriterT,
) where

import Control.Applicative (
  Alternative (
    empty,
    (<|>)
  ),
 )
import Control.Monad (
  ap,
  liftM,
 )
import Data.Functor (
  (<&>),
 )
import Mini.Transformers.Class (
  MonadTrans (
    lift
  ),
 )

{-
 - Type
 -}

{- | A monad with monoidal write-only type /w/, inner monad /m/, and return type
/a/
-}
newtype WriterT w m a = WriterT
  { runWriterT :: m (a, w)
  -- ^ Unwrap a 'WriterT'
  }

instance (Monad m, Monoid w) => Functor (WriterT w m) where
  fmap = liftM

instance (Monad m, Monoid w) => Applicative (WriterT w m) where
  pure = WriterT . pure . (,mempty)
  (<*>) = ap

instance (Monad m, Alternative m, Monoid w) => Alternative (WriterT w m) where
  empty = WriterT empty
  m <|> n = WriterT $ runWriterT m <|> runWriterT n

instance (Monad m, Monoid w) => Monad (WriterT w m) where
  m >>= k = WriterT $ do
    (a, w) <- runWriterT m
    (b, w') <- runWriterT (k a)
    pure (b, w <> w')

instance (Monoid w) => MonadTrans (WriterT w) where
  lift m = WriterT $ m <&> (,mempty)

{-
 - Writing
 -}

-- | Append the given value to the output
tell :: (Monad m) => w -> WriterT w m ()
tell = WriterT . pure . ((),)