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以下内容。在每一点上它都会检测到格式不正确的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

Answer 2

从罗马的好解决方案中重新整理一下。我认为这可能更具可读性。

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)

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

2 个答案: