选择具有重叠定义的最正确的 FromJSON 实例

Pick the most correct FromJSON instance with overlapping definitions

我有一种不寻常的用例,用于支持通过 JSON 通信并具有大量 Maybe 值的记录的多个版本。

data VersionedThing = V1 Thing1 | V2 Thing2 

data Thing1 = Thing { 
  name :: Maybe String,
  val1 :: Maybe String,
  val2 :: Maybe String,
}

data Thing2 = Thing { 
  name :: Maybe String,
  val3 :: Maybe String,
  val4 :: Maybe String,
} 

instance FromJSON Thing1 where 
  parseJSON (Object v) = Thing <$> v.: "name" <*> v.:? "val1" <*> v .:? "val2"

instance FromJSON Thing2 where 
  parseJSON (Object v) = Thing <$> v.: "name" <*> v.:? "val3" <*> v .:? "val4"

instance FromJSON (VersionedThing) where
  parseJSON v = (V1 <$> parseJSON v)
        `mplus` (V2 <$> parseJSON v) 

我的问题是,因为这些记录共享一个没有其他要求的名称字段,代表特定版本的 JSON 将始终能够被解析为另一个版本。

例如解码JSON

{
  "name":"Foo",
  "val3":"Bar",
  "val4":"Baz"
}

可以产生 haskell 个值:

Thing1 (Just "Foo") Nothing Nothing 

Thing2 (Just "Foo") (Just "Bar") (Just "Baz)

有没有一种方法可以编写 VersionedThingFromJSON 实例,使其始终解析 "most correct" 值中的任何一个,而不是简单地使用第一个来成功?

这是我的计划:在解析时,我们将跟踪查看了哪些键。不使用对象的所有键的解析器将失败。这是您的序言,充实完整且可编译:

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad.Writer
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Functor.Compose
import Data.HashMap.Lazy (HashMap)
import Data.Text (Text)
import qualified Data.HashMap.Lazy as HM

data VersionedThing = V1 Thing1 | V2 Thing2 deriving (Eq, Ord, Read, Show)

data Thing1 = Thing1
    { name :: Maybe String
    , val1 :: Maybe String
    , val2 :: Maybe String
    } deriving (Eq, Ord, Read, Show)

data Thing2 = Thing2
    { name :: Maybe String
    , val3 :: Maybe String
    , val4 :: Maybe String
    } deriving (Eq, Ord, Read, Show)

现在我们将同时添加一个用于解析和跟踪的类型,以及 "just parse without tracking" 和 "just track without parsing" 的嵌入。

type ParseAndTrack = Compose Parser (Writer (HashMap Text ()))

parse :: Parser a -> ParseAndTrack a
track :: Text -> ParseAndTrack ()

parse p = Compose (pure <$> p)
track t = Compose . pure . tell $ HM.singleton t ()

我们可以使用这两个原语将 (.:)(.:?) 提升到自己的跟踪版本。我们将为解析和跟踪的内容使用后缀 &

(.:&) :: FromJSON a => Object -> Text -> ParseAndTrack a
o .:& t = track t *> parse (o .: t)

(.:?&) :: FromJSON a => Object -> Text -> ParseAndTrack (Maybe a)
o .:?& t = (Just <$> (o .:& t)) <|> pure Nothing

最后,我们将提供一种从 "parse-and-track" 模式回落到 "parse-only" 模式的顶级方法,如果我们没有使用所有可用的密钥,则会失败。

consumeAllOf :: Object -> ParseAndTrack a -> Parser a
consumeAllOf o p = do
    (result, keys) <- runWriter <$> getCompose p
    let unusedKeys = HM.difference o keys
    unless (null unusedKeys) . fail $
        "unrecognized keys " ++ show (HM.keys unusedKeys)
    return result

现在我们可以使用上面的附加工具编写您的两个解析器,一切都应该可以正常工作了。 Thing1Thing2 的解析器的唯一区别是我们在前面抛出一个 consumeAllOf 并在中间使用 .:.:? 的跟踪版本.

instance FromJSON Thing1 where
    parseJSON (Object v) = consumeAllOf v $ Thing1 <$> v.:& "name" <*> v.:?& "val1" <*> v .:?& "val2"

instance FromJSON Thing2 where
    parseJSON (Object v) = consumeAllOf v $ Thing2 <$> v.:& "name" <*> v.:?& "val3" <*> v .:?& "val4"

instance FromJSON (VersionedThing) where
    parseJSON v = (V1 <$> parseJSON v)
          `mplus` (V2 <$> parseJSON v)

在 ghci 中尝试:

> decode "{\"name\": \"foo\", \"val1\": \"bar\"}" :: Maybe VersionedThing
Just (V1 (Thing1 {name = Just "foo", val1 = Just "bar", val2 = Nothing}))
> decode "{\"name\": \"foo\", \"val3\": \"bar\"}" :: Maybe VersionedThing
Just (V2 (Thing2 {name = Just "foo", val3 = Just "bar", val4 = Nothing}))