1 -----------------------------------------------------------------------------
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/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : non-portable (multi-param classes, functional dependencies)
12 -- The implementation of the writer transformer.
14 -- Inspired by the paper
15 -- /Functional Programming with Overloading and
16 -- Higher-Order Polymorphism/,
17 -- Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
18 -- Advanced School of Functional Programming, 1995.
19 -----------------------------------------------------------------------------
21 module Control.Monad.X.WriterT (
31 import Prelude(Functor(..),Monad(..),fst,snd,(.))
32 import Control.Monad(liftM,MonadPlus(..))
34 import Data.Monoid as Monoid (Monoid(..))
36 import Control.Monad.X.Trans as T
37 import Control.Monad.X.Utils
38 import Control.Monad.X.Types(WriterT(..))
41 instance (Monoid w) => MonadTrans (WriterT w) where
42 lift m = W (liftM (\a -> (a,mempty)) m)
44 instance (Monoid w, HasBaseMonad m n) => HasBaseMonad (WriterT w m) n where
47 instance (Monoid w, Monad m) => Functor (WriterT w m) where
50 instance (Monoid w, Monad m) => Monad (WriterT w m) where
52 m >>= f = W (do (a, w) <- unW m
54 return (b, w `mappend` w'))
58 runWriter :: WriterT w m a -> m (a,w)
61 runWriterT :: WriterT w m a -> m (a,w)
64 execWriterT :: Monad m => WriterT w m a -> m w
65 execWriterT m = liftM snd (unW m)
67 mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
68 mapWriterT f m = W (f (unW m))
71 instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where
73 local = local' mapWriterT
75 -- different from before, listen produces no output
76 instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where
77 tell w = W (return ((), w))
78 listen = mapWriterT (liftM (\(a,w) -> ((a,w),mempty)))
80 instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where
84 instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
85 throwError = throwError'
86 catchError = catchError1' W unW
88 instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where
92 -- 'findAll' does not produce output
93 -- if interested in the output use 'listen' before calling 'findAll'.
94 instance (Monoid w, MonadNondet m) => MonadNondet (WriterT w m) where
95 findAll = mapWriterT (liftM (\xs -> (fmap fst xs, mempty)) . findAll)
96 commit = mapWriterT commit
98 instance (Monoid w, MonadResume m) => MonadResume (WriterT w m) where
99 delay = mapWriterT delay
100 force = mapWriterT force
102 -- jumping undoes the output
103 instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where
104 callCC = callCC1' W unW (\a -> (a,mempty))