Define custom (*>) for various transformers to fix space leaks (fixes #33)
[darcs-mirrors/transformers.git] / Control / Monad / Trans / Cont.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 702
3 {-# LANGUAGE Safe #-}
4 #endif
5 #if __GLASGOW_HASKELL__ >= 706
6 {-# LANGUAGE PolyKinds #-}
7 #endif
8 #if __GLASGOW_HASKELL__ >= 710
9 {-# LANGUAGE AutoDeriveTypeable #-}
10 #endif
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : Control.Monad.Trans.Cont
14 -- Copyright : (c) The University of Glasgow 2001
15 -- License : BSD-style (see the file LICENSE)
16 --
17 -- Maintainer : R.Paterson@city.ac.uk
18 -- Stability : experimental
19 -- Portability : portable
20 --
21 -- Continuation monads.
22 --
23 -- Delimited continuation operators are taken from Kenichi Asai and Oleg
24 -- Kiselyov's tutorial at CW 2011, \"Introduction to programming with
25 -- shift and reset\" (<http://okmij.org/ftp/continuations/#tutorial>).
26 --
27 -----------------------------------------------------------------------------
28
29 module Control.Monad.Trans.Cont (
30 -- * The Cont monad
31 Cont,
32 cont,
33 runCont,
34 evalCont,
35 mapCont,
36 withCont,
37 -- ** Delimited continuations
38 reset, shift,
39 -- * The ContT monad transformer
40 ContT(..),
41 evalContT,
42 mapContT,
43 withContT,
44 callCC,
45 -- ** Delimited continuations
46 resetT, shiftT,
47 -- * Lifting other operations
48 liftLocal,
49 ) where
50
51 import Control.Monad.IO.Class
52 import Control.Monad.Trans.Class
53 import Data.Functor.Identity
54
55 import Control.Applicative
56 #if MIN_VERSION_base(4,9,0)
57 import qualified Control.Monad.Fail as Fail
58 #endif
59
60 {- |
61 Continuation monad.
62 @Cont r a@ is a CPS ("continuation-passing style") computation that produces an
63 intermediate result of type @a@ within a CPS computation whose final result type
64 is @r@.
65
66 The @return@ function simply creates a continuation which passes the value on.
67
68 The @>>=@ operator adds the bound function into the continuation chain.
69 -}
70 type Cont r = ContT r Identity
71
72 -- | Construct a continuation-passing computation from a function.
73 -- (The inverse of 'runCont')
74 cont :: ((a -> r) -> r) -> Cont r a
75 cont f = ContT (\ c -> Identity (f (runIdentity . c)))
76 {-# INLINE cont #-}
77
78 -- | The result of running a CPS computation with a given final continuation.
79 -- (The inverse of 'cont')
80 runCont
81 :: Cont r a -- ^ continuation computation (@Cont@).
82 -> (a -> r) -- ^ the final continuation, which produces
83 -- the final result (often 'id').
84 -> r
85 runCont m k = runIdentity (runContT m (Identity . k))
86 {-# INLINE runCont #-}
87
88 -- | The result of running a CPS computation with the identity as the
89 -- final continuation.
90 --
91 -- * @'evalCont' ('return' x) = x@
92 evalCont :: Cont r r -> r
93 evalCont m = runIdentity (evalContT m)
94 {-# INLINE evalCont #-}
95
96 -- | Apply a function to transform the result of a continuation-passing
97 -- computation.
98 --
99 -- * @'runCont' ('mapCont' f m) = f . 'runCont' m@
100 mapCont :: (r -> r) -> Cont r a -> Cont r a
101 mapCont f = mapContT (Identity . f . runIdentity)
102 {-# INLINE mapCont #-}
103
104 -- | Apply a function to transform the continuation passed to a CPS
105 -- computation.
106 --
107 -- * @'runCont' ('withCont' f m) = 'runCont' m . f@
108 withCont :: ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
109 withCont f = withContT ((Identity .) . f . (runIdentity .))
110 {-# INLINE withCont #-}
111
112 -- | @'reset' m@ delimits the continuation of any 'shift' inside @m@.
113 --
114 -- * @'reset' ('return' m) = 'return' m@
115 --
116 reset :: Cont r r -> Cont r' r
117 reset = resetT
118 {-# INLINE reset #-}
119
120 -- | @'shift' f@ captures the continuation up to the nearest enclosing
121 -- 'reset' and passes it to @f@:
122 --
123 -- * @'reset' ('shift' f >>= k) = 'reset' (f ('evalCont' . k))@
124 --
125 shift :: ((a -> r) -> Cont r r) -> Cont r a
126 shift f = shiftT (f . (runIdentity .))
127 {-# INLINE shift #-}
128
129 -- | The continuation monad transformer.
130 -- Can be used to add continuation handling to any type constructor:
131 -- the 'Monad' instance and most of the operations do not require @m@
132 -- to be a monad.
133 --
134 -- 'ContT' is not a functor on the category of monads, and many operations
135 -- cannot be lifted through it.
136 newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
137
138 -- | The result of running a CPS computation with 'return' as the
139 -- final continuation.
140 --
141 -- * @'evalContT' ('lift' m) = m@
142 evalContT :: (Monad m) => ContT r m r -> m r
143 evalContT m = runContT m return
144 {-# INLINE evalContT #-}
145
146 -- | Apply a function to transform the result of a continuation-passing
147 -- computation. This has a more restricted type than the @map@ operations
148 -- for other monad transformers, because 'ContT' does not define a functor
149 -- in the category of monads.
150 --
151 -- * @'runContT' ('mapContT' f m) = f . 'runContT' m@
152 mapContT :: (m r -> m r) -> ContT r m a -> ContT r m a
153 mapContT f m = ContT $ f . runContT m
154 {-# INLINE mapContT #-}
155
156 -- | Apply a function to transform the continuation passed to a CPS
157 -- computation.
158 --
159 -- * @'runContT' ('withContT' f m) = 'runContT' m . f@
160 withContT :: ((b -> m r) -> (a -> m r)) -> ContT r m a -> ContT r m b
161 withContT f m = ContT $ runContT m . f
162 {-# INLINE withContT #-}
163
164 instance Functor (ContT r m) where
165 fmap f m = ContT $ \ c -> runContT m (c . f)
166 {-# INLINE fmap #-}
167
168 instance Applicative (ContT r m) where
169 pure x = ContT ($ x)
170 {-# INLINE pure #-}
171 f <*> v = ContT $ \ c -> runContT f $ \ g -> runContT v (c . g)
172 {-# INLINE (<*>) #-}
173 m *> k = m >>= \_ -> k
174 {-# INLINE (*>) #-}
175
176 instance Monad (ContT r m) where
177 #if !(MIN_VERSION_base(4,8,0))
178 return x = ContT ($ x)
179 {-# INLINE return #-}
180 #endif
181 m >>= k = ContT $ \ c -> runContT m (\ x -> runContT (k x) c)
182 {-# INLINE (>>=) #-}
183
184 #if MIN_VERSION_base(4,9,0)
185 instance (Fail.MonadFail m) => Fail.MonadFail (ContT r m) where
186 fail msg = ContT $ \ _ -> Fail.fail msg
187 {-# INLINE fail #-}
188 #endif
189
190 instance MonadTrans (ContT r) where
191 lift m = ContT (m >>=)
192 {-# INLINE lift #-}
193
194 instance (MonadIO m) => MonadIO (ContT r m) where
195 liftIO = lift . liftIO
196 {-# INLINE liftIO #-}
197
198 -- | @callCC@ (call-with-current-continuation) calls its argument
199 -- function, passing it the current continuation. It provides
200 -- an escape continuation mechanism for use with continuation
201 -- monads. Escape continuations one allow to abort the current
202 -- computation and return a value immediately. They achieve
203 -- a similar effect to 'Control.Monad.Trans.Except.throwE'
204 -- and 'Control.Monad.Trans.Except.catchE' within an
205 -- 'Control.Monad.Trans.Except.ExceptT' monad. The advantage of this
206 -- function over calling 'return' is that it makes the continuation
207 -- explicit, allowing more flexibility and better control.
208 --
209 -- The standard idiom used with @callCC@ is to provide a lambda-expression
210 -- to name the continuation. Then calling the named continuation anywhere
211 -- within its scope will escape from the computation, even if it is many
212 -- layers deep within nested computations.
213 callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a
214 callCC f = ContT $ \ c -> runContT (f (\ x -> ContT $ \ _ -> c x)) c
215 {-# INLINE callCC #-}
216
217 -- | @'resetT' m@ delimits the continuation of any 'shiftT' inside @m@.
218 --
219 -- * @'resetT' ('lift' m) = 'lift' m@
220 --
221 resetT :: (Monad m) => ContT r m r -> ContT r' m r
222 resetT = lift . evalContT
223 {-# INLINE resetT #-}
224
225 -- | @'shiftT' f@ captures the continuation up to the nearest enclosing
226 -- 'resetT' and passes it to @f@:
227 --
228 -- * @'resetT' ('shiftT' f >>= k) = 'resetT' (f ('evalContT' . k))@
229 --
230 shiftT :: (Monad m) => ((a -> m r) -> ContT r m r) -> ContT r m a
231 shiftT f = ContT (evalContT . f)
232 {-# INLINE shiftT #-}
233
234 -- | @'liftLocal' ask local@ yields a @local@ function for @'ContT' r m@.
235 liftLocal :: (Monad m) => m r' -> ((r' -> r') -> m r -> m r) ->
236 (r' -> r') -> ContT r m a -> ContT r m a
237 liftLocal ask local f m = ContT $ \ c -> do
238 r <- ask
239 local f (runContT m (local (const r) . c))
240 {-# INLINE liftLocal #-}