tags:

views:

166

answers:

2

What I am trying to do is really simple.

I'd like to convert the following JSON, which I'm getting from an external source:

[{"symbol": "sym1", "description": "desc1"}
 {"symbol": "sym1", "description": "desc1"}]

into the following types:

data Symbols = Symbols [Symbol]
type Symbol  = (String, String)

I ended up writing the following code using Text.JSON:

instance JSON Symbols where
  readJSON (JSArray arr) = either Error (Ok . Symbols) $ resultToEither (f arr [])
    where
      f ((JSObject obj):vs) acc = either Error (\x -> f vs (x:acc)) $ resultToEither (g (fromJSObject obj) [])
      f [] acc                  = Ok $ reverse acc
      f _ acc                   = Error "Invalid symbol/description list"

      g ((name, JSString val):vs) acc = g vs ((name, fromJSString val):acc)
      g [] acc                        = valg acc
      g _ acc                         = Error "Invalid symbol/description record"

      valg xs = case (sym, desc) of
        (Nothing, _)            -> Error "Record is missing symbol"
        (_, Nothing)            -> Error "Record is missing description"
        (Just sym', Just desc') -> Ok (sym', desc')
        where
          sym = lookup "symbol" xs
          desc = lookup "description" xs

  showJSON (Symbols syms) = JSArray $ map f syms
    where
      f (sym, desc) = JSObject $ toJSObject [("symbol", JSString $ toJSString sym),
                                             ("description", JSString $ toJSString desc)]

This has got to the the most inelegant Haskell I've ever written. readJSON just doesn't look right. Sure, showJSON is substantially shorter, but what is up with this JSString $ toJSString and JSObject $ toJSObject stuff I am forced to put in here? And resultToEither?

Am I using Text.JSON wrong? Is there a better way?


Okay this is more like it. I've gotten readJSON down to the following thanks to the clarifications and ideas from Roman and Grazer. At every point it will detect an incorrectly formatted JSON and output an error instead of throwing an exception.

instance JSON Symbols where
  readJSON o = fmap Symbols (readJSON o >>= mapM f)
    where
      f (JSObject o) = (,) <$> valFromObj "symbol" o <*> valFromObj "description" o
      f _            = Error "Unable to read object"
+5  A: 

Could you please change the title to something more precise? From "Haskell's Text.JSON considered ugly …" to something like "My code using Text.JSON considered ugly..."

Half of your code consists of explicit recursion -- why do you need it? From a quick look something like mapM should suffice.

Update: sample code

instance JSON Symbols where
  readJSON (JSArray arr) = fmap Symbols (f arr)
  f = mapM (\(JSObject obj) -> g . fromJSObject $ obj)
  g = valg . map (\(name, JSString val) -> (name, fromJSString val))

  valg xs = case (sym, desc) of
    (Nothing, _)            -> Error "Record is missing symbol"
    (_, Nothing)            -> Error "Record is missing description"
    (Just sym', Just desc') -> Ok (sym', desc')
    where 
      sym = lookup "symbol" xs
      desc = lookup "description" xs
Roman Cheplyaka
I can change the title, but I don't think it changes the question. How would you use mapM here where there are no monads involved to simplify?
qrest
`Result` *is* a monad (http://hackage.haskell.org/packages/archive/json/0.4.4/doc/html/Text-JSON.html#t:Result). I will now update my answer with a sample code. Note that I discarded a few error messages -- you can restore them if you want.
Roman Cheplyaka
To improve error handling (code that I showed may throw exceptions) write safe versions of pattern matching functions (for JSObject and JSString) which will return Error on pattern match failure and use them monadically.
Roman Cheplyaka
+2  A: 

Rearranging a little from Roman's nice solution. I think this may be a little more readable.

instance JSON Symbols where
  readJSON o = fmap Symbols (readJSON o >>= mapM f)
    where
      f (JSObject o) = let l = fromJSObject o
                       in do s <- jslookup "symbol" l
                             d <- jslookup "description" l
                             return (s,d)
      f _ = Error "Expected an Object"
      jslookup k l = maybe (Error $ "missing key : "++k) readJSON (lookup k l)
Grazer
What's in this solution is part of what I was trying to get to in my asking about the toJSObject, toJSString, oddities. jslookup, for example, illustrates that readJSON can effectively extract a string from a JSValue without having to go through all of that.
qrest
The 'fromJSObject' would probably not even be needed if there was a JSON instance that stored to JSObject. Actually, if the json package is compiled with MAP_AS_DICT, then it should be as simple as: readJSON :: Result [Map String String]. Then some simple fiddling to turn the Map into the structure you want
Grazer