[project @ 2002-04-24 16:31:37 by simonmar]
[packages/base.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 -- $Id: Cont.hs,v 1.2 2002/04/24 16:31:38 simonmar Exp $
12 --
13 -- Continuation monads.
14 --
15 -----------------------------------------------------------------------------
16
17 module Control.Monad.Cont (
18 MonadCont(..),
19 Cont(..),
20 runCont,
21 mapCont,
22 withCont,
23 ContT(..),
24 runContT,
25 mapContT,
26 withContT,
27 module Control.Monad,
28 module Control.Monad.Trans,
29 ) where
30
31 import Prelude
32
33 import Control.Monad
34 import Control.Monad.Trans
35 import Control.Monad.Reader
36 import Control.Monad.Writer
37 import Control.Monad.State
38 import Control.Monad.RWS
39
40 class (Monad m) => MonadCont m where
41 callCC :: ((a -> m b) -> m a) -> m a
42
43 -- ---------------------------------------------------------------------------
44 -- Our parameterizable continuation monad
45
46 newtype Cont r a = Cont { runCont :: (a -> r) -> r }
47
48 instance Functor (Cont r) where
49 fmap f m = Cont $ \c -> runCont m (c . f)
50
51 instance Monad (Cont r) where
52 return a = Cont ($ a)
53 m >>= k = Cont $ \c -> runCont m $ \a -> runCont (k a) c
54
55 instance MonadCont (Cont r) where
56 callCC f = Cont $ \c -> runCont (f (\a -> Cont $ \_ -> c a)) c
57
58 mapCont :: (r -> r) -> Cont r a -> Cont r a
59 mapCont f m = Cont $ f . runCont m
60
61 withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
62 withCont f m = Cont $ runCont m . f
63
64 -- ---------------------------------------------------------------------------
65 -- Our parameterizable continuation monad, with an inner monad
66
67 newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
68
69 instance (Monad m) => Functor (ContT r m) where
70 fmap f m = ContT $ \c -> runContT m (c . f)
71
72 instance (Monad m) => Monad (ContT r m) where
73 return a = ContT ($ a)
74 m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c)
75
76 instance (Monad m) => MonadCont (ContT r m) where
77 callCC f = ContT $ \c -> runContT (f (\a -> ContT $ \_ -> c a)) c
78
79 instance MonadTrans (ContT r) where
80 lift m = ContT (m >>=)
81
82 instance (MonadIO m) => MonadIO (ContT r m) where
83 liftIO = lift . liftIO
84
85 instance (MonadReader r' m) => MonadReader r' (ContT r m) where
86 ask = lift ask
87 local f m = ContT $ \c -> do
88 r <- ask
89 local f (runContT m (local (const r) . c))
90
91 instance (MonadState s m) => MonadState s (ContT r m) where
92 get = lift get
93 put = lift . put
94
95 -- -----------------------------------------------------------------------------
96 -- MonadCont instances for other monad transformers
97
98 instance (MonadCont m) => MonadCont (ReaderT r m) where
99 callCC f = ReaderT $ \r ->
100 callCC $ \c ->
101 runReaderT (f (\a -> ReaderT $ \_ -> c a)) r
102
103 instance (MonadCont m) => MonadCont (StateT s m) where
104 callCC f = StateT $ \s ->
105 callCC $ \c ->
106 runStateT (f (\a -> StateT $ \s' -> c (a, s'))) s
107
108 instance (Monoid w, MonadCont m) => MonadCont (WriterT w m) where
109 callCC f = WriterT $
110 callCC $ \c ->
111 runWriterT (f (\a -> WriterT $ c (a, mempty)))
112
113 instance (Monoid w, MonadCont m) => MonadCont (RWST r w s m) where
114 callCC f = RWST $ \r s ->
115 callCC $ \c ->
116 runRWST (f (\a -> RWST $ \_ s' -> c (a, s', mempty))) r s
117
118 mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
119 mapContT f m = ContT $ f . runContT m
120
121 withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
122 withContT f m = ContT $ runContT m . f