[Maybe monad. Bryan O'Sullivan **20071220081009] { addfile ./examples/ch14/Carrier.hs addfile ./examples/ch14/carrier.ghci hunk ./en/ch12-barcode.xml 927 - + hunk ./en/ch14-monads.xml 192 - the types we want them to have, in a Haskell typeclass. The - standard Prelude already defines just such a typeclass, named - Monad. + the types that we want them to have, in a Haskell typeclass. + The standard Prelude already defines just such a typeclass, + named Monad. hunk ./en/ch14-monads.xml 280 + + + When we say that a type is a monad, this + is really an shorthand way of saying that it's an instance + of the Monad typeclass. Being an instance of + Monad gives us the necessary monadic triple of + type constructor, injection function, and chaining + function. + + + + In the same way, a reference to the + Foo monad implies that we're talking + about the type named Foo, and that it's an + instance of Monad. + + hunk ./en/ch14-monads.xml 386 - and extracts its result. These functions are usually the only - means provided for values to escape. Thus, the author of a - monad has complete control over the external visibility of - whatever happens inside the monad. In our case, we can - imagine a few alternatives to execLogger: - one might only return the log messages, while another might - return just the result and drop the log messages. + and unwraps its result. Such a function are usually the only + means provided for a value to escape from its monadic wrapper. + The author of a monad thus has complete control over how + whatever happens inside the monad gets out. + + Some monads have several execution functions. In our + case, we can imagine a few alternatives to + execLogger: one might only return the log + messages, while another might return just the result and drop + the log messages. hunk ./en/ch14-monads.xml 532 - We do exactly the same thing with a monad. In fact, with a - monad, the job is easier, because the Monad - typeclass already provides unwrapping and rewrapping functions - for us, in the form of &bind; and &return;. + We do exactly the same thing with a monad. Because the + Monad typeclass already provides the &bind; and + &return; functions that know how to wrap and unwrap a value, the + liftM function doesn't need any details of + a monad's implementation. hunk ./en/ch14-monads.xml 588 + + The Maybe monad + + The Maybe type is very nearly the simplest + instance of Monad. It represents a computation + that might fail. + + &Maybe.hs:instance; + + When we chain together a number of computations over + Maybe using &bind; or &bind_;, and any returns + Nothing, then we don't evaluate any of the + remaining computations. + + Note, though, that the chain is not completely + short-circuited. Each &bind; or &bind_; in the chain will still + match a Nothing on its left, and produce a + Nothing on its right, all the way to the + end. It's easy to forget this point: when a computation in the + chain fails, the subsequent production, chaining, and + consumption of Nothing values is cheap at runtime, + but it's not free. + + + Executing the Maybe monad + + A function suitable for executing the Maybe + monad is maybe. (Remember that + executing a monad involves evaluating it and + returning a result that's had the monad's type wrapper + removed.) + + &Maybe.hs:maybe; + + Its first parameter is the value to return if the result + is Nothing. The second is a function to call on + a result wrapped in the Just constructor; the + result of that application is then returned. + + Since the Maybe ADT is so simple, it's about + as common to simply pattern-match on a Maybe + value as it is to call maybe. Each one + is more readable in different circumstances. + + + + Maybe at work, and good API design + + Here's an example of Maybe in use as a monad. + Given a customer's name, we want to find the billing address + of their mobile phone carrier. + + &Carrier.hs:findCarrierBillingAddress; + + Our first version is the dreaded ladder of code marching + off the right of the screen, with many boilerplate &case; + expressions. + + &Carrier.hs:variation1; + + The Data.Map module's + lookup function has a monadic return + type. + + &carrier.ghci:lookup; + + In other words, if the given key is present in the map, + lookup injects it into the monad using + &return;. Otherwise, it calls &fail;. This is a lovely piece + of API design! The behaviours of success and failure are + automatically customised to our needs, based on the monad + we're calling lookup from. Better yet, + lookup itself doesn't know or care what + those behaviours are. + + The &case; expressions above typecheck because we're + comparing the result of lookup against + values of type Maybe. But the code is horrible; + let's make more sensible use of Maybe's status as + a monad. + + &Carrier.hs:variation2; + + If any of these lookups fails, the definitions of &bind; + and &bind_; mean that the result of the function as a whole + will be Nothing, just as it was for our first + attempt that used &case; explicitly. + + This version is much tidier. That being said, the + &return; isn't necessary. Stylistically, it makes the code + look more regular, and perhaps more familiar to the eyes of an + imperative programmer, but behaviourally it's redundant. + Here's an equivalent piece of code. + + &Carrier.hs:variation2a; + + When we introduced maps, we mentioned in that the type signatures of + functions in the Data.Map module often make them + awkward to partially apply. The lookup + function is a good example. If we flip + its arguments, we can write the function body as a + one-liner. + + &Carrier.hs:variation3; + + + + hunk ./en/ch14-monads.xml 925 + + + Monads and functors + + fmap! join! + hunk ./examples/ch14/Carrier.hs 1 +{-- snippet findCarrierBillingAddress --} +import qualified Data.Map as M + +type PersonName = String +type PhoneNumber = String +type BillingAddress = String +data MobileCarrier = Honest_Bobs_Phone_Network + | Morrisas_Marvelous_Mobiles + | Petes_Plutocratic_Phones + deriving (Eq, Ord) + +findCarrierBillingAddress :: PersonName + -> M.Map PersonName PhoneNumber + -> M.Map PhoneNumber MobileCarrier + -> M.Map MobileCarrier BillingAddress + -> Maybe BillingAddress +{-- /snippet findCarrierBillingAddress --} +findCarrierBillingAddress = undefined + +{-- snippet variation1 --} +variation1 person phoneMap carrierMap addressMap = + case M.lookup person phoneMap of + Nothing -> Nothing + Just number -> + case M.lookup number carrierMap of + Nothing -> Nothing + Just carrier -> M.lookup addressMap carrier +{-- /snippet variation1 --} + +{-- snippet variation2 --} +variation2 person phoneMap carrierMap addressMap = do + number <- M.lookup person phoneMap + carrier <- M.lookup number carrierMap + address <- M.lookup carrier addressMap + return address +{-- /snippet variation2 --} + +{-- snippet variation2a --} +variation2a person phoneMap carrierMap addressMap = do + number <- M.lookup person phoneMap + carrier <- M.lookup number carrierMap + M.lookup carrier addressMap +{-- /snippet variation2a --} + +{-- snippet variation3 --} +variation3 person phoneMap carrierMap addressMap = + lookup phoneMap person >>= lookup carrierMap >>= lookup addressMap + where lookup = flip M.lookup +{-- /snippet variation3 --} hunk ./examples/ch14/Maybe.hs 1 -import Prelude hiding (Maybe(..)) +import Prelude hiding (Maybe(..), Monad(..)) hunk ./examples/ch14/Maybe.hs 21 -class Monad m where +class Monad m where hunk ./examples/ch14/Maybe.hs 28 -{-- snippet fail --} - fail :: String -> m a - fail = error -{-- /snippet fail --} - hunk ./examples/ch14/Maybe.hs 38 +{-- snippet instance --} +instance Monad Maybe where + Just x >>= k = k x + Nothing >>= _ = Nothing + + Just _ >> k = k + Nothing >> _ = Nothing + + return x = Just x + + fail _ = Nothing +{-- /snippet instance --} + +{-- snippet maybe --} +maybe :: b -> (a -> b) -> Maybe a -> b +maybe n _ Nothing = n +maybe _ f (Just x) = f x +{-- /snippet maybe --} + hunk ./examples/ch14/carrier.ghci 1 +--# lookup +:module +Data.Map +:type Data.Map.lookup }