eb3f65c310c500a2031e117b9265b5067903f3eb
[packages/random.git] / Control / Monad / Cont.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Control.Monad.Cont
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- Continuation monads.
12 --
13 -----------------------------------------------------------------------------
14
15 module Control.Monad.Cont (
16 MonadCont(..),
17 Cont(..),
18 runCont,
19 mapCont,
20 withCont,
21 ContT(..),
22 runContT,
23 mapContT,
24 withContT,
25 module Control.Monad,
26 module Control.Monad.Trans,
27 ) where
28
29 import Prelude
30
31 import Control.Monad
32 import Control.Monad.Trans
33 import Control.Monad.Reader
34 import Control.Monad.Writer
35 import Control.Monad.State
36 import Control.Monad.RWS
37
38 class (Monad m) => MonadCont m where
39 callCC :: ((a -> m b) -> m a) -> m a
40
41 -- ---------------------------------------------------------------------------
42 -- Our parameterizable continuation monad
43
44 newtype Cont r a = Cont { runCont :: (a -> r) -> r }
45
46 instance Functor (Cont r) where
47 fmap f m = Cont $ \c -> runCont m (c . f)
48
49 instance Monad (Cont r) where
50 return a = Cont ($ a)
51 m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c
52
53 instance MonadCont (Cont r) where
54 callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \_ -> c a)) c
55
56 mapCont :: (r -> r) -> Cont r a -> Cont r a
57 mapCont f m = Cont $ f . runCont m
58
59 withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
60 withCont f m = Cont $ runCont m . f
61
62 -- ---------------------------------------------------------------------------
63 -- Our parameterizable continuation monad, with an inner monad
64
65 newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
66
67 instance (Monad m) => Functor (ContT r m) where
68 fmap f m = ContT $ \c -> runContT m (c . f)
69
70 instance (Monad m) => Monad (ContT r m) where
71 return a = ContT ($ a)
72 m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c)
73
74 instance (Monad m) => MonadCont (ContT r m) where
75 callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c
76
77 instance MonadTrans (ContT r) where
78 lift m = ContT (m >>=)
79
80 instance (MonadIO m) => MonadIO (ContT r m) where
81 liftIO = lift . liftIO
82
83 instance (MonadReader r' m) => MonadReader r' (ContT r m) where
84 ask = lift ask
85 local f m = ContT $ \c -> do
86 r <- ask
87 local f (runContT m (local (const r) . c))
88
89 instance (MonadState s m) => MonadState s (ContT r m) where
90 get = lift get
91 put = lift . put
92
93 -- -----------------------------------------------------------------------------
94 -- MonadCont instances for other monad transformers
95
96 instance (MonadCont m) => MonadCont (ReaderT r m) where
97 callCC f = ReaderT $ \r ->
98 callCC $ \c ->
99 runReaderT (f (\a -> ReaderT $ \_ -> c a)) r
100
101 instance (MonadCont m) => MonadCont (StateT s m) where
102 callCC f = StateT $ \s ->
103 callCC $ \c ->
104 runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s
105
106 instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where
107 callCC f = WriterT $
108 callCC $ \c ->
109 runWriterT (f (\a -> WriterT $ c (a, mempty)))
110
111 instance (Monoid w, MonadCont m) => MonadCont (RWST r w s m) where
112 callCC f = RWST $ \r s ->
113 callCC $ \c ->
114 runRWST (f (\a -> RWST $ \_ s' -> c (a, s', mempty))) r s
115
116 mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
117 mapContT f m = ContT $ f . runContT m
118
119 withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
120 withContT f m = ContT $ runContT m . f