¿Mi uso de Haskell's Text.JSON se considera feo?

Question

Lo que estoy tratando de hacer es realmente simple.

me gustaría convertir el siguiente JSON, que estoy recibiendo de una fuente externa:

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

en los siguientes tipos:

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

terminé escribiendo el siguiente código usando 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)] 

Esto tiene para el Haskell más poco elegante que he escrito. readJSON simplemente no se ve bien. Claro, showJSON es sustancialmente más corto, pero ¿qué pasa con este JSString $ toJSString y JSObject $ toJSObject cosas que estoy obligado a poner aquí? ¿Y resultToEither?

¿Estoy usando Text.JSON incorrecto? ¿Hay una mejor manera?

---

Bueno, esto es más como él. Obtuve readJSON de la siguiente manera gracias a las aclaraciones e ideas de Roman y Grazer. En cada punto detectará un JSON formateado incorrectamente y generará un error en lugar de lanzar una excepción.

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" 

Answer 1

¿Podría cambiar el título por algo más preciso? Desde "Haskell's Text.JSON considerado feo ..." a algo así como "Mi código usando Text.JSON considerado feo ..."

La mitad de tu código consiste en recursión explícita, ¿por qué la necesitas? Desde un vistazo rápido algo como mapM debería ser suficiente.

Actualización: código de ejemplo

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 

Answer 2

Reorganización de un poco de buena solución de Roman. Creo que esto puede ser un poco más legible.

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)