Creating/consuming JSON in Haskell, with the help of pattern guards

I’m going to write about two Haskell things I’ve used today, both of which were new to me: first, creating/consuming JSON using Sigbjorn Finne‘s json library; second, using pattern guards to make the “consuming” part prettier than my first butt-ugly attempts.

Earlier today I googled a bit looking for examples of using the JSON library, but didn’t find any clear or immediately useful ones. There were a few examples of people rolling their own JSON stuff in Haskell, but obviously that wasn’t what I was after. (I’ve just noticed that Real World Haskell talks about JSON, but doesn’t appear to immediately answer my questions — though there is loads of good stuff there of course.) I just wanted something to get me going quickly with the problem at hand, really.

The context is this: I’m working on some code which represents models of devices’ user interfaces as finite automata and tries to do some analysis on that. I want to use JSON to pump FA models between implementations in at least two, and maybe more, languages. None of that is really relevant to the rest of this post, except perhaps in the next paragraph. :-)

I have an abstract data type representing what I call actions, which are essentially lists of transitions, which are just integers (the destination state). Actions may be deterministic (in which case each transition is just an integer) or nondeterministic (then each transition is a list of integers). Again, the meaning isn’t so important; what’s important is that my ADT looks like this:

data Action = DAction [Int] | NAction [[Int]]
  deriving (Eq, Ord, Show)

Now, having imported the appropriate JSON module…

import Text.JSON

… I need to make this type an instance of the JSON type class by defining showJSON and readJSON functions for creating and consuming JSON, respectively:

instance JSON Action where
    showJSON (DAction xs) = showJSON ("DAction", xs)
    showJSON (NAction xs) = showJSON ("NAction", xs)
    readJSON = Error "not yet implemented" -- See below!

Let’s start by thinking about showJSON. It’s important to note that showJSON doesn’t produce a serialised JSON string directly. Instead, there’s an intermediate representation: the JSValue ADT; you serialise values of that type using the JSON module’s encode or encodeStrict functions. This extra layer of abstraction is a big win, because when we’re consuming JSON, we don’t have to write any code to parse the serialised string: we just call decode (or decodeStrict) to turn the string (whose contents should never be very exotic: that’s the whole point) into a JSValue. Then, readJSON‘s job is to turn that JSValue back into our domain-specific representation, whatever that is. That was the bit I was having trouble with (which is why I haven’t shown it yet), but I recognise that doing it this way was a lot easier than parsing the serialised string representation would have been, so I’m thankful for the extra abstraction layer.

In my case (and, I suspect, in most), showJSON is rather straightforward, thanks to some already-existing JSON type class instances. I simply construct a pair whose first element is a string identifying the action type, and whose second element is the action’s transition list. The JSON module already defines instances of the JSON type class for pairs, Strings, lists, and Ints, so the corresponding showJSON functions (which I’ve never seen) do all the work for me. Win.

Time for an example; let’s define a simple Action value…

da :: Action
da = DAction [0,1,2]

and take a look at its JSValue and string representations in ghci:

*Data.FA.JSON> showJSON da
JSArray [JSString (JSONString {fromJSString = "DAction"}),JSArray [JSRational (0%1),JSRational (1%1),JSRational (2%1)]]
*Data.FA.JSON> putStrLn $ encode $ showJSON da
["DAction",[0,1,2]]

The JSValue is quite verbose, but if you compare it with the encoded string, you can comprehend its structure easily enough. JSON doesn’t have tuples, so the pair we fed showJSON has been turned into a two-element list (a JSArray). The string “DAction” is wrapped in a JSONString (a more efficient representation of String) inside a JSString constructor. The list of integers is a JSArray, but each Int is represented as a Rational: the JSON module doesn’t know how to serialise integers directly (AFAICS JSON can, in general?)

So far, so good: serialising my data structure to JSON is pretty easy. Lists of Actions, maps from Ints to Actions, etc. all “just work” too, out of the box: handy.

Extraction of an Action from a JSValue is trickier, and I am by no means confident that I’m doing it in the most sensible manner — though what I’m doing does work, at least! The type signature of readJSON is:

readJSON :: JSValue -> Result a

where Result is a bit like Maybe or Either: it’s either Ok a (it worked) or Error String (fail!). readJSON takes a JSValue, and depending on what the contents of our decoded JSON string were, this could be pretty much anything! So we have a pseudo-parsing situation: we need to match it against what we’re expecting, and if it doesn’t fit, we raise an error. In other words, we have to unpack it, layer by layer. Here’s what I came up with initially:

