json - 我对 Haskell 的 Text.JSON 的使用被认为是丑陋的？

Question

我想做的是真的很简单 .

我想转换以下 JSON，这是我从外部来源获取的:

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

分为以下几种:

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

我最终使用 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)]

这已经是我写过的最不优雅的 Haskell 了。 readJSON只是看起来不对。当然， showJSON明显更短，但这是怎么回事 JSString $ toJSString和 JSObject $ toJSObject我被迫放在这里的东西？和 resultToEither ?

我使用 Text.JSON 错了吗？有没有更好的办法？

好吧，这更像它。我已经收到 readJSON感谢 Roman 和 Grazer 的澄清和想法。在每一点它都会检测到格式不正确的 JSON 并输出错误而不是抛出异常。

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

你能把标题改成更准确的吗？从“Haskell 的 Text.JSON 被认为丑陋……”到“我使用 Text.JSON 的代码被认为丑陋……”

您的一半代码由显式递归组成——为什么需要它？快速查看类似 mapM 的内容应该足够了。

更新:示例代码

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