-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Writer.Class
-- Copyright   :  (c) Andy Gill 2001,
--                (c) Oregon Graduate Institute of Science and Technology, 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  ross@soi.city.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (type families)
--
-- The MonadWriter class.
--
--      Inspired by the paper
--      /Functional Programming with Overloading and
--          Higher-Order Polymorphism/,
--        Mark P Jones (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>)
--          Advanced School of Functional Programming, 1995.
-----------------------------------------------------------------------------

module Control.Monad.Writer.Class (
    MonadWriter(..),
    listens,
    censor,
  ) where

import Control.Monad.Trans.Error as Error
import Control.Monad.Trans.Identity as Identity
import Control.Monad.Trans.Maybe as Maybe
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (
        RWST, tell, listen, pass)
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (
        RWST, tell, listen, pass)
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy (
        WriterT, tell, listen, pass)
import qualified Control.Monad.Trans.Writer.Strict as Strict (
        WriterT, tell, listen, pass)
import Control.Monad.Trans (lift)

import Data.Monoid

-- ---------------------------------------------------------------------------
-- MonadWriter class
--
-- tell is like tell on the MUD's it shouts to monad
-- what you want to be heard. The monad carries this 'packet'
-- upwards, merging it if needed (hence the Monoid requirement).
--
-- listen listens to a monad acting, and returns what the monad "said".
--
-- pass lets you provide a writer transformer which changes internals of
-- the written object.

class (Monoid (WriterType m), Monad m) => MonadWriter m where
    type WriterType m
    tell   :: WriterType m -> m ()
    listen :: m a -> m (a, WriterType m)
    pass   :: m (a, WriterType m -> WriterType m) -> m a

listens :: (MonadWriter m) => (WriterType m -> b) -> m a -> m (a, b)
listens :: (WriterType m -> b) -> m a -> m (a, b)
listens f :: WriterType m -> b
f m :: m a
m = do
    ~(a :: a
a, w :: WriterType m
w) <- m a -> m (a, WriterType m)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen m a
m
    (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, WriterType m -> b
f WriterType m
w)

censor :: (MonadWriter m) => (WriterType m -> WriterType m) -> m a -> m a
censor :: (WriterType m -> WriterType m) -> m a -> m a
censor f :: WriterType m -> WriterType m
f m :: m a
m = m (a, WriterType m -> WriterType m) -> m a
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass (m (a, WriterType m -> WriterType m) -> m a)
-> m (a, WriterType m -> WriterType m) -> m a
forall a b. (a -> b) -> a -> b
$ do
    a
a <- m a
m
    (a, WriterType m -> WriterType m)
-> m (a, WriterType m -> WriterType m)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, WriterType m -> WriterType m
f)

instance (Monoid w, Monad m) => MonadWriter (Lazy.WriterT w m) where
    type WriterType (Lazy.WriterT w m) = w
    tell :: WriterType (WriterT w m) -> WriterT w m ()
tell   = WriterType (WriterT w m) -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Lazy.tell
    listen :: WriterT w m a -> WriterT w m (a, WriterType (WriterT w m))
listen = WriterT w m a -> WriterT w m (a, WriterType (WriterT w m))
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Lazy.listen
    pass :: WriterT
  w m (a, WriterType (WriterT w m) -> WriterType (WriterT w m))
-> WriterT w m a
pass   = WriterT
  w m (a, WriterType (WriterT w m) -> WriterType (WriterT w m))
-> WriterT w m a
forall (m :: * -> *) w a.
Monad m =>
WriterT w m (a, w -> w) -> WriterT w m a
Lazy.pass

instance (Monoid w, Monad m) => MonadWriter (Strict.WriterT w m) where
    type WriterType (Strict.WriterT w m) = w
    tell :: WriterType (WriterT w m) -> WriterT w m ()
tell   = WriterType (WriterT w m) -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Strict.tell
    listen :: WriterT w m a -> WriterT w m (a, WriterType (WriterT w m))
listen = WriterT w m a -> WriterT w m (a, WriterType (WriterT w m))
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Strict.listen
    pass :: WriterT
  w m (a, WriterType (WriterT w m) -> WriterType (WriterT w m))
