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

這已經到了我所寫過的最不雅的哈斯克爾。 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)