Aeson：如何将JSON对象转换为键值类型列表并解析为自定义Haskell类型ThingComposition

你的核心问题是需要把JSON的键值对（String->Double）转换成ThingComposition类型，要么是合法的[(ThingType, Double)]列表，要么是InvalidThingComposition。你之前的尝试没处理好Parser monad的序列化解析逻辑，也没考虑如何优雅处理解析失败的场景。

下面是两种可行的实现方案，分别对应不同的错误处理策略：

方案1：捕获任何解析失败，返回Invalid #

如果只要有一个值无法解析成Double，就直接返回InvalidThingComposition，可以利用Parser的错误捕获机制：

import Data.Aeson
import Data.Aeson.Types (Parser, withObject, withText, catchError)
import Data.Text (Text)
import Data.Map (toList)

data ThingType = ThingTypeSome | ThingTypeOther | ThingTypeUnknown Text
txtToThing :: Text -> ThingType
txtToThing "some type of thing" = ThingTypeSome
txtToThing "other type of thing" = ThingTypeOther
txtToThing s = ThingTypeUnknown s

instance FromJSON ThingType where
  parseJSON val = withText "ThingType" (return . txtToThing) val

data ThingComposition = ThingComposition [(ThingType, Double)] | InvalidThingComposition

instance FromJSON ThingComposition where
  parseJSON val = withObject "ThingComposition" $ \obj -> do
    -- 将JSON对象转为键值对列表
    let keyValuePairs = toList obj
    -- 尝试解析所有键值对：键转ThingType，值转Double
    let parseAllPairs = traverse (\(key, value) -> 
                                   (txtToThing key,) <$> parseJSON value
                                 ) keyValuePairs
    -- 捕获解析错误，失败则返回空列表
    validPairs <- catchError parseAllPairs (\_ -> return [])
    -- 判断是否因解析失败导致空列表，返回对应结果
    if null validPairs && not (null keyValuePairs)
      then return InvalidThingComposition
      else return $ ThingComposition validPairs

逻辑说明： #

1. toList obj把JSON对象转换成[(Text, Value)]键值对列表；
2. traverse遍历每个键值对：键用txtToThing直接转成ThingType（因为键肯定是Text，不会失败），值解析成Double；
3. catchError捕获整个遍历过程中的任何解析错误（比如值不是数字），出错则返回空列表；
4. 最后判断：如果原键值对非空但解析结果为空，说明有解析失败，返回InvalidThingComposition；否则返回合法的ThingComposition。

方案2：逐个检查每个值的解析结果 #

如果你需要更细粒度的控制（比如潜在需要记录失败的键值对，但最终仍返回Invalid），可以用Maybe包裹每个Double的解析结果：

import Data.Aeson
import Data.Aeson.Types (Parser, withObject, withText)
import Data.Text (Text)
import Data.Map (toList)
import Data.Maybe (isJust)
import Control.Applicative ((<|>))

-- ThingType的定义和FromJSON实例同上

instance FromJSON ThingComposition where
  parseJSON val = withObject "ThingComposition" $ \obj -> do
    let keyValuePairs = toList obj
    -- 解析每个值为Double，失败则返回Nothing
    parsedPairs <- traverse (\(key, value) -> do
                               let thingType = txtToThing key
                               doubleVal <- (Just <$> parseJSON value) <|> return Nothing
                               return (thingType, doubleVal)
                           ) keyValuePairs
    -- 检查所有值都解析成功
    if all (isJust . snd) parsedPairs
      then let validPairs = map (\(tt, Just d) -> (tt, d)) parsedPairs
           in return $ ThingComposition validPairs
      else return InvalidThingComposition

逻辑说明： #

1. 对每个值，尝试解析成Double，成功则返回Just Double，失败则返回Nothing；
2. 检查所有解析结果的snd部分都是Just，如果是，就把Maybe解包成合法的列表；否则返回InvalidThingComposition。

为什么你之前的尝试不行？ #

你写的(return . ThingComposition) . map (bimap parseJSON parseJSON) . toList有两个核心问题：

1. parseJSON返回的是Parser a类型，map之后得到的是[(Parser ThingType, Parser Double)]，而不是你需要的Parser [(ThingType, Double)]——必须用traverse或sequence把单个的Parser组合成能生成列表的Parser；
2. 没有处理解析失败的情况，一旦某个值解析失败，整个Parser会直接抛出错误，而不是返回InvalidThingComposition。

内容的提问来源于stack exchange，提问作者GTF