[More about early development Bryan O'Sullivan **20080223072249] { addfile ./examples/ch06/putjson.ghci addfile ./examples/ch06/PrettyStub.hs hunk ./en/ch06-library.xml 224 - Turning Haskell values into JSON data + Printing JSON data hunk ./en/ch06-library.xml 226 - Now that we have a Haskell representation for JSON's types, - we'd like to be able to take Haskell values and render them - as JSON data. + Now that we have a Haskell representation for + JSON's types, we'd like to be able to take Haskell values and + render them as JSON data. + + There are a few ways we could go about this. + Perhaps the most direct would be to write a rendering function + that prints a value in JSON form. We'll quickly show how to do + this, because it's about time we started interacting with the + outside world. Once we're done, we'll explore some more + interesting approaches. + + Since this will be our first example of printing data, we'll + be introducing some new functions and notation below. Rather + than cover these in depth, we'll skim over them, and defer a + more extended treatment until . + + &PutJSON.hs:module; + + The result type of putJValue is + IO (), where IO indicates that the + function performs I/O. The putStr function + prints a string, and show returns a string + representation of a Haskell value. + + Clearly, printing a simple JSON value is easy. + + &putjson.ghci:simple; + + A compound value requires a little more work, so we can + ensure that it's formatted correctly. + + &PutJSON.hs:putJValue; + + We've introduced one unfamiliar piece of notation here, the + &do; keyword. In this context, it lets us perform a series of + actions in sequence. + + To print a JObject value, we begin by printing + an opening brace. We must then determine whether we have zero + or more than zero key/value pairs to print, in order to get the + formatting right. If we have no pairs to print, we print + nothing + If you're already somewhat familiar with Haskell, you'll + know that this is not an idiomatic way to do nothing. We'll + introduce return () in . + . Otherwise, we print the first pair, then we loop + over all the pairs that follow, and print each one preceded by a + comma. (The forM_ function takes a list + and a function that can perform I/O, and applies the function to + every element of the list.) + + + + Another look at rendering JSON + + If simply printing JSON data is both obvious and easy, why + might we want to consider doing something else? For example, we + could easily to modify our printing code above to output to an + arbitrary file handle. However, if we wanted to compress the + data somehow before writing it out, we could not as easily adapt + the code to do this. + + If we separate the rendering from what we do with the + rendered data, we grant ourselves more flexibility. There are + several Haskell libraries that handle data compression, but they + all do so by providing very simple compression and decompression + functions: a compression function takes an uncompressed string + and returns a compressed string. If we write a function that + takes JSON data and produces a rendered string, we can build a + pipeline: we pass the rendered JSON into our desired compression + function, and get compressed, rendered JSON back. + + + To render JSON data, we'll begin by assuming that we already + have a generic rendering library: we'll develop its skeleton as + we go. After we're done writing our client code, we'll go back + and fill in the details of the rendering library. + + Instead of rendering straight to a string, we'll make our + JSON renderer work with values of a type that we'll call + Doc. The renderer won't be able to see any of the + internals of the Doc type: instead, it will call + functions from our rendering library, which will hide the + details from the client. + + By basing our generic rendering library on this abstract + Doc type, we can choose an implementation that is + flexible and efficient. + + We'll name our JSON rendering function + jvalue. Rendering one of the basic JSON + values is a straightforward business. + + &PrettyJSON.hs:jvalue; + + We'll write the text and + double functions as part of our generic + rendering library. + + + + + Developing Haskell code without going nuts + + During the early stages of our Haskell development + adventure, we have so many new, unfamiliar concepts to keep + track of at one time that it can be a challenge to write code + that compiles at all. + + As we write our first substantial body of code, it's a + huge help to pause every few minutes and + try to compile what we've produced so far. Because Haskell is + so strongly typed, if our code compiles cleanly, we're assuring + ourselves that we're not wandering too far off into the + programming weeds. + + One useful technique for quickly developing the skeleton of + a program is to write stub versions of + functions. For example, we mentioned above that our + text and double + functions would be part of our generic library. If we don't + provide definitions for those functions, our attempts to + compile early, compile often with our JSON + renderer will fail, as the compiler won't know anything about + those functions. To avoid this problem, we write stub functions + that don't do anything. + + &PrettyStub.hs:stubs; + + The special value undefined always typechecks, + no matter where we use it, but it will cause our program to + crash if we attempt to evaluate it. + + &prettystub.ghci:crash; + + By providing stub definitions for these functions, we allow + ourselves to compile our code, letting the compiler's type + checker ensure that our program is correctly typed. + + + Beware of type inference + + A Haskell compiler's ability to infer types is both + powerful and valuable. Early on, the temptation to omit as + many type declarations as possible can be strong: let's simply + make the compiler figure the whole lot out! + + There is, however, plenty of risk to omitting type + information: until we gain some experience, we're extremely + likely to write code that will fail to compile due to simple + type errors. When we omit type information, we give the + compiler more room to infer types that are logical, but + possibly not at all the types we thought we were using. The + error messages that result can be very difficult to + interpret. + + Every time we add a type signature, we remove a degree of + freedom from the type inference engine. This reduces the + likelihood of divergence between our understanding of our code + and the compiler's. Type declarations also act as shorthand + for us as readers, making it easier for us to do our own + mental inference of what must be going on in a body of + code. + + This is not to say that you need to pepper every tiny + fragment of code with a type declaration. It is, however, + generally a good idea to add a signature to every top-level + function and variable in your code. + + Because undefined will happily typecheck no + matter where we use it, it's especially important to write + type signatures when we use undefined to write + temporary stub definitions for functions whose bodies we don't + want to fill in yet. + hunk ./en/ch06-library.xml 404 - There are a few ways we could go about this. Perhaps the - most direct would be to write a rendering function that - prints a value in JSON form. hunk ./examples/ch06/PrettyJSON.hs 23 - 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 + 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 hunk ./examples/ch06/PrettyJSON.hs 31 -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 +string = encloseC '\"' '\"' . hcat . map oneChar + where oneChar c = case lookup c specials of + Just r -> text r + Nothing | c < ' ' || c > '\xff' -> unicode c + | otherwise -> char c hunk ./examples/ch06/PrettyStub.hs 1 +module PrettyStub where + +import Prettify (Doc(..)) + +{-- snippet text --} +text :: String -> Doc +text str = undefined + +double :: Double -> Doc +double num = undefined +{-- /snippet text --} hunk ./examples/ch06/PutJSON.hs 1 +{-- snippet module --} hunk ./examples/ch06/PutJSON.hs 4 +import Control.Monad (forM_) hunk ./examples/ch06/PutJSON.hs 7 +putJValue :: JValue -> IO () + hunk ./examples/ch06/PutJSON.hs 14 +{-- /snippet module --} hunk ./examples/ch06/PutJSON.hs 16 +{-- snippet putJValue --} hunk ./examples/ch06/PutJSON.hs 20 - [] -> return () + [] -> putStr "" hunk ./examples/ch06/PutJSON.hs 22 - putPairs ps + forM_ ps $ \q -> do putStr ", " + putPair q hunk ./examples/ch06/PutJSON.hs 28 - putPairs (p:ps) = do putStr ", " - putPair p - putPairs ps - putPairs [] = return () +{-- /snippet putJValue --} hunk ./examples/ch06/putjson.ghci 1 +--# simple +:load PutJSON +putJValue (JBool True) +putJValue (JString "foo") }