-> WriterT w m a
pass   = WriterT
  w m (a, WriterType (WriterT w m) -> WriterType (WriterT w m))
-> WriterT w m a
forall (m :: * -> *) w a.
Monad m =>
WriterT w m (a, w -> w) -> WriterT w m a
Strict.pass

instance (Monoid w, Monad m) => MonadWriter (LazyRWS.RWST r w s m) where
    type WriterType (LazyRWS.RWST r w s m) = w
    tell :: WriterType (RWST r w s m) -> RWST r w s m ()
tell   = WriterType (RWST r w s m) -> RWST r w s m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
LazyRWS.tell
    listen :: RWST r w s m a -> RWST r w s m (a, WriterType (RWST r w s m))
listen = RWST r w s m a -> RWST r w s m (a, WriterType (RWST r w s m))
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
LazyRWS.listen
    pass :: RWST
  r w s m (a, WriterType (RWST r w s m) -> WriterType (RWST r w s m))
-> RWST r w s m a
pass   = RWST
  r w s m (a, WriterType (RWST r w s m) -> WriterType (RWST r w s m))
-> RWST r w s m a
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m (a, w -> w) -> RWST r w s m a
LazyRWS.pass

instance (Monoid w, Monad m) => MonadWriter (StrictRWS.RWST r w s m) where
    type WriterType (StrictRWS.RWST r w s m) = w
    tell :: WriterType (RWST r w s m) -> RWST r w s m ()
tell   = WriterType (RWST r w s m) -> RWST r w s m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
StrictRWS.tell
    listen :: RWST r w s m a -> RWST r w s m (a, WriterType (RWST r w s m))
listen = RWST r w s m a -> RWST r w s m (a, WriterType (RWST r w s m))
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
StrictRWS.listen
    pass :: RWST
  r w s m (a, WriterType (RWST r w s m) -> WriterType (RWST r w s m))
-> RWST r w s m a
pass   = RWST
  r w s m (a, WriterType (RWST r w s m) -> WriterType (RWST r w s m))
-> RWST r w s m a
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m (a, w -> w) -> RWST r w s m a
StrictRWS.pass

-- ---------------------------------------------------------------------------
-- Instances for other mtl transformers

instance (Error e, MonadWriter m) => MonadWriter (ErrorT e m) where
    type WriterType (ErrorT e m) = WriterType m
    tell :: WriterType (ErrorT e m) -> ErrorT e m ()
tell   = m () -> ErrorT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ErrorT e m ())
-> (WriterType m -> m ()) -> WriterType m -> ErrorT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterType m -> m ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: ErrorT e m a -> ErrorT e m (a, WriterType (ErrorT e m))
listen = Listen (WriterType m) m (Either e a)
-> Listen (WriterType m) (ErrorT e m) a
forall (m :: * -> *) w e a.
Monad m =>
Listen w m (Either e a) -> Listen w (ErrorT e m) a
Error.liftListen Listen (WriterType m) m (Either e a)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: ErrorT e m (a, WriterType (ErrorT e m) -> WriterType (ErrorT e m))
-> ErrorT e m a
pass   = Pass (WriterType m) m (Either e a)
-> Pass (WriterType m) (ErrorT e m) a
forall (m :: * -> *) w e a.
Monad m =>
Pass w m (Either e a) -> Pass w (ErrorT e m) a
Error.liftPass Pass (WriterType m) m (Either e a)
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (IdentityT m) where
    type WriterType (IdentityT m) = WriterType m
    tell :: WriterType (IdentityT m) -> IdentityT m ()
tell   = m () -> IdentityT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> IdentityT m ())
-> (WriterType m -> m ()) -> WriterType m -> IdentityT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterType m -> m ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: IdentityT m a -> IdentityT m (a, WriterType (IdentityT m))
listen = (m a -> m (a, WriterType m))
-> IdentityT m a -> IdentityT m (a, WriterType m)
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
Identity.mapIdentityT m a -> m (a, WriterType m)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: IdentityT
  m (a, WriterType (IdentityT m) -> WriterType (IdentityT m))
