[Monad laws Bryan O'Sullivan **20080112081128] { addfile ./examples/ch14/MonadLaws.hs addfile ./examples/ch14/MonadJoin.hs addfile ./examples/ch14/monadjoin.ghci addfile ./examples/ch14/AltMonad.hs hunk ./en/ch10-binary.xml 622 - + hunk ./en/ch14-monads.xml 1546 - fmap! join! + Functors and monads are closely related. The + terms are borrowed from a branch of mathematics called category + theory, but they did not make the transition completely + unscathed. + + In category theory, a monad is built from a functor. You + might expect that in Haskell, the Monad typeclass + would thus be a subclass of Functor, but it isn't + defined as such in the standard Prelude. This is an unfortunate + oversight + + However, authors of Haskell libraries use a workaround: when + someone defines an instance of Monad for a type, + they almost always write a Functor instance for it, + too. You can fairly reliably take it for granted that you'll be + able to use the Functor typeclass's + fmap function with any monad. + + If we compare the type signature of + fmap with those of some of the standard + monad functions that we've already seen, and we get a hint as to + what fmap on a monad does. + + &monadness.ghci:fmap; + + Sure enough, fmap lifts a pure function + into the monad, just as liftM does. + + + Another way of looking at monads + + Now that we know about the relationship between functors + and monads, If we take a look back at the list monad, we can + see something interesting. Specifically, take a look at the + definition of &bind; for lists. + + &ListMonad.hs:instance.noid; + + Recall that f has type a -> + [a]. When we call map f xs, we get back + a value of type [[a]], which we have to + flatten using concat. + + Consider what we could do if Monad was a + subclass of Functor. Since + fmap for lists is defined to be + map, we could replace + map with fmap in the + definition of &bind;. This is not very interesting by itself, + but suppose we could go further. + + The concat function is of type + [[a]] -> [a]: as we mentioned, it flattens the + nesting of lists. We could generalise this type signature + from lists to monads, giving us the remove a level of + nesting type m (m a) -> m a. The + function that has this type is conventionally named + join. + + If we had definitions of join and + fmap, we wouldn't need to write a + definition of &bind; for every monad, because it would be + completely generic. Here's what an alternative definition of + the Monad typeclass might look like, along with a + definition of &bind;. + + &AltMonad.hs:AltMonad; + + Neither definition of a monad is better, + since if we have join we can write + &bind;, and vice versa, but the different perspectives can be + refreshing. + + Removing a layer of monadic wrapping can, in fact, be + useful in realistic circumstances. We can find a generic + definition of join in the + Control.Monad module. + + &MonadJoin.hs:join; + + Here are some examples of what it does. + + &monadjoin.ghci:examples; + + + + + The monad laws, and good coding style + + In , we introduced + two rules for how functors should always behave. + + &MonadLaws.hs:functor; + + Not surprisingly, there are also rules for how monads ought + to behave. The three laws below are referred to as the monad + laws. A Haskell implementation doesn't enforce these laws: it's + up to the author of a Monad instance to follow + them. + + The monad laws are simply formal ways of saying a + monad shouldn't surprise me. In principle, we could + probably get away with skipping over them entirely. It would be + a shame if we did, however, because the laws contain gems of + wisdom that we might otherwise overlook. + + + Reading the laws + + You can read each law below as the expression on + the left of the == is equivalent to that on the + right. + + + The first law states that &return; is a left + identity for &bind;. + + &MonadLaws.hs:leftIdentity; + + Another way to phrase this is that there's no reason to use + &return; to wrap up a pure value if all you're going to do is + unwrap it again with &bind;. It's actually a common style error + among programmers new to monads to wrap a value with &return;, + then unwrap it with &bind; a few lines later in the same + function. Here's the same law written with &do; + notation. + + &MonadLaws.hs:leftIdentityDo; + + This law has practical consequences for our coding style: we + don't want to write unnecessary code, and the law lets us assume + that the terse code will be identical in its effect to the more + verbose version. + + The second monad law states that &return; is a + right identity for &bind;. + + &MonadLaws.hs:rightIdentity; + + This law also has style consequences in real programs, + particularly if you're coming from an imperative language: + there's no need to call &return; if the last action in a block + would otherwise be returning the correct result. Let's look at + this law in &do; notation. + + &MonadLaws.hs:rightIdentityDo; + + Once again, if we assume that a monad obeys this law, we can + write the shorter code in the knowledge that it will have the + same effect as the longer code. + + The final law is concerned with associativity. + + &MonadLaws.hs:associativity; + + This law can be a little more difficult to follow, so let's + look at the contents of the parentheses on each side of the + equation. We can rewrite the expression on the left as + follows. + + &MonadLaws.hs:associativityLeft; + + On the right, we can also rearrange things. + + &MonadLaws.hs:associativityRight; + + We're now claiming that the following two expressions are + equivalent. + + &MonadLaws.hs:associativityRewrite; + + What this means is if we want to break up an action into + smaller pieces, it doesn't matter which sub-actions we hoist out + to make new actions with, provided we preserve their ordering. + If we have three actions chained together, we can substitute the + first two and leave the third in place, or we can replace the + second two and leave the first in place. + + Even this more complicated law has a practical consequence. + If you're familiar with the terminology of software refactoring, + this law essentially states that the extract + method technique applies to Haskell monads. + + We've now seen how each of the monad laws offers us an + insight into writing better monadic code. The first two laws + show us how to avoid unnecessary use of &return;. The third + suggests that we can safely refactor a complicated action into + several simpler ones. We can now safely let the details fade, in + the knowledge that our do what I mean intuitions + won't be violated when we use properly written monads. Don't + forget to check these laws yourself when you create a + monad! hunk ./examples/ch14/AltMonad.hs 1 +{-- snippet AltMonad --} +import Prelude hiding ((>>=), return) + +class Functor m => AltMonad m where + join :: m (m a) -> m a + return :: a -> m a + +(>>=) :: AltMonad m => m a -> (a -> m b) -> m b +xs >>= f = join (fmap f xs) +{-- /snippet AltMonad --} hunk ./examples/ch14/MonadJoin.hs 1 +{-- snippet join --} +join :: Monad m => m (m a) -> m a +join x = x >>= id +{-- /snippet join --} + hunk ./examples/ch14/MonadLaws.hs 1 +{-- snippet functor --} +fmap id == id +fmap (f . g) == fmap f . fmap g +{-- /snippet functor --} + +{-- snippet leftIdentity --} +return x >>= f == f x +{-- /snippet leftIdentity --} + +{-- snippet leftIdentityDo --} +do y <- return x + f y == f x +{-- /snippet leftIdentityDo --} + +{-- snippet rightIdentity --} +m >>= return == m +{-- /snippet rightIdentity --} + +{-- snippet rightIdentityDo --} +do y <- m + return y == m +{-- /snippet rightIdentityDo --} + +{-- snippet associativity --} +m >>= (\x -> f x >>= g) == (m >>= f) >>= g +{-- /snippet associativity --} + +{-- snippet associativityLeft --} +m >>= s + where s = \x -> f x >>= g +{-- /snippet associativityLeft --} + +{-- snippet associativityRight --} +t >>= g + where t = m >>= f +{-- /snippet associativityRight --} + +{-- snippet associativityRewrite --} +m >>= s == t >>= g +{-- /snippet associativityRewrite --} hunk ./examples/ch14/monadjoin.ghci 1 +:m +Control.Monad + +--# examples +join (Just (Just 1)) +join Nothing +join [[1],[2,3]] hunk ./examples/ch14/monadness.ghci 4 +:m +Control.Monad hunk ./examples/ch14/monadness.ghci 13 +--# fmap +:type fmap +:type liftM + }