1 implementation module RWST
5 from Data.Func import $
7 import Data.Functor.Identity
11 import Control.Applicative
14 // The RWST monad transformer
15 :: RWST r w s m a = RWST (r s -> m (a, s, w))
17 instance Functor (RWST r w s m) | Monad m & Monoid w where
20 instance Applicative (RWST r w s m) | Monad m & Monoid w where
21 pure a = RWST \_ s->pure (a, s, mempty)
22 (<*>) mf mx = ap mf mx
24 instance Monad (RWST r w s m) | Monad m & Monoid w where
25 bind m k = RWST \r s->runRWST m r s
26 >>= \(a, s`, w)->runRWST (k a) r s`
27 >>= \(b, s``,w`)->pure (b, s``, mappend w w`)
29 runRWST :: (RWST r w s m a) r s -> m (a, s, w)
30 runRWST (RWST f) r s = f r s
32 evalRWST :: (RWST r w s m a) r s -> m (a, w) | Monad m
33 evalRWST m r s = runRWST m r s >>= \(a, _, w)->pure (a, w)
35 execRWST :: (RWST r w s m a) r s -> m (s, w) | Monad m
36 execRWST m r s = runRWST m r s >>= \(_, s`, w)->pure (s, w)
38 mapRWST :: ((m (a, s, w)) -> n (b, s, w`)) (RWST r w s m a) -> RWST r w` s n b
39 mapRWST f m = RWST \r s->f $ runRWST m r s
41 withRWST :: (r` -> s -> (r, s)) (RWST r w s m a) -> RWST r` w s m a
42 withRWST f m = RWST \r s->uncurry (runRWST m) $ f r s
45 ask :: RWST r w s m r | Monoid w & Monad m
46 ask = RWST \r s->pure (r, s, mempty)
48 local :: (r -> r) (RWST r w s m a) -> RWST r w s m a | Monoid w & Monad m
49 local f m = RWST \r s->runRWST m (f r) s
51 asks :: (r -> a) -> RWST r w s m a | Monoid w & Monad m
52 asks f = ask >>= \r->pure $ f r
55 tell :: w -> RWST r w s m Void | Monoid w & Monad m
56 tell w = RWST \_ s->pure (Void, s,w)
58 listen :: (RWST r w s m a) -> RWST r w s m (a, w) | Monoid w & Monad m
59 listen m = RWST \r s->runRWST m r s >>= \(a, s`, w)->pure ((a, w), s`, w)
61 pass :: (RWST r w s m (a, w -> w)) -> RWST r w s m a | Monoid w & Monad m
62 pass m = RWST \r s->runRWST m r s >>= \((a, f), s`, w)->pure (a, s`, f w)
64 listens :: (w -> b) (RWST r w s m a) -> RWST r w s m (a, b)| Monoid w & Monad m
65 listens f m = listen m >>= \(a, w)->pure (a, f w)
67 censor :: (w -> w) (RWST r w s m a) -> RWST r w s m a | Monoid w & Monad m
68 censor f m = pass $ m >>= \a->pure (a, f)
71 get :: RWST r w s m s | Monoid w & Monad m
72 get = RWST \_ s->pure (s, s, mempty)
74 put :: s -> RWST r w s m Void | Monoid w & Monad m
75 put s = RWST \_ _->pure (Void, s, mempty)
77 modify :: (s -> s) -> RWST r w s m Void | Monoid w & Monad m
78 modify f = get >>= \s->put $ f s
80 gets :: (s -> a) -> RWST r w s m a | Monoid w & Monad m
81 gets f = get >>= \s->pure $ f s
83 // Lifting other operations
84 liftCallCC :: ((((a,s,w) -> m (b,s,w)) -> m (a,s,w)) -> m (a,s,w)) ((a -> RWST r w s m b) -> RWST r w s m a) -> RWST r w s m a | Monoid w
85 liftCallCC callCC f = RWST \r s->callCC
86 \c->runRWST (f $ \a->RWST \_ _->c (a, s, mempty)) r s
88 liftCallCC` :: ((((a,s,w) -> m (b,s,w)) -> m (a,s,w)) -> m (a,s,w)) ((a -> RWST r w s m b) -> RWST r w s m a) -> RWST r w s m a | Monoid w
89 liftCallCC` callCC f = RWST \r s->callCC
90 \c->runRWST (f $ \a->RWST \_ s`->c (a, s`, mempty)) r s
92 liftCatch :: ((m (a,s,w)) (e -> m (a,s,w)) -> m (a,s,w)) (RWST l w s m a) (e -> RWST l w s m a) -> RWST l w s m a
93 liftCatch catchError m h = RWST \r s->catchError
94 (runRWST m r s) (\e->runRWST (h e) r s)