Writer.hs

{-|
Module      : DeepControl.Monad.Trans.Writer
Description : Extension for mtl's Contrl.Monad.Writer.
Copyright   : (c) Andy Gill 2001,
              (c) Oregon Graduate Institute of Science and Technology, 2001,
              (C) 2015 KONISHI Yohsuke,
License     : BSD-style (see the file LICENSE)
Maintainer  : ocean0yohsuke@gmail.com
Stability   : experimental
Portability : ---

This module extended Writer monad of mtl(monad-transformer-library).
-}
{-# LANGUAGE FlexibleInstances #-}
module DeepControl.Monad.Trans.Writer (
    module Control.Monad.Writer,

    -- * Level-2
    listen2, pass2,
    -- * Level-3
    listen3, pass3,
    -- * Level-4
    --listen4, pass4,
    -- * Level-5
    --listen5, pass5,

    ) where 

import DeepControl.Applicative
import DeepControl.Commutative
import DeepControl.Monad
import DeepControl.Monad.Signatures
import DeepControl.Monad.Trans

import Control.Monad.Writer
import Control.Monad.Identity
import Data.Monoid

----------------------------------------------------------------------
-- Level-1

instance (Monoid w) => Commutative (Writer w) where
    commute x = 
        let (a, b) = runWriter x
        in  (WriterT . Identity) |$> (a <$|(,)|* b)

----------------------------------------------------------------------
-- Level-2

instance (Monoid w) => Monad2 (Writer w) where
    mv >>== f = 
        mv >>= \x -> runWriterT x >- \(Identity (a, w)) ->
        f a <$| (\x -> runWriterT x >- \(Identity (b, w')) ->
                       WriterT $ Identity (b, w <> w'))

listen2 :: (MonadWriter w m2, Applicative m1) => m1 (m2 a) -> m1 (m2 (a, w))
listen2 m = listen |$> m
pass2 :: (MonadWriter w m2, Applicative m1) => m1 (m2 (a, w -> w)) -> m1 (m2 a)
pass2 m = pass |$> m

----------------------------------------------------------------------
-- Level-3

instance (Monoid w) => Monad3 (Writer w) where
    mv >>>== f = 
        mv >>== \x -> runWriterT x >- \(Identity (a, w)) ->
        f a <<$| (\x -> runWriterT x >- \(Identity (b, w')) ->
                        WriterT $ Identity (b, w <> w'))

listen3 :: (MonadWriter w m3, Applicative m1, Applicative m2) => m1 (m2 (m3 a)) -> m1 (m2 (m3 (a, w)))
listen3 m = listen2 |$> m
pass3 :: (MonadWriter w m3, Applicative m1, Applicative m2) => m1 (m2 (m3 (a, w -> w))) -> m1 (m2 (m3 a))
pass3 m = pass2 |$> m

----------------------------------------------------------------------
-- Level-4

instance (Monoid w) => Monad4 (Writer w) where
    mv >>>>== f = 
        mv >>>== \x -> runWriterT x >- \(Identity (a, w)) ->
        f a <<<$| (\x -> runWriterT x >- \(Identity (b, w')) ->
                         WriterT $ Identity (b, w <> w'))

----------------------------------------------------------------------
-- Level-5

instance (Monoid w) => Monad5 (Writer w) where
    mv >>>>>== f = 
        mv >>>>== \x -> runWriterT x >- \(Identity (a, w)) ->
        f a <<<<$| (\x -> runWriterT x >- \(Identity (b, w')) ->
                          WriterT $ Identity (b, w <> w'))