[Describe modules Bryan O'Sullivan **20080221065603] { addfile ./examples/ch06/PrettyJSON.hs hunk ./en/ch06-library.xml 68 - If we save the source file again, we can reload it in + If we save the modified source file, we can reload it in hunk ./en/ch06-library.xml 73 + A few more accessor functions, and we've got a small body of + code to work with. + + &SimpleJSON.hs:getters; + + + + + The anatomy of a Haskell module + + A Haskell source file contains a single + module. A module lets us determine which + namesinside the module are accessible from other modules. + + Normally, a source file begins with a module + declaration. + + &SimpleJSON.hs:module; + + The word module is reserved. It is followed by + the name of the module. By convention, the source file has the + same base name as the module, which is why our + file SimpleJSON.hs contains the module + SimpleJSON. + + Following the module name is a list of + exports, enclosed in parentheses. The + where keyword indicates that the body of the module + follows. + + The list of exports indicates which names in this module are + visible from other modules. This lets us keep private code + hidden from the outside world. The special notation + (..) that follows the name JValue + indicates that we are exporting both the type and all of its + constructors. + + It might seem strange that we can export a type's name, but + not its constructors. The ability to do this is important: it + lets us hide the details of a type from its users, making the + type abstract. If we can't see a type's + constructors, we can't pattern match against a value of that + type, nor can we construct a new value of that type. Later in + this chapter, we'll discuss some situations in which we might + want to make a type abstract. + + If we omit the list of exports (including the parentheses) + from a module declaration, every name in the module will be + exported: module SimpleJSON where .... To export + no names at all (only infrequently useful), we write an empty + list using a pair of parentheses: module SimpleJSON () + where .... hunk ./examples/ch06/PrettyJSON.hs 1 +module PrettyJSON + ( + jvalue + ) where + +import SimpleJSON (JValue(..)) +import Prettify (Doc, (<>), (<+>), char, double, enclose, encloseC, fsep, hcat, punctuate, text) +import Numeric (showHex) +import Data.Bits (shiftR, (.&.)) + +jvalue :: JValue -> Doc +jvalue (JString s) = string s +jvalue (JNumber n) = double n +jvalue (JObject o) = series (encloseC '{' '}') field o +jvalue (JArray a) = series (encloseC '(' ')') jvalue a +jvalue (JBool True) = text "true" +jvalue (JBool False) = text "false" +jvalue JNull = text "null" + +unicode :: Char -> Doc +unicode c | d < 0x10000 = ch d + | otherwise = astral (d - 0x10000) + where d = fromEnum c + ch x = text "\\u" <> text (replicate (4 - length h) '0') <> text h + where h = showHex x "" + astral n = ch (a + 0xd800) <> ch (b + 0xdc00) + where a = (n `shiftR` 10) .&. 0x3ff + b = n .&. 0x3ff + +string :: String -> Doc +string = encloseC '\"' '\"' . hcat . map one + where one c = case lookup c specials of + Just r -> text r + Nothing | c < ' ' || c > '\xff' -> unicode c + | otherwise -> char c + specials = zipWith ch "\b\n\f\r\t\\\"/" "bnrt\\\"/" + ch a b = (a, '\\':[b]) + +series :: (Doc -> Doc) -> (a -> Doc) -> [a] -> Doc +series open item = open . fsep . punctuate (char ',') . map item + +field :: (String, JValue) -> Doc +field (k,v) = string k <> char ':' <+> jvalue v + +-- Not present in Text.PrettyPrint.HughesPJ. + +--enclose :: Doc -> Doc -> Doc -> Doc +--enclose left right x = left <> x <> right + +--encloseC :: Char -> Char -> Doc -> Doc +--encloseC left right x = char left <> x <> char right hunk ./examples/ch06/SimpleJSON.hs 1 +{-- snippet module --} hunk ./examples/ch06/SimpleJSON.hs 5 - , jvalue + , getString + , getInt + , getDouble + , getBool + , getObject + , getArray + , isNull hunk ./examples/ch06/SimpleJSON.hs 13 - -import Prettify (Doc, (<>), (<+>), char, double, enclose, encloseC, fsep, hcat, punctuate, text) --- import Text.PrettyPrint.HughesPJ (Doc, (<>), (<+>), char, double, fsep, hcat, punctuate, text) -import Numeric (showHex) -import Data.Bits (shiftR, (.&.)) +{-- /snippet module --} hunk ./examples/ch06/SimpleJSON.hs 25 -jvalue :: JValue -> Doc -jvalue (JString s) = string s -jvalue (JNumber n) = double n -jvalue (JObject o) = series (encloseC '{' '}') field o -jvalue (JArray a) = series (encloseC '(' ')') jvalue a -jvalue (JBool True) = text "true" -jvalue (JBool False) = text "false" -jvalue JNull = text "null" - hunk ./examples/ch06/SimpleJSON.hs 31 -unicode :: Char -> Doc -unicode c | d < 0x10000 = ch d - | otherwise = astral (d - 0x10000) - where d = fromEnum c - ch x = text "\\u" <> text (replicate (4 - length h) '0') <> text h - where h = showHex x "" - astral n = ch (a + 0xd800) <> ch (b + 0xdc00) - where a = (n `shiftR` 10) .&. 0x3ff - b = n .&. 0x3ff - -string :: String -> Doc -string = encloseC '\"' '\"' . hcat . map one - where one c = case lookup c specials of - Just r -> text r - Nothing | c < ' ' || c > '\xff' -> unicode c - | otherwise -> char c - specials = zipWith ch "\b\n\f\r\t\\\"/" "bnrt\\\"/" - ch a b = (a, '\\':[b]) +{-- snippet getters --} +getInt (JNumber n) = Just (truncate n) +getInt _ = Nothing hunk ./examples/ch06/SimpleJSON.hs 35 -series :: (Doc -> Doc) -> (a -> Doc) -> [a] -> Doc -series open item = open . fsep . punctuate (char ',') . map item +getDouble (JNumber n) = Just n +getDouble _ = Nothing hunk ./examples/ch06/SimpleJSON.hs 38 -field :: (String, JValue) -> Doc -field (k,v) = string k <> char ':' <+> jvalue v +getBool (JBool b) = Just b +getBool _ = Nothing hunk ./examples/ch06/SimpleJSON.hs 41 --- Not present in Text.PrettyPrint.HughesPJ. +getObject (JObject o) = Just o +getObject _ = Nothing hunk ./examples/ch06/SimpleJSON.hs 44 ---enclose :: Doc -> Doc -> Doc -> Doc ---enclose left right x = left <> x <> right +getArray (JArray a) = Just a +getArray _ = Nothing hunk ./examples/ch06/SimpleJSON.hs 47 ---encloseC :: Char -> Char -> Doc -> Doc ---encloseC left right x = char left <> x <> char right +isNull v = v == JNull +{-- /snippet getters --} }