2

此代码将递归 JSON 结构解析为我制作的 haskell 对象。我正在使用 Aeson 库。我遇到的问题是我希望能够轻松地进行错误检查，即使是递归调用。现在，每当发生错误时，我都会使用一个虚拟值 (ayyLmao)。但是，我想利用从 Parser monad 获得的错误检查。我该如何做到这一点并可能在此过程中清理我的代码？如有必要，我还可以发布一些示例 JSON。

编辑：我想指出我想摆脱“ayyLmao”（因此是愚蠢的名字），并以某种方式使用 Parser monad 的“mzero”来代替我的错误检查。

type Comments = Vector Comment

data Comment = Comment
    { author :: Text
    , body :: Text
    , replies :: Comments
    } deriving Show

-- empty placeholder value (only should appear when errors occur)
ayyLmao :: Comment
ayyLmao = Comment "Ayy" "Lmao" V.empty

parseComment :: Object -> Maybe Comments
parseComment obj = flip parseMaybe obj $ \listing -> do
    -- go through intermediate objects
    comments <- listing .: "data" >>= (.: "children")
    -- parse every comment in an array
    return $ flip fmap comments $ \commentData -> case commentData of
        -- if the data in the array is an object, parse the comment
        -- (using a dummy value on error)
        Object v -> fromMaybe ayyLmao (parseMaybe parseComment' v)
        -- use a dummy value for errors (we should only get objects in
        -- the array
        _ -> ayyLmao
        where
            parseComment' :: Object -> Parser Comment
            parseComment' v = do
                -- get all data from the object
                comment <- v .: "data"
                authorField <- comment .: "author"
                bodyField <- comment .: "body"
                replyObjs <- comment .: "replies"
                return $ case replyObjs of
                    -- if there are more objects, then parse recursively
                    Object more -> case parseComment more of
                        -- errors use the dummy value again
                        Just childReplies -> Comment authorField bodyField childReplies
                        Nothing -> ayyLmao
                    -- otherwise, we've reached the last comment in the
                    -- tree
                    _ -> Comment authorField bodyField V.empty

编辑：下面答案中的代码是正确的，但我想添加我修改后的解决方案。给出的解决方案假定“null”表示不再有回复，但由于某种原因，API 设计人员决定应该用空字符串表示。

instance FromJSON Comment where
    parseJSON = withObject "Comment" $ \obj -> do
        dat <- obj .: "data"
        commReplies <- dat .: "replies"
        Comment
            <$> dat .: "author"
            <*> dat .: "body"
            <*> case commReplies of
                Object _  -> getComments <$> dat .: "replies"
                String "" -> return V.empty
                _         -> fail "Expected more comments or a the empty string"
4

1 回答 1

3

你用“或者我可以有一个解析器列表，然后将它折叠到一个更大的解析器中”来达到目标​​。这正是您从嵌套解析器传播错误的方式。要删除的代码的最小更改ayyLmao是：

parseComment :: Object -> Maybe Comments
parseComment obj = flip parseMaybe obj $ \listing -> do
    -- go through intermediate objects
    comments <- listing .: "data" >>= (.: "children")
    -- parse every comment in an array
    V.sequence $ flip fmap comments $ \commentData -> case commentData of
        -- if the data in the array is an object, parse the comment
        -- (using a dummy value on error)
        Object v -> parseComment' v
        -- use a dummy value for errors (we should only get objects in
        -- the array
        _ -> mzero
        where
            parseComment' :: Object -> Parser Comment
            parseComment' v = do
                -- get all data from the object
                comment <- v .: "data"
                authorField <- comment .: "author"
                bodyField <- comment .: "body"
                replyObjs <- comment .: "replies"
                case replyObjs of
                    -- if there are more objects, then parse recursively
                    Object more -> case parseComment more of
                        -- errors use the dummy value again
                        Just childReplies -> return $ Comment authorField bodyField childReplies
                        Nothing -> mzero
                    -- otherwise, we've reached the last comment in the
                    -- tree
                    _ -> return $ Comment authorField bodyField V.empty

这mzero用于错误情况并从回复列表中传播错误V.sequence。sequence正是一个接受解析器列表（或者，在这种情况下，是一个向量）并折叠成一个成功或失败的解析器的东西。

但是，以上并不是一个很好的使用 aeson 的方法。通常最好派生一个FromJSON类型类的实例并从那里工作。我将上述实现为

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.Vector as V
import Data.Vector (Vector)
import Data.Text (Text)
import Data.Aeson
import Data.Maybe (fromMaybe)

import Control.Applicative

type Comments = Vector Comment

data Comment = Comment
    { author :: Text
    , body :: Text
    , replies :: Comments
    } deriving Show

newtype CommentList = CommentList { getComments :: Comments }

instance FromJSON Comment where
    parseJSON = withObject "Comment" $ \obj -> do
        dat <- obj .: "data"
        Comment
            <$> dat .: "author"
            <*> dat .: "body"
            <*> (fromMaybe V.empty . fmap getComments <$> dat .: "replies")

instance FromJSON CommentList where
    parseJSON = withObject "CommentList" $ \obj -> do
        dat <- obj .: "data"
        CommentList <$> dat .: "children"

这引入了一种包装类型CommentList，用于obj.data.children从 JSON 中获取属性。这利用了现有FromJSON实例的优势，Vector因此您不必手动遍历回复并单独解析它们。

表达方式

fromMaybe V.empty . fmap getComments <$> dat .: "replies"

假设repliesJSON 中的属性包含一个null值或一个有效值CommentList，因此它尝试解析一个Maybe CommentList值（null被解析为Nothing），然后使用Nothing用空向量替换一个值fromMaybe。

于 2014-09-11T04:44:01.487 回答