Control/Monad/Writer.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Monad.Writer
   4 -- Copyright   :  (c) Andy Gill 2001,
   5 --                (c) Oregon Graduate Institute of Science and Technology, 2001
   6 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable ( requires mulit-parameter type classes,
  11 --                               requires functional dependencies )
  12 --
  13 -- The MonadWriter class.
  14 --
  15 --        Inspired by the paper
  16 --        \em{Functional Programming with Overloading and
  17 --            Higher-Order Polymorphism},
  18 --          \A[HREF="http://www.cse.ogi.edu/~mpj"]{Mark P Jones},
  19 --                Advanced School of Functional Programming, 1995.}
  20 -----------------------------------------------------------------------------
  21
  22 module Control.Monad.Writer (
  23         MonadWriter(..),
  24         listens,
  25         censor,
  26         Writer(..),
  27         runWriter,
  28         execWriter,
  29         mapWriter,
  30         WriterT(..),
  31         runWriterT,
  32         execWriterT,
  33         mapWriterT,
  34         module Control.Monad,
  35         module Control.Monad.Monoid,
  36         module Control.Monad.Fix,
  37         module Control.Monad.Trans,
  38   ) where
  39
  40 import Prelude
  41
  42 import Control.Monad
  43 import Control.Monad.Monoid
  44 import Control.Monad.Fix
  45 import Control.Monad.Trans
  46 import Control.Monad.Reader
  47
  48 -- ---------------------------------------------------------------------------
  49 -- MonadWriter class
  50 --
  51 -- tell is like tell on the MUD's it shouts to monad
  52 -- what you want to be heard. The monad carries this 'packet'
  53 -- upwards, merging it if needed (hence the Monoid requirement)}
  54 --
  55 -- listen listens to a monad acting, and returns what the monad "said".
  56 --
  57 -- pass lets you provide a writer transformer which changes internals of
  58 -- the written object.
  59
  60 class (Monoid w, Monad m) => MonadWriter w m | m -> w where
  61         tell   :: w -> m ()
  62         listen :: m a -> m (a, w)
  63         pass   :: m (a, w -> w) -> m a
  64
  65 listens :: (MonadWriter w m) => (w -> w) -> m a -> m (a, w)
  66 listens f m = do
  67         (a, w) <- listen m
  68         return (a, f w)
  69
  70 censor :: (MonadWriter w m) => (w -> w) -> m a -> m a
  71 censor f m = pass $ do
  72         a <- m
  73         return (a, f)
  74
  75 -- ---------------------------------------------------------------------------
  76 -- Our parameterizable writer monad
  77
  78 newtype Writer w a = Writer { runWriter :: (a, w) }
  79
  80
  81 instance Functor (Writer w) where
  82         fmap f m = Writer $ let (a, w) = runWriter m in (f a, w)
  83
  84 instance (Monoid w) => Monad (Writer w) where
  85         return a = Writer (a, mempty)
  86         m >>= k  = Writer $ let
  87                 (a, w)  = runWriter m
  88                 (b, w') = runWriter (k a)
  89                 in (b, w `mappend` w')
  90
  91 instance (Monoid w) => MonadFix (Writer w) where
  92         mfix m = Writer $ let (a, w) = runWriter (m a) in (a, w)
  93
  94 instance (Monoid w) => MonadWriter w (Writer w) where
  95         tell   w = Writer ((), w)
  96         listen m = Writer $ let (a, w) = runWriter m in ((a, w), w)
  97         pass   m = Writer $ let ((a, f), w) = runWriter m in (a, f w)
  98
  99
 100 execWriter :: Writer w a -> w
 101 execWriter m = snd (runWriter m)
 102
 103 mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
 104 mapWriter f m = Writer $ f (runWriter m)
 105
 106 -- ---------------------------------------------------------------------------
 107 -- Our parameterizable writer monad, with an inner monad
 108
 109 newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
 110
 111
 112 instance (Monad m) => Functor (WriterT w m) where
 113         fmap f m = WriterT $ do
 114                 (a, w) <- runWriterT m
 115                 return (f a, w)
 116
 117 instance (Monoid w, Monad m) => Monad (WriterT w m) where
 118         return a = WriterT $ return (a, mempty)
 119         m >>= k  = WriterT $ do
 120                 (a, w)  <- runWriterT m
 121                 (b, w') <- runWriterT (k a)
 122                 return (b, w `mappend` w')
 123         fail msg = WriterT $ fail msg
 124
 125 instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where
 126         mzero       = WriterT mzero
 127         m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n
 128
 129 instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where
 130         mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a)
 131
 132 instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where
 133         tell   w = WriterT $ return ((), w)
 134         listen m = WriterT $ do
 135                 (a, w) <- runWriterT m
 136                 return ((a, w), w)
 137         pass   m = WriterT $ do
 138                 ((a, f), w) <- runWriterT m
 139                 return (a, f w)
 140
 141 instance (Monoid w) => MonadTrans (WriterT w) where
 142         lift m = WriterT $ do
 143                 a <- m
 144                 return (a, mempty)
 145
 146 instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
 147         liftIO = lift . liftIO
 148
 149 instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where
 150         ask       = lift ask
 151         local f m = WriterT $ local f (runWriterT m)
 152
 153
 154 execWriterT :: Monad m => WriterT w m a -> m w
 155 execWriterT m = do
 156         (_, w) <- runWriterT m
 157         return w
 158
 159 mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
 160 mapWriterT f m = WriterT $ f (runWriterT m)
 161
 162 -- ---------------------------------------------------------------------------
 163 -- MonadWriter instances for other monad transformers
 164
 165 instance (MonadWriter w m) => MonadWriter w (ReaderT r m) where
 166         tell     = lift . tell
 167         listen m = ReaderT $ \w -> listen (runReaderT m w)
 168         pass   m = ReaderT $ \w -> pass   (runReaderT m w)