[Life with typeclasses, part 1 Bryan O'Sullivan **20080502065931] { addfile ./examples/ch06/result.js addfile ./examples/ch07/brokenClass.ghci addfile ./examples/ch07/ClassResult.hs addfile ./examples/ch07/Overlap.hs addfile ./en/ch07a-json-typeclass.xml hunk ./en/00book.xml 18 + hunk ./en/00book.xml 123 + &ch07a; hunk ./en/Makefile 28 - $d/*.ghci $d/*.hs $d/*.java $d/*.lhs \ - $d/*.py)) + $d/*.ghci $d/*.hs $d/*.java $d/*.js \ + $d/*.lhs $d/*.py)) hunk ./en/Makefile 262 +vpath %.js $(src-dirs) hunk ./en/Makefile 286 + ../tools/bin/snippets $(CURDIR)/x $< > $@ + +x/.stamp-%.js: %.js + @mkdir -p x hunk ./en/ch07a-json-typeclass.xml 1 + + + + A typeclass approach to JSON + + + + The JValue type that we introduced in is not especially easy to work with. + Here is a truncated and tidied snippet of some real JSON data, + produced by a well known search engine. + + &result.js:result; + + And here's a further slimmed down fragment of that data, + represented in Haskell. + + &SimpleResult.hs:result; + + Because Haskell doesn't natively support lists that contain + types of different value, we can't directly represent a JSON + object that contains values of different types. Instead, we must + wrap each value with a JValue constructor. This + limits our flexibility: if we want to change the number + 3920 to a string "3,920", we must + change the constructor that we use to wrap it from + JNumber to JString. + + Haskell's typeclasses offer a tempting solution to this + problem. + + &JSONClass.hs:class; + + Now, instead of applying a constructor like + JNumber to a value to wrap it, we apply the + toJValue function. If we change a value's + type, the compiler will choose a suitable implementation of + toJValue to use with it. + + We also provide a fromJValue function, + which attempts to convert a JValue into a value of + our desired type. + + + More helpful errors + + The return type of our fromJValue + function uses the predefined Either type. Like + Maybe, this type is predefined for us, and we'll + often use it to represent a computation that could + fail. + + While Maybe is useful for this purpose, it + gives us no information if a failure occurs: we literally have + Nothing. The Either type has a + similar structure, but instead of Nothing, the + something bad happened constructor is named + Left, and it takes a parameter. + + &DataEither.hs:Either; + + Quite often, the type we use for the a parameter value is + String, which lets us return an error message if + something goes wrong. To see how we use the + Either type in practice, let's look at a simple + instance of our typeclass. + + &JSONClass.hs:Bool; + + + + + Making an instance with a type synonym + + The Haskell 98 standard does not allow us to write an + instance of the following form, even though it seems perfectly + reasonable. + + &JSONClass.hs:String; + + Recall that String is a synonym for + [Char], which in turn is the type + [a] where Char is substituted for + the type parameter a. According + to Haskell 98's rules, we are not allowed to supply a type in + place of a type parameter when we write an instance. In other + words, it would be legal for us to write an instance for + [a], but not for [Char]. + + While &GHC; follows the Haskell 98 standard by default, we + can relax this particular restriction by placing a specially + formatted comment at the top of our source file. + + &JSONClass.hs:LANGUAGE; + + This comment is a directive to the compiler, called a + pragma, which tells it to enable a + language extension. The TypeSynonymInstances + language extension makes the above code legal. We'll + encounter a few other language extensions at various points in + this book. + + + + Living in an open world + + Haskell's typeclasses are intentionally designed to let us + create new instances of a typeclass whenever we like. + + &JSONClass.hs:doubleToJValue; + + We can add new instances anywhere; they are not confined + to the module where we define a typeclass. This feature of + the typeclass system is referred to as its open + world assumption. If we could say the + following are the only instances of this typeclass that can + exist, we could have a closed + world. + + One useful instance we'd like to be able to write is to + turn a list into a JSON array. We won't worry about + implementation details just yet, so let's use + undefined as the bodies of the instance's + methods. + + &BrokenClass.hs:array; + + It would also be convenient if we could turn a list of + name/value pairs into a JSON object. + + &BrokenClass.hs:object; + + If we put these definitions into a source file and load + them into &ghci;, everything initially seems fine. + + &brokenClass.ghci:load; + + However, once we try to use the + list-of-pairs instance, we run into trouble. + + &brokenClass.ghci:use; + + This problem of overlapping instances + is a consequence of Haskell's open world assumption. Here's a + simpler example that makes it clearer what's going on. + + &Overlap.hs:Borked; + + We have two instances of the typeclass + Borked for pairs: one for a pair of + Ints and another for a pair of anything else + that's Borked. + + Suppose that we want to bork a pair + of Int values. To do so, the compiler must + choose an instance to use. Because these instances are right + next to each other, it may seem that it could simply choose + the more specific instance. + + As we've noted, though, the instances don't + have to be next to each other. They could + be in two separate modules, and the code that's trying to use + the Borked typeclass in a third. When a module + contains an instance, the instance is automatically exported + from the module, but not in a way that's easily + visible. + + We could thus easily not know that one of those modules + contained an instance for Borked. As a result, + we could accidentally and silently change the behaviour of our + third module simply by importing the second instance, and we + probably wouldn't notice until runtime. The rule against + overlapping instances rule ensures that the compiler issues an + error instead. + + + + Relaxing the rules for overlapping instances + + &GHC; supports a language extension, + OverlappingInstances, that chooses the most + specific among a set of overlapping instances when possible. + Although it can be convenient, it suffers from the problem we + outline above, and the rules that apply to its use are subtle + and complicated. + + As with all of &GHC;'s tuning knobs that loosen the + restrictions on the type checker, we recommend using this + extension only sparingly, and with great care. In the + sections that follow, we'll describe how to modify our code to + work without with extension. + + + + + hunk ./examples/ch06/result.js 1 +/** snippet result */ +{ + "query": "awkward squad haskell", + "estimatedCount": 3920, + "moreResults": true, + "results": + [{ + "title": "Simon Peyton Jones: papers", + "snippet": "Tackling the awkward squad: monadic input/output ...", + "url": "http://research.microsoft.com/~simonpj/papers/marktoberdorf/", + }, + { + "title": "Haskell for C Programmers | Lambda the Ultimate", + "snippet": "... the best job of all the tutorials I've read ...", + "url": "http://lambda-the-ultimate.org/node/724", + }] +} +/** /snippet result */ hunk ./examples/ch07/ClassResult.hs 1 +import JSONClass + +result :: JValue +result = toJValue (jobject [ + ("query", toJValue "awkward squad haskell"), + ("estimatedCount", toJValue (3920::Int)), + ("moreResults", toJValue True) + ]) + +{- +result = jobject [ + ("query", "awkward squad haskell"), + ("estimatedCount", 3920), + ("moreResults", True), + ("results", JArray [ + JObject [ + ("title", JString "Simon Peyton Jones: papers"), + ("snippet", JString "Tackling the awkward ..."), + ("url", JString "http://.../marktoberdorf/") + ]]) + ] +-} hunk ./examples/ch07/JSONClass.hs 1 -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-- snippet LANGUAGE --} +{-# LANGUAGE TypeSynonymInstances #-} +{-- /snippet LANGUAGE --} hunk ./examples/ch07/JSONClass.hs 35 - | JNumber !Rational + | JNumber Double hunk ./examples/ch07/JSONClass.hs 42 +{-- snippet class --} hunk ./examples/ch07/JSONClass.hs 52 - -rationalToJValue :: (Rational -> a) -> JValue -> Either JSONError a -rationalToJValue f (JNumber v) = Right (f v) -rationalToJValue _ _ = Left "not a JSON number" +{-- /snippet class --} hunk ./examples/ch07/JSONClass.hs 54 +{-- snippet String --} hunk ./examples/ch07/JSONClass.hs 59 +{-- /snippet String --} + +{-- snippet doubleToJValue --} +doubleToJValue :: (Double -> a) -> JValue -> Either JSONError a +doubleToJValue f (JNumber v) = Right (f v) +doubleToJValue _ _ = Left "not a JSON number" hunk ./examples/ch07/JSONClass.hs 67 - toJValue = JNumber . toRational - fromJValue = rationalToJValue round + toJValue = JNumber . realToFrac + fromJValue = doubleToJValue round hunk ./examples/ch07/JSONClass.hs 71 - toJValue = JNumber . toRational - fromJValue = rationalToJValue round + toJValue = JNumber . realToFrac + fromJValue = doubleToJValue round hunk ./examples/ch07/JSONClass.hs 75 - toJValue = JNumber . toRational - fromJValue = rationalToJValue fromRational - -instance JSON Rational where hunk ./examples/ch07/JSONClass.hs 76 - fromJValue = rationalToJValue id + fromJValue = doubleToJValue id +{-- /snippet doubleToJValue --} hunk ./examples/ch07/JSONClass.hs 98 +{-- snippet Bool --} hunk ./examples/ch07/JSONClass.hs 103 +{-- /snippet Bool --} hunk ./examples/ch07/Overlap.hs 1 +{-# LANGUAGE FlexibleInstances #-} + +{-- snippet Borked --} +class Borked a where + bork :: a -> String + +instance Borked Int where + bork = show + +instance Borked (Int, Int) where + bork (a, b) = bork a ++ ", " ++ bork b + +instance (Borked a, Borked b) => Borked (a, b) where + bork (a, b) = ">>" ++ bork a ++ " " ++ bork b ++ "<<" +{-- /snippet Borked --} + +{-- snippet wimply --} +instance Borked a => Borked (Int, a) where + bork (a, b) = bork a ++ ", " ++ bork b + +instance Borked a => Borked (a, Int) where + bork (a, b) = bork a ++ ", " ++ bork b +{-- /snippet wimply --} hunk ./examples/ch07/brokenClass.ghci 1 +--# load +:load BrokenClass + +--# use +toJValue [("foo","bar")] hunk ./tools/Snip.hs 42 + "js" -> (startC, endC) }