[Start work on chapters 16 and 18a Bryan O'Sullivan **20080208005018] { adddir ./examples/ch18a addfile ./examples/ch18a/FormParse.hs adddir ./examples/ch16 addfile ./examples/ch16/MovieReview.hs addfile ./examples/ch16/ap.ghci addfile ./en/ch18a-applicative.xml hunk ./en/00book.xml 29 + hunk ./en/00book.xml 137 + &ch18a; hunk ./en/Makefile 25 -src-dirs := $(wildcard ../examples/app[A-Z] ../examples/ch[0-9][0-9]) +src-dirs := $(wildcard ../examples/app[A-Z]* ../examples/ch[0-9][0-9]*) hunk ./en/ch16-monad-case.xml 4 - FIXME - FIXME. + Some monad examples + + + Golfing practice: association lists + + Web clients and servers often pass information around as a + simple textual list of key-value pairs. + + name=Attila+%42The+Hun%42&occupation=Khan + + The encoding is named + application/x-www-form-urlencoded, and it's easy to + understand. Each key-value pair is separated by an + & character. Within a pair, a + key is a series of characters, followed by an + =, followed by a value. + + We can obviously represent a key as a String, + but the HTTP specification is not clear about whether a key must + be followed by a value. We can capture this ambiguity by + representing a value as a Maybe String. If we use + Nothing for a value, then there was no value + present. If we wrap a string in Just, then there + was a value. Using Maybe lets us distinguish + between no value and empty + value. + + Haskell programmers use the name association + list for the type [(a, b)], where we + can think of each element as an association between a key and a + value. The name originates in the Lisp community, where it's + usually abbreviated as an alist. We could + thus represent the above string as the following Haskell + value. + + &MovieReview.hs:attila; + + In , we'll parse an + application/x-www-form-urlencoded string, and + represent the result as an alist of [(String, Maybe + String)]. Let's say we want to use one of these alists + to fill out a data structure. + + &MovieReview.hs:MovieReview; + + We'll begin by belabouring the obvious with a naive + function. + + &MovieReview.hs:simpleReview; + + It only returns a MovieReview if the alist + contains all of the necessary values, and they're all non-empty + strings. However, the fact that it validates its inputs is its + only merit: it suffers badly from the staircasing + that we've learned to be wary of, and it knows the intimate + details of the representation of an alist. + + Since we're now well acquainted with the Maybe + monad, we can tidy up the staircasing. + + &MovieReview.hs:maybeReview; + + Although this is much tidier, we're still repeating + ourselves. We can take advantage of the fact that the + MovieReview constructor acts as a normal, pure + function by lifting it into the monad, as + we discussed in . + + &MovieReview.hs:liftedReview; + + + + Generalised lifting + + Although using liftM3 tidies up our + code, we can't use a liftM-family function + to solve this sort of problem in general, because they're only + defined up to liftM5. If we had a + constructor or pure function that took, say, ten parameters, you + might think we'd be out of luck. + + Of course, our toolbox isn't yet empty. In + Control.Monad, there's a function named + ap with a slightly odd type + signature. + + &ap.ghci:ap; + + You might wonder who would put a single-argument pure + function inside a monad, and why. Recall, however, that + all Haskell functions really take only one + argument, and you'll begin to see how this might relate to the + MovieReview constructor. + + &ap.ghci:MovieReview; + + We can just as easily write that type as String -> + (String -> (String -> MovieReview)). If we use + plain old liftM to lift + MovieReview into the Maybe monad, + we'll have a value of type Maybe (String -> (String + -> (String -> MovieReview))). We can now see + that this type is suitable as an argument for + ap, in which case the result type will be + Maybe (String -> (String -> MovieReview)). We + can pass this, in turn, to ap, and continue + to chain until we end up with this definition. + + &MovieReview.hs:apReview; + + We can chain applications of ap like + this as many times as we need to, and thereby to avoid the hard + limit of 5 on the liftM family of + functions. + + Another helpful way to look at ap is + that it's the monadic equivalent of the familiar + ($) operator. We can see this clearly when + we compare the type signatures of the two functions. + + &ap.ghci:types; + + + hunk ./en/ch18-parsec.xml 178 - We promised you earlier that we could simply our CSV parser + We promised you earlier that we could simplify our CSV parser hunk ./en/ch18a-applicative.xml 1 + + + + Further adventures in parsing + + In this chapter, we're going to spend a little more time on + parsing. Our goal is to develop a few useful parsers. We'll + write one parser for HTTP requests, which will help us to develop + a web server in later chapters. We'll complete our treatment of + JSON by writing a parser for JSON data, and again we'll be using + this later, too. + + Along the way, we'll dwell on a few easy topics in + mathematics. As usual, we have a practical goal in mind: the + concepts we'll introduce will help us to write cleaner, more + regular code. + + + Parsing an URL-encoded query string + + When we introduced + application/x-www-form-urlencoded text in , we mentioned that we'd write a + parser for these strings. We can quickly and easily do this + using Parsec. + + Each key-value pair is separated by the + & character. + + &FormParse.hs:p_query; + + Notice that in the type signature, we're using + Maybe to represent a value: the HTTP specification + is unclear about whether a key must have an + associated value, and we'd like to be able to distinguish + between no value and empty + value. + + &FormParse.hs:p_pair; + + The many1 function is similar to + many: it applies its parser repeatedly, + returning a list of their results. While + many will succeed and return an empty list + if its parser never succeeds, many1 will + fail if its parser never succeeds, and will otherwise return a + list of at least one element. + + The optionMaybe function modifies the + behaviour of a parser. If the parser fails, + optionMaybe doesn't fail: it returns + Nothing. Otherwise, it wraps the parser's + successful result with Just. This gives us the + ability to distinguish between no value and + empty value, as we mentioned above. + + Individual characters can be encoded in one of several + ways. + + &FormParse.hs:p_char; + + Some characters can be represented literally. Spaces are + treated specially, using a + character. Other + characters must be encoded as a % character + followed by two hexadecimal digits. The Numeric + module's readHex parses a hex string as + a number. + + As appealing and readable as this parser is, we can profit + from stepping back and taking another look at some of our + building blocks. + + + + hunk ./examples/ch16/MovieReview.hs 1 +import Control.Monad (ap, liftM, liftM3) + +{-- snippet MovieReview --} +data MovieReview = MovieReview { + revTitle :: String + , revUser :: String + , revReview :: String + } +{-- /snippet MovieReview --} + +{-- snippet simpleReview --} +simpleReview :: [(String, Maybe String)] -> Maybe MovieReview +simpleReview alist = + case lookup "title" alist of + Just (Just title@(_:_)) -> + case lookup "user" alist of + Just (Just user@(_:_)) -> + case lookup "review" alist of + Just (Just review@(_:_)) -> + Just (MovieReview title user review) + _ -> Nothing -- no review + _ -> Nothing -- no user + _ -> Nothing -- no title +{-- /snippet simpleReview --} + +{-- snippet maybeReview --} +maybeReview alist = do + title <- lookup1 "title" alist + user <- lookup1 "user" alist + review <- lookup1 "review" alist + return (MovieReview title user review) + +lookup1 key alist = case lookup key alist of + Just (Just s@(_:_)) -> Just s + _ -> Nothing +{-- /snippet maybeReview --} + +{-- snippet liftedReview --} +liftedReview alist = + liftM3 MovieReview (lookup1 "title" alist) + (lookup1 "user" alist) + (lookup1 "review" alist) +{-- /snippet liftedReview --} + +{-- snippet apReview --} +apReview alist = + MovieReview `liftM` lookup1 "title" alist + `ap` lookup1 "user" alist + `ap` lookup1 "review" alist +{-- /snippet apReview --} + +attila = +{-- snippet attila --} + [("name", Just "Attila \"The Hun\""), + ("occupation", Just "Khan")] +{-- /snippet attila --} hunk ./examples/ch16/ap.ghci 1 +:load MovieReview + +--# ap +:m +Control.Monad +:type ap + +--# MovieReview +:type MovieReview + +--# types +:type ($) +:type ap hunk ./examples/ch18a/FormParse.hs 1 +import Text.ParserCombinators.Parsec +import Numeric (readHex) + +{-- snippet p_query --} +p_query :: CharParser () [(String, Maybe String)] +p_query = p_pair `sepBy` char '&' +{-- /snippet p_query --} + +{-- snippet p_pair --} +p_pair :: CharParser () (String, Maybe String) +p_pair = do + name <- many1 p_char + value <- optionMaybe (char '=' >> many p_char) + return (name, value) +{-- /snippet p_pair --} + +{-- snippet p_char --} +p_char :: CharParser () Char +p_char = oneOf urlBaseChars + <|> (char '+' >> return ' ') + <|> p_hex + +urlBaseChars = ['a'..'z']++['A'..'Z']++['0'..'9']++"$-_.!*'()," + +p_hex :: CharParser () Char +p_hex = do + char '%' + a <- hexDigit + b <- hexDigit + let ((d, _):_) = readHex [a,b] + return . toEnum $ d +{-- /snippet p_char --} }