readJSONAction' :: JSValue -> Result Action
readJSONAction' value =
    case value of
      JSArray [a,b] ->
          case a of
            JSString jsTag -> 
                case (fromJSString jsTag) of
                  "DAction" ->
                    case (readJSONs b)::Result [Int] of
                      Ok xs -> Ok (DAction xs)
                      _ -> Error "can't decode deterministic actions"
                  "NAction" ->
                    case (readJSONs b)::Result [[Int]] of
                      Ok xs -> Ok (NAction xs)
                      _ -> Error "can't decode nondeterministic actions"
                  _ -> Error "Incorrect action tag"
            _ -> Error "can't decode action tag"
      _ -> Error "not an action" 

It sure does look ugly, as you’ll no doubt agree. It unpacks the JSValue bit by bit, using a case distinction to catch unexpected content, which is translated into an Error value. Note the explicit type-tagging in the deeply-nested calls to readJSONs: there are many instances of readJSONs and we need to be explicit about which one we want to call — and they’re different for the two different kinds of action.

This works…

*Data.FA.JSON> readJSON (showJSON da) :: Result Action
Ok (DAction [0,1,2])

… (again, we need to explicitl specify which readJSON we want), but it’s ugly as hell. My friend and colleage pwb suggested “pattern guards might make it prettier”. So I checked them out, and came up with this:

readJSONAction :: JSValue -> Result Action
readJSONAction value
  | JSArray [a,b] <- value
  , JSString jsTag <- a = checkContents jsTag b
  | otherwise = Error "not an action"
    where checkContents tag cargo
              | "DAction" <- (fromJSString tag)
              , Ok xs <- ((readJSONs cargo)::Result [Int])
                      = Ok (DAction xs)
              | "NAction" <- (fromJSString tag)
              , Ok xs <- ((readJSONs cargo)::Result [[Int]])
                      = Ok (NAction xs)
              | otherwise = Error "not an action"

The main disadvantage over the previous version is that we get less detailed error messages, but I think I can live with that for more readable code. It’s still fairly ugly though, and I’m not 100% sure why I need to break out the checkContents part (I did write it in a hurry).

I just can’t shake the nagging suspicion that I’m missing some clever and elegant way of doing this. So if anyone has any pointers, I’d love to hear them. Otherwise, I can at least testify that the above techniques work: maybe that’ll be useful for another JSON adventurer in a hurry, one day. :-)

7 Responses to “Creating/consuming JSON in Haskell, with the help of pattern guards”

  1. pwb
    January 8th, 2009 | 1:37 am

    I wonder why Text.JSON uses its own exotic error type rather than Either String a. The latter has a MonadError instance so you could use catchError in principle. Though in this case I don’t think it’d make your code any prettier.

    If you want more specific error messages, you might try the two patterns that are correct, then make the errors progressively less specific by replacing bits of the pattern with wildcards:

    readJSONAction (JSArray [JSString "DAction",cargo])
        | Ok xs <- readJSONs cargo = Ok (DAction xs)
        | otherwise                = Error "can't decode deterministic actions"
    readJSONAction (JSArray [JSString "NAction",cargo])
        | Ok xs <- readJSONs cargo = Ok (NAction xs)
        | otherwise                = Error "can't decode nondeterministic actions"
    -- errors from here on
    readJSONAction (JSArray [t,_])
        | JSString _ <- t = Error "Incorrect action tag"
        | otherwise       = Error "can't decode action tag"
    readJSONAction _      = Error "not an action"

  2. January 8th, 2009 | 7:17 am

    The list of integers is a JSArray, but each Int is represented as a Rational: the JSON module doesn’t know how to serialise integers directly (AFAICS JSON can, in general?)

    JSON (and JavaScript) doesn’t distinguish between types of numbers (floats, ints) at the type level, there is only a Number type. 1 is a valid number value, and that’s it (though it will be represented as an int internally, afaik).

    So I’m guessing Text.JSON takes a shortcut here and represents all numbers as rationals, fine by me.

  3. January 8th, 2009 | 10:21 am

    pwb, your suggestion doesn’t work because JSString "DAction" isn’t what’s actually there. You get:

    Data/FA/JSON.hs:21:35:
        Couldn't match expected type `JSString'
               against inferred type `[Char]'
        In the pattern: "DAction"
        In the pattern: JSString "DAction"
        In the pattern: [JSString "DAction", cargo]

    I can’t see any way to unpack that string without using fromJSString, and AFAICS that can’t be embedded in a pattern match?

    Other than that, yeah, yours looks nicer. :-)

  4. pwb
    January 10th, 2009 | 1:10 am

    You can embed it using -XOverloadedStringLiterals and an IsString instance for JSString, then the string literal pattern is desugared as an equality test.

  5. pwb
    January 10th, 2009 | 1:11 am

    Er, -XOverloadedStrings I mean.

  6. Max
    January 10th, 2009 | 4:25 am

    If Result isn’t an instance of MonadError, it should be. Write a patch!

  7. January 13th, 2009 | 2:58 pm

    Max: done! New version came out today with my patch. :-)