34b792e9de0beaa56cdba826f8093531f5d72042
[darcs-mirrors/transformers.git] / Control / Monad / Trans / State / Lazy.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 702
3 {-# LANGUAGE Safe #-}
4 #endif
5 #if __GLASGOW_HASKELL__ >= 710
6 {-# LANGUAGE AutoDeriveTypeable #-}
7 #endif
8 -----------------------------------------------------------------------------
9 -- |
10 -- Module : Control.Monad.Trans.State.Lazy
11 -- Copyright : (c) Andy Gill 2001,
12 -- (c) Oregon Graduate Institute of Science and Technology, 2001
13 -- License : BSD-style (see the file LICENSE)
14 --
15 -- Maintainer : R.Paterson@city.ac.uk
16 -- Stability : experimental
17 -- Portability : portable
18 --
19 -- Lazy state monads, passing an updatable state through a computation.
20 -- See below for examples.
21 --
22 -- Some computations may not require the full power of state transformers:
23 --
24 -- * For a read-only state, see "Control.Monad.Trans.Reader".
25 --
26 -- * To accumulate a value without using it on the way, see
27 -- "Control.Monad.Trans.Writer".
28 --
29 -- In this version, sequencing of computations is lazy, so that for
30 -- example the following produces a usable result:
31 --
32 -- > evalState (sequence $ repeat $ do { n <- get; put (n*2); return n }) 1
33 --
34 -- For a strict version with the same interface, see
35 -- "Control.Monad.Trans.State.Strict".
36 -----------------------------------------------------------------------------
37
38 module Control.Monad.Trans.State.Lazy (
39 -- * The State monad
40 State,
41 state,
42 runState,
43 evalState,
44 execState,
45 mapState,
46 withState,
47 -- * The StateT monad transformer
48 StateT(..),
49 evalStateT,
50 execStateT,
51 mapStateT,
52 withStateT,
53 -- * State operations
54 get,
55 put,
56 modify,
57 modify',
58 gets,
59 -- * Lifting other operations
60 liftCallCC,
61 liftCallCC',
62 liftCatch,
63 liftListen,
64 liftPass,
65 -- * Examples
66 -- ** State monads
67 -- $examples
68
69 -- ** Counting
70 -- $counting
71
72 -- ** Labelling trees
73 -- $labelling
74 ) where
75
76 import Control.Monad.IO.Class
77 import Control.Monad.Signatures
78 import Control.Monad.Trans.Class
79 import Data.Functor.Identity
80
81 import Control.Applicative
82 import Control.Monad
83 import Control.Monad.Fix
84
85 -- ---------------------------------------------------------------------------
86 -- | A state monad parameterized by the type @s@ of the state to carry.
87 --
88 -- The 'return' function leaves the state unchanged, while @>>=@ uses
89 -- the final state of the first computation as the initial state of
90 -- the second.
91 type State s = StateT s Identity
92
93 -- | Construct a state monad computation from a function.
94 -- (The inverse of 'runState'.)
95 state :: (Monad m)
96 => (s -> (a, s)) -- ^pure state transformer
97 -> StateT s m a -- ^equivalent state-passing computation
98 state f = StateT (return . f)
99
100 -- | Unwrap a state monad computation as a function.
101 -- (The inverse of 'state'.)
102 runState :: State s a -- ^state-passing computation to execute
103 -> s -- ^initial state
104 -> (a, s) -- ^return value and final state
105 runState m = runIdentity . runStateT m
106
107 -- | Evaluate a state computation with the given initial state
108 -- and return the final value, discarding the final state.
109 --
110 -- * @'evalState' m s = 'fst' ('runState' m s)@
111 evalState :: State s a -- ^state-passing computation to execute
112 -> s -- ^initial value
113 -> a -- ^return value of the state computation
114 evalState m s = fst (runState m s)
115
116 -- | Evaluate a state computation with the given initial state
117 -- and return the final state, discarding the final value.
118 --
119 -- * @'execState' m s = 'snd' ('runState' m s)@
120 execState :: State s a -- ^state-passing computation to execute
121 -> s -- ^initial value
122 -> s -- ^final state
123 execState m s = snd (runState m s)
124
125 -- | Map both the return value and final state of a computation using
126 -- the given function.
127 --
128 -- * @'runState' ('mapState' f m) = f . 'runState' m@
129 mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
130 mapState f = mapStateT (Identity . f . runIdentity)
131
132 -- | @'withState' f m@ executes action @m@ on a state modified by
133 -- applying @f@.
134 --
135 -- * @'withState' f m = 'modify' f >> m@
136 withState :: (s -> s) -> State s a -> State s a
137 withState = withStateT
138
139 -- ---------------------------------------------------------------------------
140 -- | A state transformer monad parameterized by:
141 --
142 -- * @s@ - The state.
143 --
144 -- * @m@ - The inner monad.
145 --
146 -- The 'return' function leaves the state unchanged, while @>>=@ uses
147 -- the final state of the first computation as the initial state of
148 -- the second.
149 newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
150
151 -- | Evaluate a state computation with the given initial state
152 -- and return the final value, discarding the final state.
153 --
154 -- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@
155 evalStateT :: (Monad m) => StateT s m a -> s -> m a
156 evalStateT m s = do
157 ~(a, _) <- runStateT m s
158 return a
159
160 -- | Evaluate a state computation with the given initial state
161 -- and return the final state, discarding the final value.
162 --
163 -- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@
164 execStateT :: (Monad m) => StateT s m a -> s -> m s
165 execStateT m s = do
166 ~(_, s') <- runStateT m s
167 return s'
168
169 -- | Map both the return value and final state of a computation using
170 -- the given function.
171 --
172 -- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@
173 mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
174 mapStateT f m = StateT $ f . runStateT m
175
176 -- | @'withStateT' f m@ executes action @m@ on a state modified by
177 -- applying @f@.
178 --
179 -- * @'withStateT' f m = 'modify' f >> m@
180 withStateT :: (s -> s) -> StateT s m a -> StateT s m a
181 withStateT f m = StateT $ runStateT m . f
182
183 instance (Functor m) => Functor (StateT s m) where
184 fmap f m = StateT $ \ s ->
185 fmap (\ ~(a, s') -> (f a, s')) $ runStateT m s
186
187 instance (Functor m, Monad m) => Applicative (StateT s m) where
188 pure = return
189 (<*>) = ap
190
191 instance (Functor m, MonadPlus m) => Alternative (StateT s m) where
192 empty = mzero
193 (<|>) = mplus
194
195 instance (Monad m) => Monad (StateT s m) where
196 return a = state $ \ s -> (a, s)
197 m >>= k = StateT $ \ s -> do
198 ~(a, s') <- runStateT m s
199 runStateT (k a) s'
200 fail str = StateT $ \ _ -> fail str
201
202 instance (MonadPlus m) => MonadPlus (StateT s m) where
203 mzero = StateT $ \ _ -> mzero
204 m `mplus` n = StateT $ \ s -> runStateT m s `mplus` runStateT n s
205
206 instance (MonadFix m) => MonadFix (StateT s m) where
207 mfix f = StateT $ \ s -> mfix $ \ ~(a, _) -> runStateT (f a) s
208
209 instance MonadTrans (StateT s) where
210 lift m = StateT $ \ s -> do
211 a <- m
212 return (a, s)
213
214 instance (MonadIO m) => MonadIO (StateT s m) where
215 liftIO = lift . liftIO
216
217 -- | Fetch the current value of the state within the monad.
218 get :: (Monad m) => StateT s m s
219 get = state $ \ s -> (s, s)
220
221 -- | @'put' s@ sets the state within the monad to @s@.
222 put :: (Monad m) => s -> StateT s m ()
223 put s = state $ \ _ -> ((), s)
224
225 -- | @'modify' f@ is an action that updates the state to the result of
226 -- applying @f@ to the current state.
227 --
228 -- * @'modify' f = 'get' >>= ('put' . f)@
229 modify :: (Monad m) => (s -> s) -> StateT s m ()
230 modify f = state $ \ s -> ((), f s)
231
232 -- | A variant of 'modify' in which the computation is strict in the
233 -- new state.
234 --
235 -- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@
236 modify' :: (Monad m) => (s -> s) -> StateT s m ()
237 modify' f = do
238 s <- get
239 put $! f s
240
241 -- | Get a specific component of the state, using a projection function
242 -- supplied.
243 --
244 -- * @'gets' f = 'liftM' f 'get'@
245 gets :: (Monad m) => (s -> a) -> StateT s m a
246 gets f = state $ \ s -> (f s, s)
247
248 -- | Uniform lifting of a @callCC@ operation to the new monad.
249 -- This version rolls back to the original state on entering the
250 -- continuation.
251 liftCallCC :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
252 liftCallCC callCC f = StateT $ \ s ->
253 callCC $ \ c ->
254 runStateT (f (\ a -> StateT $ \ _ -> c (a, s))) s
255
256 -- | In-situ lifting of a @callCC@ operation to the new monad.
257 -- This version uses the current state on entering the continuation.
258 -- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
259 liftCallCC' :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
260 liftCallCC' callCC f = StateT $ \ s ->
261 callCC $ \ c ->
262 runStateT (f (\ a -> StateT $ \ s' -> c (a, s'))) s
263
264 -- | Lift a @catchE@ operation to the new monad.
265 liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a
266 liftCatch catchE m h =
267 StateT $ \ s -> runStateT m s `catchE` \ e -> runStateT (h e) s
268
269 -- | Lift a @listen@ operation to the new monad.
270 liftListen :: (Monad m) => Listen w m (a,s) -> Listen w (StateT s m) a
271 liftListen listen m = StateT $ \ s -> do
272 ~((a, s'), w) <- listen (runStateT m s)
273 return ((a, w), s')
274
275 -- | Lift a @pass@ operation to the new monad.
276 liftPass :: (Monad m) => Pass w m (a,s) -> Pass w (StateT s m) a
277 liftPass pass m = StateT $ \ s -> pass $ do
278 ~((a, f), s') <- runStateT m s
279 return ((a, s'), f)
280
281 {- $examples
282
283 Parser from ParseLib with Hugs:
284
285 > type Parser a = StateT String [] a
286 > ==> StateT (String -> [(a,String)])
287
288 For example, item can be written as:
289
290 > item = do (x:xs) <- get
291 > put xs
292 > return x
293 >
294 > type BoringState s a = StateT s Identity a
295 > ==> StateT (s -> Identity (a,s))
296 >
297 > type StateWithIO s a = StateT s IO a
298 > ==> StateT (s -> IO (a,s))
299 >
300 > type StateWithErr s a = StateT s Maybe a
301 > ==> StateT (s -> Maybe (a,s))
302
303 -}
304
305 {- $counting
306
307 A function to increment a counter.
308 Taken from the paper \"Generalising Monads to Arrows\",
309 John Hughes (<http://www.cse.chalmers.se/~rjmh/>), November 1998:
310
311 > tick :: State Int Int
312 > tick = do n <- get
313 > put (n+1)
314 > return n
315
316 Add one to the given number using the state monad:
317
318 > plusOne :: Int -> Int
319 > plusOne n = execState tick n
320
321 A contrived addition example. Works only with positive numbers:
322
323 > plus :: Int -> Int -> Int
324 > plus n x = execState (sequence $ replicate n tick) x
325
326 -}
327
328 {- $labelling
329
330 An example from /The Craft of Functional Programming/, Simon
331 Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>),
332 Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a
333 tree of integers in which the original elements are replaced by
334 natural numbers, starting from 0. The same element has to be
335 replaced by the same number at every occurrence, and when we meet
336 an as-yet-unvisited element we have to find a \'new\' number to match
337 it with:\"
338
339 > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)
340 > type Table a = [a]
341
342 > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)
343 > numberTree Nil = return Nil
344 > numberTree (Node x t1 t2) = do
345 > num <- numberNode x
346 > nt1 <- numberTree t1
347 > nt2 <- numberTree t2
348 > return (Node num nt1 nt2)
349 > where
350 > numberNode :: Eq a => a -> State (Table a) Int
351 > numberNode x = do
352 > table <- get
353 > case elemIndex x table of
354 > Nothing -> do
355 > put (table ++ [x])
356 > return (length table)
357 > Just i -> return i
358
359 numTree applies numberTree with an initial state:
360
361 > numTree :: (Eq a) => Tree a -> Tree Int
362 > numTree t = evalState (numberTree t) []
363
364 > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil
365 > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil
366
367 -}