[More verbiage. Bryan O'Sullivan **20080505060911] { hunk ./en/ch07a-json-typeclass.xml 112 - &JSONClass.hs:doubleToJValue; + &JSONClass.hs:doubleToJValue; hunk ./en/ch07a-json-typeclass.xml 123 - 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. + a list into what JSON calls an array. We won't worry about + implementation details just yet, so let's use + undefined as the bodies of the instance's + methods. hunk ./en/ch07a-json-typeclass.xml 128 - &BrokenClass.hs:array; + &BrokenClass.hs:array; hunk ./en/ch07a-json-typeclass.xml 133 - &BrokenClass.hs:object; + &BrokenClass.hs:object; hunk ./en/ch07a-json-typeclass.xml 135 - If we put these definitions into a source file and load them - into &ghci;, everything initially seems fine. + + When do overlapping instances cause problems? + + If we put these definitions into a source file and load + them into &ghci;, everything initially seems fine. hunk ./en/ch07a-json-typeclass.xml 143 - However, once we try to use the - list-of-pairs instance, we run into trouble. + However, once we try to use the + list-of-pairs instance, we run into trouble. hunk ./en/ch07a-json-typeclass.xml 148 - 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. + 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. hunk ./en/ch07a-json-typeclass.xml 154 - 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. + 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. hunk ./en/ch07a-json-typeclass.xml 158 - 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. + 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. hunk ./en/ch07a-json-typeclass.xml 164 - However, &GHC; is conservative by default, and insists that - there must be only one possible instance that it could use. It - will thus report an error if we try to use - bork. + However, &GHC; is conservative by default, and insists + that there must be only one possible instance that it could + use. It will thus report an error if we try to use + bork. hunk ./en/ch07a-json-typeclass.xml 169 - - When do overlapping instances cause an error? - - As we mentioned earlier, we can scatter instances of a - typeclass across several modules. &GHC; does not complain - about the mere existence of overlapping instances. Instead, - it only complains when we try to use a method of the affected - typeclass, when it is forced to make a decision about which - instance to use. - + + As we mentioned earlier, we can scatter instances of a + typeclass across several modules. &GHC; does not complain + about the mere existence of overlapping instances. Instead, + it only complains when we try to use a method of the + affected typeclass, when it is forced to make a decision + about which instance to use. + + hunk ./en/ch07a-json-typeclass.xml 225 - hunk ./en/ch07a-json-typeclass.xml 227 - Since the OverlappingInstances and + The OverlappingInstances and hunk ./en/ch07a-json-typeclass.xml 229 - specific to &GHC;, how does the machinery around the familiar - Show typeclass render [Char] - differently from [Int]? Via a clever - trick. + specific to &GHC;, and by definition were not present in + Haskell 98. However, the familiar Show typeclass + from Haskell 98 somehow renders a list of Char + differently from a list of Int. It achieves this + via a clever, but simple, trick. hunk ./en/ch07a-json-typeclass.xml 238 - implementation of showList renders using - square brackets and commas. The instance of Show - for Char provides a special implementation of - showList that uses double quotes and - escapes non-ASCII-printable characters. + implementation of showList renders + elements using square brackets and commas. The instance of + Show for [a] uses + showList. The instance of + Show for Char simply provides a + special implementation of showList that + uses double quotes and escapes non-ASCII-printable + characters. + + At least sometimes, then, we can avoid the need for the + OverlappingInstances extension with a little bit + of lateral thinking. hunk ./en/ch07a-json-typeclass.xml 339 - N constructor, and match against an unprotected - &undefined;. + N constructor from the expression, and match + against an unprotected &undefined;. hunk ./en/ch07a-json-typeclass.xml 344 - We didn't crash! Because there's no constructor present - at runtime, matching against N _ is actually + We don't crash! Because there's no constructor present at + runtime, matching against N _ is actually hunk ./en/ch07a-json-typeclass.xml 349 + + + Another perspective on newtype constructors + + Even though we use a newtype type's + constructor in the same way as a data type's + constructor, it really exists just to coerce a value between + the two types. + + In other words, when we apply the N + constructor in an expression, we coerce an expression from type + Int to type NewtypeInt as far as + we and the compiler are concerned, but absolutely nothing + happens at runtime. + + Similarly, when we match on the N + constructor in a pattern, we coerce an expression from type + NewtypeInt to Int, but again + there's no overhead involved at runtime. + + + + + Summary: the three ways of naming types + + Here's a brief recap of Haskell's three ways to introduce + new names for types. + + + + The data keyword introduces a truly new + albegraic data type. + + + The type keyword gives us a synonym to + use for an existing type. We can use the type and its + synonym interchangeably. + + + The newtype keyword gives an existing + type a distinct identity. The original type and the new + type are not interchangeable. + + hunk ./en/ch07a-json-typeclass.xml 394 + + + + JSON typeclasses without overlapping instances + + Enabling &GHC;'s support for overlapping instances might be + a tempting and quick way to make our JSON code happy, but it + won't teach us how to work with &newtype;. In any case, we will + on occasion be faced with several equally good instances, in + which case overlapping instances will not save us. + + Our first task, then, is to wrap up the list type so that + the compiler will not see it as a list. + + &JSONClass.hs:JAry; + + When we export this type from our module, we'll export the + complete details of the type. Our module header will look like + this: + + &JSONClassExport.hs:module; + + The (..) following the + JAry name means export all details of this + type. + + Usually, when we export a &newtype;, we do + not export the data constructor. Instead, + we define a function that applies the constructor for us. + + &JSONClass.hs:jary; + + We then export the type constructor, the deconstructor + function, and the construction function, but + not the data constructor. hunk ./en/ch07a-json-typeclass.xml 430 + &JSONClassExport.hs:abstract; + + However, the usual reason to avoid exporting the data + constructor is to hide the plumbing, keeping our + type abstract. When we don't export a type's data constructor, + clients of our library can only use the functions we provide to + construct and deconstruct values of that type. That gives us, + the library authors, the liberty to change our internal + representation if we need to. If we export the data + constructor, and decide to change the details of our type, we'll + run the risk of breaking any existing code that uses the + constructor. + + In this case, we really won't gain anything by making the + array wrapper abstract, so it makes more sense if we simply + export the entire definition. + + We provide another wrapper type that hides our + representation of a JSON object. + + &JSONClass.hs:JObj; + + With these types defined, we make small changes to the + definition of our JValue type. + + &JSONClass.hs:JValue; + + This change doesn't affect the instances of the + JSON typeclass that we've already written, but we'd + like to write instances for our new JAry and + JObj types. + + &JSONClass.hs:instance.JAry; + + Let's take a slow walk through the individual steps of + converting a JAry a to a JValue. Given + a list where we know that everything inside is a + JSON instance, converting it to a list of + JValues is easy. + + &JSONClass.hs:listToJValues; + + Taking this and wrapping it to become a JAry + JValue is just a matter of applying the &newtype;'s + type constructor. + + &JSONClass.hs:jvaluesToJAry; + + (Remember, this has no performance cost. We're just telling + the compiler to hide the fact that we're using a list.) To turn + this into a JValue, we apply another type + constructor. + + &JSONClass.hs:jaryOfJValuesToJValue; + + Assemble these pieces using function composition, and we get + a concise one-liner for converting to a + JValue. + + &JSONClass.hs:jaryToJValue; + + We have more work to do to convert from + a JValue to a JAry a, but we'll break + it into reusable parts. The basic function is + straightforward. + + &JSONClass.hs:jaryFromJValue; + + The whenRight function inspects its + argument: calls a function on it if it was created with the + Right constructor, and leaves a Left + value untouched. + + &JSONClass.hs:whenRight; + + More complicated is mapEithers. It + acts like the regular map function, but if + it ever encounters a Left value, it returns that + immediately, instead of continuing to accumulate a list of + Right values. + + &JSONClass.hs:mapEithers; + + Because the elements of the list hidden in the + JObj type have a little more structure, the code to + convert to and from a JValue is a bit more complex. + Fortunately, we can reuse the functions that we just + defined. + + &JSONClass.hs:instance.JObj; + + + Exercises + + + + + Load the Control.Arrow module into + &ghci;, and find out what the + second function does. + + + + + What is the type of (,)? When + you use it in &ghci;, what does it do? What about + (,,)? + + + + hunk ./en/ch16-monad-case.xml 494 - Now that we know about these functions, we can use one to - golf our definition of randomsIO, turning - it into a one-liner. + (Indeed, we already encountered + second, in .) We can use + first to golf our definition of + randomsIO, turning it into a + one-liner. hunk ./examples/ch07/BrokenClass.hs 1 -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, OverlappingInstances, TypeSynonymInstances #-} hunk ./examples/ch07/BrokenClass.hs 43 +{- hunk ./examples/ch07/BrokenClass.hs 55 +-} hunk ./examples/ch07/BrokenClass.hs 61 -{- hunk ./examples/ch07/BrokenClass.hs 71 --} hunk ./examples/ch07/JSONClass.hs 5 +{-- snippet module --} hunk ./examples/ch07/JSONClass.hs 10 - , JAry + , JAry(..) hunk ./examples/ch07/JSONClass.hs 12 - , fromJAry - , jarray hunk ./examples/ch07/JSONClass.hs 13 - , jobject hunk ./examples/ch07/JSONClass.hs 14 +{-- /snippet module --} hunk ./examples/ch07/JSONClass.hs 16 +{-- snippet instance.JObj --} hunk ./examples/ch07/JSONClass.hs 18 -import Control.Monad (liftM) hunk ./examples/ch07/JSONClass.hs 19 +instance (JSON a) => JSON (JObj a) where + toJValue = JObject . JObj . map (second toJValue) . fromJObj + fromJValue (JObject (JObj o)) = whenRight JObj (mapEithers unwrap o) + where unwrap (k,v) = whenRight ((,) k) (fromJValue v) + fromJValue _ = Left "not a JSON object" +{-- /snippet instance.JObj --} + +{-- snippet JAry --} hunk ./examples/ch07/JSONClass.hs 30 +{-- /snippet JAry --} hunk ./examples/ch07/JSONClass.hs 32 -jarray :: JSON a => [a] -> JAry a -jarray = JAry +{-- snippet jary --} +jary :: [a] -> JAry a +jary = JAry +{-- /snippet jary --} hunk ./examples/ch07/JSONClass.hs 37 +{-- snippet JObj --} hunk ./examples/ch07/JSONClass.hs 41 - -jobject :: JSON a => [(String, a)] -> JObj a -jobject = JObj +{-- /snippet JObj --} hunk ./examples/ch07/JSONClass.hs 43 +{-- snippet JValue --} hunk ./examples/ch07/JSONClass.hs 46 - | JObject (JObj JValue) - | JArray (JAry JValue) - | JBool !Bool + | JBool Bool hunk ./examples/ch07/JSONClass.hs 48 + | JObject (JObj JValue) -- was [(String, JValue)] + | JArray (JAry JValue) -- was [JValue] hunk ./examples/ch07/JSONClass.hs 51 +{-- /snippet JValue --} hunk ./examples/ch07/JSONClass.hs 90 +{-- snippet mapEithers --} hunk ./examples/ch07/JSONClass.hs 98 +{-- /snippet mapEithers --} hunk ./examples/ch07/JSONClass.hs 100 -instance (JSON a) => JSON (JAry a) where - toJValue = JArray . jarray . map toJValue . fromJAry - fromJValue (JArray a) = whenRight jarray (mapEithers fromJValue (fromJAry a)) - fromJValue _ = Left "not a JSON array" +{-- snippet listToJValues --} +listToJValues :: (JSON a) => [a] -> [JValue] +listToJValues = map toJValue +{-- /snippet listToJValues --} hunk ./examples/ch07/JSONClass.hs 105 -instance (JSON a) => JSON (JObj a) where - toJValue = JObject . jobject . map (second toJValue) . fromJObj - fromJValue (JObject o) = whenRight jobject (mapEithers unwrap (fromJObj o)) - where unwrap (k, v) = whenRight ((,) k) (fromJValue v) - fromJValue _ = Left "not a JSON object" +{-- snippet jvaluesToJAry --} +jvaluesToJAry :: [JValue] -> JAry JValue +jvaluesToJAry = JAry +{-- /snippet jvaluesToJAry --} + +{-- snippet jaryOfJValuesToJValue --} +jaryOfJValuesToJValue :: JAry JValue -> JValue +jaryOfJValuesToJValue = JArray +{-- /snippet jaryOfJValuesToJValue --} + +{-- snippet jaryToJValue --} +jaryToJValue = JArray . JAry . map toJValue . fromJAry +{-- /snippet jaryToJValue --} + +{-- snippet jaryFromJValue --} +jaryFromJValue (JArray (JAry a)) = + whenRight JAry (mapEithers fromJValue a) +jaryFromJValue _ = Left "not a JSON array" +{-- /snippet jaryFromJValue --} + +{-- snippet instance.JAry --} +jaryFromJValue :: (JSON a) => JValue -> Either JSONError (JAry a) + +jaryToJValue :: (JSON a) => JAry a -> JValue + +instance (JSON a) => JSON (JAry a) where + toJValue = jaryToJValue + fromJValue = jaryFromJValue +{-- /snippet instance.JAry --} hunk ./examples/ch07/JSONClass.hs 142 +{-- snippet whenRight --} hunk ./examples/ch07/JSONClass.hs 146 +{-- /snippet whenRight --} }