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