Haskell 从定义重叠的JSON实例中选择最正确的

我有一种不同寻常的用例，用于支持通过JSON进行通信的记录的多个版本，并且具有大量的

值，可能是
值

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) 

可以产生haskell值：

Thing1 (Just "Foo") Nothing Nothing 

或

有没有一种方法可以从JSON编写我的
VersionedThing
实例，它总是解析“最正确”的值，而不是简单地使用第一个值来成功
 我的计划是：在解析时，我们将跟踪所查看的键。不使用对象所有键的解析器将失败。以下是您的前言，内容充实，完整且可编译：

{-# 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)

现在，我们将同时添加一个用于解析和跟踪的类型，以及“只解析而不跟踪”和“只跟踪而不解析”的嵌入

最后，我们将给出一种从“解析并跟踪”模式返回到“仅解析”模式的顶级方法，如果我们没有使用所有可用的键，则会失败

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

在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}))

如果该对象同时包含“val1”和“val3”怎么办？如果里面一个也没有呢？我认为“最正确”需要更好地定义。如果不允许“val1”和“val3”共存，则在解析Thing1时如果看到“val3”，则会导致解析失败。您将只能得到类似于
Thing1
或
Thing2
的JSON。我可以选择一个只有“名称”的任意默认情况。真正的问题是，这可能会发展到两个以上的数据版本，我希望有一些更具可扩展性的内容，而不仅仅是寻找在某些情况下不应该出现的字段。因此，“最正确”将是使用最少数量的
Nothing
进行解码的数据类型。如果，如果所有字段都为Nothing，则解析将失败，该怎么办？我想这会解决你的问题。（例如：对于Thing1，parseJSON（objectv）=do{n这可能行得通……但我宁愿不必更改
Thing1
或
Thing2
的
parseJSON
实例。我的总体目标是允许数据的多个版本共存，所以我宁愿不更改任何以前的定义。我想我可以解码它们，然后重新编码到
对象中e> ，然后查看
HashMap
的长度以查看成功的键数。但这也让人感觉很不舒服。编写一个评分函数，告诉解析有多好（例如，Just的数量）。然后尝试所有解析并选择得分最高的一个。两个旁白。为什么不使用
HashSet Text
而不是
HashMap Text（）
？理想情况下，您会使用
HM.keysHashSet o==keys
而不是
null（HM.difference o keys）
。但是
HM.keysHashSet
似乎不存在！真可惜。为什么不使用
Writer…Parser
而不是
编写解析器（Writer…）
并获得一个
Monad
实例来使用？这可能很好，但在这样做之前，我想检查
（）
是否跟踪了正确的事情，而我太懒了，在写我的答案之前，我没有这样做。谢谢你写这篇文章！我总体上喜欢这个解决方案（它比我的其他一些想法优雅得多）。理想情况下，我不想修改我以前的
Thing1
和
Thing2
解析器，只想修改
VersionedThing
的解析器，但这也给了我一些关于如何使其工作的好主意。@jkeuhlen我想另一个有趣的组合器是
roundtripping:：ToJSON a=>（Value->Parser a）->（Value->Parser a）；roundtrippp v=do{a你想把这个替代方法编辑到你的答案中吗？我想我会把这两种方法的一部分结合起来，最终得到我的解决方案
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

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

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)

> 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}))