1 -----------------------------------------------------------------------------
3 -- Module : Control.Monad.RWS
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 ( mulit-param classes, functional dependencies )
12 -- Declaration of the MonadRWS class.
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.RWS (
32 module Control.Monad.Reader,
33 module Control.Monad.Writer,
34 module Control.Monad.State,
40 import Control.Monad.Monoid
41 import Control.Monad.Fix
42 import Control.Monad.Trans
43 import Control.Monad.Reader
44 import Control.Monad.Writer
45 import Control.Monad.State
48 newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) }
50 instance Functor (RWS r w s) where
51 fmap f m = RWS $ \r s -> let
52 (a, s', w) = runRWS m r s
55 instance (Monoid w) => Monad (RWS r w s) where
56 return a = RWS $ \_ s -> (a, s, mempty)
57 m >>= k = RWS $ \r s -> let
58 (a, s', w) = runRWS m r s
59 (b, s'', w') = runRWS (k a) r s'
60 in (b, s'', w `mappend` w')
62 instance (Monoid w) => MonadFix (RWS r w s) where
63 mfix f = RWS $ \r s -> let (a, s', w) = runRWS (f a) r s in (a, s', w)
65 instance (Monoid w) => MonadReader r (RWS r w s) where
66 ask = RWS $ \r s -> (r, s, mempty)
67 local f m = RWS $ \r s -> runRWS m (f r) s
69 instance (Monoid w) => MonadWriter w (RWS r w s) where
70 tell w = RWS $ \_ s -> ((), s, w)
71 listen m = RWS $ \r s -> let
72 (a, s', w) = runRWS m r s
74 pass m = RWS $ \r s -> let
75 ((a, f), s', w) = runRWS m r s
78 instance (Monoid w) => MonadState s (RWS r w s) where
79 get = RWS $ \_ s -> (s, s, mempty)
80 put s = RWS $ \_ _ -> ((), s, mempty)
83 evalRWS :: RWS r w s a -> r -> s -> (a, w)
85 (a, _, w) = runRWS m r s
88 execRWS :: RWS r w s a -> r -> s -> (s, w)
90 (_, s', w) = runRWS m r s
93 mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b
94 mapRWS f m = RWS $ \r s -> f (runRWS m r s)
96 withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
97 withRWS f m = RWS $ \r s -> uncurry (runRWS m) (f r s)
100 newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
102 instance (Monad m) => Functor (RWST r w s m) where
103 fmap f m = RWST $ \r s -> do
104 (a, s', w) <- runRWST m r s
107 instance (Monoid w, Monad m) => Monad (RWST r w s m) where
108 return a = RWST $ \_ s -> return (a, s, mempty)
109 m >>= k = RWST $ \r s -> do
110 (a, s', w) <- runRWST m r s
111 (b, s'',w') <- runRWST (k a) r s'
112 return (b, s'', w `mappend` w')
113 fail msg = RWST $ \_ _ -> fail msg
115 instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where
116 mzero = RWST $ \_ _ -> mzero
117 m `mplus` n = RWST $ \r s -> runRWST m r s `mplus` runRWST n r s
119 instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where
120 mfix f = RWST $ \r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s
122 instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where
123 ask = RWST $ \r s -> return (r, s, mempty)
124 local f m = RWST $ \r s -> runRWST m (f r) s
126 instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where
127 tell w = RWST $ \_ s -> return ((),s,w)
128 listen m = RWST $ \r s -> do
129 (a, s', w) <- runRWST m r s
130 return ((a, w), s', w)
131 pass m = RWST $ \r s -> do
132 ((a, f), s', w) <- runRWST m r s
135 instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where
136 get = RWST $ \_ s -> return (s, s, mempty)
137 put s = RWST $ \_ _ -> return ((), s, mempty)
139 instance (Monoid w) => MonadTrans (RWST r w s) where
140 lift m = RWST $ \_ s -> do
142 return (a, s, mempty)
144 instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
145 liftIO = lift . liftIO
148 evalRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (a, w)
150 (a, _, w) <- runRWST m r s
153 execRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (s, w)
155 (_, s', w) <- runRWST m r s
158 mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
159 mapRWST f m = RWST $ \r s -> f (runRWST m r s)
161 withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
162 withRWST f m = RWST $ \r s -> uncurry (runRWST m) (f r s)