{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
-- Search for UndecidableInstances to see why this is needed

-----------------------------------------------------------------------------
-- |
-- 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  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (multi-param classes, functional dependencies)
--
-- 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.Except as Except
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, writer, tell, listen, pass)
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (
        RWST, writer, 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, writer, tell, listen, pass)
import qualified Control.Monad.Trans.Writer.Strict as Strict (
        WriterT, writer, tell, listen, pass)

import Control.Monad.Trans.Class (lift)
import Control.Monad
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 w, Monad m) => MonadWriter w m | m -> w where
#if __GLASGOW_HASKELL__ >= 707
    {-# MINIMAL (writer | tell), listen, pass #-}
#endif
    -- | @'writer' (a,w)@ embeds a simple writer action.
    writer :: (a,w) -> m a
    writer ~(a
a, w
w) = do
      w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
w
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

    -- | @'tell' w@ is an action that produces the output @w@.
    tell   :: w -> m ()
    tell w
w = ((), w) -> m ()
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer ((),w
w)

    -- | @'listen' m@ is an action that executes the action @m@ and adds
    -- its output to the value of the computation.
    listen :: m a -> m (a, w)
    -- | @'pass' m@ is an action that executes the action @m@, which
    -- returns a value and a function, and returns the value, applying
    -- the function to the output.
    pass   :: m (a, w -> w) -> m a

-- | @'listens' f m@ is an action that executes the action @m@ and adds
-- the result of applying @f@ to the output to the value of the computation.
--
-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
listens :: MonadWriter w m => (w -> b) -> m a -> m (a, b)
listens :: (w -> b) -> m a -> m (a, b)
listens w -> b
f m a
m = do
    ~(a
a, w
w) <- m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m a
m
    (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, w -> b
f w
w)

-- | @'censor' f m@ is an action that executes the action @m@ and
-- applies the function @f@ to its output, leaving the return value
-- unchanged.
--
-- * @'censor' f m = 'pass' ('liftM' (\\x -> (x,f)) m)@
censor :: MonadWriter w m => (w -> w) -> m a -> m a
censor :: (w -> w) -> m a -> m a
censor w -> w
f m a
m = m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (a, w -> w) -> m a) -> m (a, w -> w) -> m a
forall a b. (a -> b) -> a -> b
$ do
    a
a <- m a
m
    (a, w -> w) -> m (a, w -> w)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, w -> w
f)

#if MIN_VERSION_base(4,9,0)
-- | __NOTE__: This instance is only defined for @base >= 4.9.0@.
--
-- @since 2.2.2
instance (Monoid w) => MonadWriter w ((,) w) where
  writer :: (a, w) -> (w, a)
writer ~(a
a, w
w) = (w
w, a
a)
  tell :: w -> (w, ())
tell w
w = (w
w, ())
  listen :: (w, a) -> (w, (a, w))
listen ~(w
w, a
a) = (w
w, (a
a, w
w))
  pass :: (w, (a, w -> w)) -> (w, a)
pass ~(w
w, (a
a, w -> w
f)) = (w -> w
f w
w, a
a)
#endif

instance (Monoid w, Monad m) => MonadWriter w (Lazy.WriterT w m) where
    writer :: (a, w) -> WriterT w m a
writer = (a, w) -> WriterT w m a
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
Lazy.writer
    tell :: w -> WriterT w m ()
tell   = w -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Lazy.tell
    listen :: WriterT w m a -> WriterT w m (a, w)
listen = WriterT w m a -> WriterT w m (a, w)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Lazy.listen
    pass :: WriterT w m (a, w -> w) -> WriterT w m a
pass   = WriterT w m (a, w -> w) -> 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 w (Strict.WriterT w m) where
    writer :: (a, w) -> WriterT w m a
writer = (a, w) -> WriterT w m a
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
Strict.writer
    tell :: w -> WriterT w m ()
tell   = w -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Strict.tell
    listen :: WriterT w m a -> WriterT w m (a, w)
listen = WriterT w m a -> WriterT w m (a, w)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Strict.listen
    pass :: WriterT w m (a, w -> w) -> WriterT w m a
pass   = WriterT w m (a, w -> w) -> 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 w (LazyRWS.RWST r w s m) where
    writer :: (a, w) -> RWST r w s m a
writer = (a, w) -> RWST r w s m a
forall (m :: * -> *) a w r s. Monad m => (a, w) -> RWST r w s m a
LazyRWS.writer
    tell :: w -> RWST r w s m ()
tell   = w -> 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, w)
listen = RWST r w s m a -> RWST r w s m (a, w)
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, w -> w) -> RWST r w s m a
pass   = RWST r w s m (a, w -> w) -> 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 w (StrictRWS.RWST r w s m) where
    writer :: (a, w) -> RWST r w s m a