-> IdentityT m a
pass   = (m (a, WriterType m -> WriterType m) -> m a)
-> IdentityT m (a, WriterType m -> WriterType m) -> IdentityT m a
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
Identity.mapIdentityT m (a, WriterType m -> WriterType m) -> m a
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (MaybeT m) where
    type WriterType (MaybeT m) = WriterType m
    tell :: WriterType (MaybeT m) -> MaybeT m ()
tell   = m () -> MaybeT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> MaybeT m ())
-> (WriterType m -> m ()) -> WriterType m -> MaybeT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterType m -> m ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: MaybeT m a -> MaybeT m (a, WriterType (MaybeT m))
listen = Listen (WriterType m) m (Maybe a)
-> Listen (WriterType m) (MaybeT m) a
forall (m :: * -> *) w a.
Monad m =>
Listen w m (Maybe a) -> Listen w (MaybeT m) a
Maybe.liftListen Listen (WriterType m) m (Maybe a)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: MaybeT m (a, WriterType (MaybeT m) -> WriterType (MaybeT m))
-> MaybeT m a
pass   = Pass (WriterType m) m (Maybe a) -> Pass (WriterType m) (MaybeT m) a
forall (m :: * -> *) w a.
Monad m =>
Pass w m (Maybe a) -> Pass w (MaybeT m) a
Maybe.liftPass Pass (WriterType m) m (Maybe a)
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (ReaderT r m) where
    type WriterType (ReaderT r m) = WriterType m
    tell :: WriterType (ReaderT r m) -> ReaderT r m ()
tell   = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (WriterType m -> m ()) -> WriterType m -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterType m -> m ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: ReaderT r m a -> ReaderT r m (a, WriterType (ReaderT r m))
listen = (m a -> m (a, WriterType m))
-> ReaderT r m a -> ReaderT r m (a, WriterType m)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m (a, WriterType m)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: ReaderT
  r m (a, WriterType (ReaderT r m) -> WriterType (ReaderT r m))
-> ReaderT r m a
pass   = (m (a, WriterType m -> WriterType m) -> m a)
-> ReaderT r m (a, WriterType m -> WriterType m) -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m (a, WriterType m -> WriterType m) -> m a
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (Lazy.StateT s m) where
    type WriterType (Lazy.StateT s m) = WriterType m
    tell :: WriterType (StateT s m) -> StateT s m ()
tell   = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (WriterType m -> m ()) -> WriterType m -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterType m -> m ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: StateT s m a -> StateT s m (a, WriterType (StateT s m))
listen = Listen (WriterType m) m (a, s)
-> Listen (WriterType m) (StateT s m) a
forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
Lazy.liftListen Listen (WriterType m) m (a, s)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: StateT s m (a, WriterType (StateT s m) -> WriterType (StateT s m))
-> StateT s m a
pass   = Pass (WriterType m) m (a, s) -> Pass (WriterType m) (StateT s m) a
forall (m :: * -> *) w a s.
Monad m =>
Pass w m (a, s) -> Pass w (StateT s m) a
Lazy.liftPass Pass (WriterType m) m (a, s)
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (Strict.StateT s m) where
    type WriterType (Strict.StateT s m) = WriterType m
    tell :: WriterType (StateT s m) -> StateT s m ()
tell   = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (WriterType m -> m ()) -> WriterType m -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterType m -> m ()
forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: StateT s m a -> StateT s m (a, WriterType (StateT s m))
listen = Listen (WriterType m) m (a, s)
-> Listen (WriterType m) (StateT s m) a
forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
Strict.liftListen Listen (WriterType m) m (a, s)
forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: StateT s m (a, WriterType (StateT s m) -> WriterType (StateT s m))
-> StateT s m a
pass   = Pass (WriterType m) m (a, s) -> Pass (WriterType m) (StateT s m) a
forall (m :: * -> *) w a s.
Monad m =>
Pass w m (a, s) -> Pass w (StateT s m) a
Strict.liftPass Pass (WriterType m) m (a, s)
forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass