[Beginnings of state monad Bryan O'Sullivan **20080106070607] { addfile ./examples/ch14/SimpleState.hs addfile ./examples/ch14/State.hs hunk ./en/book-shortcuts.xml 124 -newtype"> +newtype"> hunk ./en/ch10-binary.xml 296 - of Parse values in a hidden argument. + of Parse values in a hidden argument. (We'll be + revisiting this kind of code in a few chapters, so don't fret if + that description seemed dense.) hunk ./en/ch14-monads.xml 909 - list comprehension. We can illustrate the similarity by + list comprehension. We can illustrate this similarity by hunk ./en/ch14-monads.xml 972 - Using the list monad + Putting the list monad to work hunk ./en/ch14-monads.xml 1124 + + + + The state monad + + We discovered earlier in this chapter that the + Parse from was a monad. It has two logically + distinct aspects. One is the idea of a parse failing, and + providing a message with the details: we represented this using + the Either type. The other involves carrying + around a piece of implicit state, in our case the partially + consumed ByteString. + + This need for a way to read and write state is common enough + in Haskell programs that the standard libraries provide a monad + named State that is dedicated to this purpose. This + monad lives in the Control.Monad.State + module. + + Where our Parse type carried around a + ByteString as its piece of state, the + State monad can carry any type of state. We'll + refer to the state's unknown type as s. + + What's an obvious and general thing we might want to do with + a state? Given a state value, we inspect it, then produce a + result and a new state value. Let's say the result can be of + any type a. A type signature + that captures this idea is s -> (a, s): take a + state s, and return a result + a and a new state s. + + + Almost a state monad + + Let's develop some simple code that's + almost the State monad, then + we'll take a look at the real thing. We'll start with our + type definition, which has exactly the obvious type we + described above. + + &SimpleState.hs:SimpleState; + + Yes, this is a type synonym, not a new type, and so we're + cheating a little. Bear with us for now; this simplifies the + description that follows. + + Earlier in this chapter, we said that a monad has a type + constructor with a single type variable, and yet here we have + a type with two variables. The key here is to understand that + we can partially apply a type just as we + can partially apply a normal function. This is easiest to + follow with an example. + + &SimpleState.hs:StringState; + + Here, we've bound the type variable s to String. The type + StringState still has an unbound type variable + a, though. It's now more + obvious that we have a suitable type constructor for a monad. + In other words, our monad's type constructor is + SimpleState s, not SimpleState + alone. + + The next ingredient we need to make a monad is a + definition for the &return; function. + + &SimpleState.hs:returnSt; + + All this does is take the result and the current state, + and tuple them up. You may by now be used to + the idea that a Haskell function with multiple parameters is + just a chain of single-parameter functions, but just in case + you're not, here's a more familiar way of writing + returnSt that makes it more obvious how + simple this function is. + + &SimpleState.hs:returnAlt; + + Our final piece of the monadic puzzle is a definition for + &bind;. Here it is, using the actual variable names from the + standard library's definition of &bind; for + State. + + &SimpleState.hs:bindSt; + + Those single-letter variable names aren't exactly a boon + to readability, so let's see if we can substitute some more + meaningful names. + + &SimpleState.hs:bindAlt; + + To understand this definition, remember that + step is a function with the type s + -> (a, s). When we evaluate this, we get a tuple, + and we have to use this to return a new function of type + s -> (a, s). This is perhaps easier to follow + if we get rid of the SimpleState type synonyms + from bindAlt's type signature, and + examine the types of its parameters and result. + + &SimpleState.hs:bindAlt.type; + + + + + The real thing + + The only simplifying trick we played in the previous + section was to use a type synonym instead of a type definition + for SimpleState. In order to define a + Monad instance, we have to provide a proper type + constructor as well as definitions for &bind; and &return;. + This leads us to the real definition of + State. + + &State.hs:State; + + All we've done is wrap our s -> (a, s) + type in a State constructor. By using Haskell's + record syntax to define the type, we're automatically given a + runState function that will unwrap a + State value from its constructor. The type of + runState is State s a -> s -> + (a, s). + + The definition of &return; is almost the same as for + SimpleState, except we wrap our function with a + State constructor. + + &State.hs:returnState; + + The definition of &bind; is a little more complicated, + because it has to use runState to remove + the State wrappers. + + &State.hs:bindState; + + 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. + hunk ./examples/ch14/SimpleState.hs 1 +{-- snippet SimpleState --} +type SimpleState s a = s -> (a, s) +{-- /snippet SimpleState --} + +{-- snippet StringState --} +type StringState a = SimpleState String a +{-- /snippet StringState --} + +{-- snippet returnSt --} +returnSt :: a -> SimpleState s a +returnSt a = \s -> (a, s) +{-- /snippet returnSt --} + +{-- snippet returnAlt --} +returnAlt :: a -> SimpleState s a +returnAlt a s = (a, s) +{-- /snippet returnAlt --} + +{-- snippet bindSt --} +bindSt :: (SimpleState s a) -> (a -> SimpleState s b) -> SimpleState s b +bindSt m k = \s -> let (a, s') = m s + in (k a) s' +{-- /snippet bindSt --} + +{-- snippet bindAlt.type --} +bindAlt :: (s -> (a, s)) -- step + -> (a -> s -> (b, s)) -- makeStep + -> (s -> (b, s)) -- (makeStep result) newState +{-- /snippet bindAlt.type --} + +{-- snippet bindAlt --} +bindAlt step makeStep oldState = + let (result, newState) = step oldState + in (makeStep result) newState +{-- /snippet bindAlt --} hunk ./examples/ch14/State.hs 1 +{-- snippet State --} +newtype State s a = State { + runState :: s -> (a, s) + } +{-- /snippet State --} + +{-- snippet returnState --} +returnState :: a -> State s a +returnState a = State $ \s -> (a, s) +{-- /snippet returnState --} + +{-- snippet bindState --} +bindState :: State s a -> (a -> State s b) -> State s b +bindState m k = State $ \s -> let (a, s') = runState m s + in runState (k a) s' +{-- /snippet bindState --} + +{-- snippet Monad --} +instance Monad (State s) where + return a = returnState a + m >>= k = bindState m k +{-- /snippet Monad --} }