writer = (a, w) -> RWST r w s m a
forall (m :: * -> *) a w r s. Monad m => (a, w) -> RWST r w s m a
StrictRWS.writer
    tell :: w -> RWST r w s m ()
tell   = w -> 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, w)
listen = RWST r w s m a -> RWST r w s m (a, w)
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, w -> w) -> RWST r w s m a
pass   = RWST r w s m (a, w -> w) -> 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
--
-- All of these instances need UndecidableInstances,
-- because they do not satisfy the coverage condition.

instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
    writer :: (a, w) -> ErrorT e m a
writer = m a -> ErrorT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ErrorT e m a) -> ((a, w) -> m a) -> (a, w) -> ErrorT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
    tell :: w -> 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 ()) -> (w -> m ()) -> w -> ErrorT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: ErrorT e m a -> ErrorT e m (a, w)
listen = Listen w m (Either e a) -> ErrorT e m a -> ErrorT e m (a, w)
forall (m :: * -> *) w e a.
Monad m =>
Listen w m (Either e a) -> Listen w (ErrorT e m) a
Error.liftListen Listen w m (Either e a)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: ErrorT e m (a, w -> w) -> ErrorT e m a
pass   = Pass w m (Either e a) -> ErrorT e m (a, w -> w) -> 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 w m (Either e a)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

-- | @since 2.2
instance MonadWriter w m => MonadWriter w (ExceptT e m) where
    writer :: (a, w) -> ExceptT e m a
writer = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a)
-> ((a, w) -> m a) -> (a, w) -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
    tell :: w -> ExceptT e m ()
tell   = m () -> ExceptT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> (w -> m ()) -> w -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: ExceptT e m a -> ExceptT e m (a, w)
listen = Listen w m (Either e a) -> ExceptT e m a -> ExceptT e m (a, w)
forall (m :: * -> *) w e a.
Monad m =>
Listen w m (Either e a) -> Listen w (ExceptT e m) a
Except.liftListen Listen w m (Either e a)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: ExceptT e m (a, w -> w) -> ExceptT e m a
pass   = Pass w m (Either e a) -> ExceptT e m (a, w -> w) -> ExceptT e m a
forall (m :: * -> *) w e a.
Monad m =>
Pass w m (Either e a) -> Pass w (ExceptT e m) a
Except.liftPass Pass w m (Either e a)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

instance MonadWriter w m => MonadWriter w (IdentityT m) where
    writer :: (a, w) -> IdentityT m a
writer = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> ((a, w) -> m a) -> (a, w) -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
    tell :: w -> IdentityT m ()
tell   = m () -> IdentityT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> IdentityT m ()) -> (w -> m ()) -> w -> IdentityT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: IdentityT m a -> IdentityT m (a, w)
listen = (m a -> m (a, w)) -> IdentityT m a -> IdentityT m (a, w)
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, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: IdentityT m (a, w -> w) -> IdentityT m a
pass   = (m (a, w -> w) -> m a) -> IdentityT m (a, w -> w) -> 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, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

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

instance MonadWriter w m => MonadWriter w (ReaderT r m) where
    writer :: (a, w) -> ReaderT r m a
writer = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> ((a, w) -> m a) -> (a, w) -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
    tell :: w -> 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 ()) -> (w -> m ()) -> w -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: ReaderT r m a -> ReaderT r m (a, w)
listen = (m a -> m (a, w)) -> ReaderT r m a -> ReaderT r m (a, w)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: ReaderT r m (a, w -> w) -> ReaderT r m a
pass   = (m (a, w -> w) -> m a) -> ReaderT r m (a, w -> w) -> 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, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

instance MonadWriter w m => MonadWriter w (Lazy.StateT s m) where
    writer :: (a, w) -> StateT s m a
writer = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> ((a, w) -> m a) -> (a, w) -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
    tell :: w -> 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 ()) -> (w -> m ()) -> w -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: StateT s m a -> StateT s m (a, w)
listen = Listen w m (a, s) -> StateT s m a -> StateT s m (a, w)
forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
Lazy.liftListen Listen w m (a, s)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: StateT s m (a, w -> w) -> StateT s m a
pass   = Pass w m (a, s) -> StateT s m (a, w -> w) -> 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 w m (a, s)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

instance MonadWriter w m => MonadWriter w (Strict.StateT s m) where
    writer :: (a, w) -> StateT s m a
writer = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> ((a, w) -> m a) -> (a, w) -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
    tell :: w -> 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 ()) -> (w -> m ()) -> w -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: StateT s m a -> StateT s m (a, w)
listen = Listen w m (a, s) -> StateT s m a -> StateT s m (a, w)
forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
Strict.liftListen Listen w m (a, s)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: StateT s m (a, w -> w) -> StateT s m a
pass   = Pass w m (a, s) -> StateT s m (a, w -> w) -> 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 w m (a, s)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass