[More state monad progress. Bryan O'Sullivan **20080109074412] { hunk ./en/ch14-monads.xml 370 - + hunk ./en/ch14-monads.xml 1234 - The real thing + Reading and modifying the state + + The definitions of &bind; and &return; for the state monad + simply act as plumbing: they move a piece of state around, but + they don't touch it in any way. We need a few other simple + functions to actually do useful work with the state. + + &SimpleState.hs:getPut; + + The getSt function simply takes the + current state and returns it as the result, while + putSt ignores the current state and + replaces it with a new state. + + + + Will the real state monad please stand up? hunk ./en/ch14-monads.xml 1282 - It should now be clear why we introduced a simpler &bind; - definition first, in the form of bindAlt. - This version differs only in adding the wrapping and - unwrapping of a few values. By separating the real work from - the bookkeeping, we've hopefully made it clearer what's really - happening. + This function differs from our earlier + bindSt only in adding the wrapping and + unwrapping of a few values. By separating the real + work from the bookkeeping, we've hopefully made it + clearer what's really happening. + + We modify the functions for reading and modifying the + state in the same way, by adding a little wrapping. + + &State.hs:getPut; + + + + + Using the state monad: generating random values + + We've already used Parse, our precursor to + the state monad, to parse binary data. If we'd been using the + state monad directly, we would have used a + ByteString as the state. + + The State monad will probably feel much familiar to you + than many other monads if you have a background in imperative + languages. After all, imperative languages are all about + carrying around some implicit state, reading some parts, and + modifying others through assignment, and this is just what the + state monad is for. + + So instead of unnecessarily cheerleading for the idea of + using the state monad, we'll begin by demonstrating how to use + it for something simple: pseudorandom value generation. In + an imperative language, there's usually an easily available + source of uniform pseudorandom numbers. For example, in C, there's + a standard rand function that generates a + pseudorandom number, using a global state that it + updates. + + Haskell's standard random generation module is named + System.Random. It allows the generation of + random values of any type, not just numbers. The module + contains several handy functions that live in the + IO monad. For example, a rough equivalent of C's + rand function would be the + following: + + &Random.hs:rand; + + (The randomR function takes an + inclusive range within which the generated random value + should lie.) + + The System.Random module provides a + typeclass, RandomGen, that lets us define new + sources of random values. The type StdGen is the + standard RandomGen instance, and generated + pseudorandom values. If we had an external source of truly + random data, we could make it an instance of + RandomGen and get truly random, instead of merely + pseudorandom, values. + + Another typeclass, Random, indicates how to + generate random values of a particular type. The module + defines Random instances for all of the usual + simple types. + + Incidentally, the definition of rand + above reads and modifies a built-in global random generator + that inhabits the IO monad. + + + A first attempt at purity + + After all of our emphasis so far on avoiding the + IO monad wherever possible, it would be a shame + if we were dragged back into it just to generate some random + values. Indeed, System.Random contains pure + random number generation functions. + + The traditional downside of purity is that we have to + get or create a random number generator, then ship it from + the point we created it to the place where it's needed. When + we finally call it, it returns a new + random number generator: we're in pure code, remember, so we + can't modify the state of the existing generator. + + If we forget about immutability and reuse the same + generator within a function, we get back exactly the same + random number every time. + + &Random.hs:twoBadRandoms; + + Needless to say, this has nasty consequences. + + &random.ghci:twoBadRandoms; + + (The random function uses an + implicit range instead of the user-supplied range used by + randomR. The + getStdGen function retrieves the + current value of the global standard number generator from + the IO monad.) + + Unfortunately, correctly passing around and using + successive versions of the generator does not make for + palatable reading. Here's a simple example. + + &Random.hs:twoGoodRandoms; + + Now that we know about the state monad, though, it looks + like a fine candidate to hide the generator. + + + + Random values in the state monad + + Here's a state monad that carries around a + StdGen as its piece of state. + + &Random.hs:RandomState; + + The type synonym is of course not necessary, but it's + handy. It saves a little keyboarding, and if we wanted to + swap another random generator for StdGen, it + would reduce the number of type signatures we'd need to + change. + + Generating a random value is now a matter of fetching + the current generator, using it, then modifying the state to + replace it with the new generator. + + &Random.hs:getRandom; + + We can now use some of the monadic machinery that we saw + earlier to write a much more concise function for giving us + a pair of random numbers. + + &Random.hs:getTwoRandoms; + + + + Exercises + + + + + Rewrite getRandom to use &do; + notation. + + + + + + + + Running the state monad + + As we've already mentioned, each monad has its own + specialised evaluation functions. In the case of the state + monad, we have several to choose from. + + + + runState returns both the + result and the final state. + + + evalState returns only the + result, throwing away the final state. + + + execState throws the result + away, returning only the final state. + + + + The evalState and + execState functions are simply + compositions of fst and + snd with runState, + respectively. Thus, of the three, + runState is the one most worth + remembering. + addfile ./examples/ch14/Random.hs hunk ./examples/ch14/Random.hs 1 +module Random where + +import Control.Monad (liftM2) +import Control.Monad.State + +{-- snippet rand --} +import System.Random + +rand :: IO Int +rand = getStdRandom (randomR (0, maxBound)) +{-- /snippet rand --} + +{-- snippet twoBadRandoms --} +twoBadRandoms :: RandomGen g => g -> (Int, Int) +twoBadRandoms gen = (fst $ random gen, fst $ random gen) +{-- /snippet twoBadRandoms --} + +{-- snippet twoGoodRandoms --} +twoGoodRandoms :: RandomGen g => g -> ((Int, Int), g) +twoGoodRandoms gen = let (a, gen') = random gen + (b, gen'') = random gen' + in ((a, b), gen'') +{-- /snippet twoGoodRandoms --} + +{-- snippet RandomState --} +type RandomState a = State StdGen a +{-- /snippet RandomState --} + +{-- snippet getRandom --} +getRandom :: Random a => RandomState a +getRandom = + get >>= \gen -> + let (val, gen') = random gen in + put gen' >> + return val +{-- /snippet getRandom --} + +{-- snippet getRandomDo --} +getRandomDo :: Random a => RandomState a +getRandomDo = do + gen <- get + let (val, gen') = random gen + put gen' + return val +{-- /snippet getRandomDo --} + +getTwoRandoms :: Random a => RandomState (a, a) +getTwoRandoms = do + a <- getRandom + b <- getRandom + return (a, b) + +getTwoCleaner :: Random a => RandomState (a, a) +getTwoCleaner = liftM2 (,) getRandom getRandom hunk ./examples/ch14/SimpleState.hs 37 +{-- snippet getPut --} +getSt :: SimpleState s s +getSt = \s -> (s, s) + +putSt :: s -> SimpleState s () +putSt s = \_ -> ((), s) +{-- /snippet getPut --} + hunk ./examples/ch14/State.hs 24 +{-- snippet getPut --} +get :: State s s +get = State $ \s -> (s, s) + +put :: s -> State s () +put s = State $ \_ -> ((), s) +{-- /snippet getPut --} + addfile ./examples/ch14/random.ghci hunk ./examples/ch14/random.ghci 1 +:load Random + +--# twoBadRandoms +twoBadRandoms `fmap` getStdGen }