Question

我有一种不寻常的用例，用于支持通过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)

有没有办法以这样的方式编写FromJSON VersionedThing实例，以便始终解析“最正确”的值，而不是简单地使用第一个成功？

Answer 1

这是我的计划：在解析时，我们将跟踪我们查看过的密钥。不使用对象的所有键的分析器将失败。这是你的序言，充实并且可以完整和可编辑：

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

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

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

现在我们可以用上面的附加工具编写你的两个解析器，事情应该只是工作。 Thing1和Thing2解析器的唯一区别是我们在前面抛出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}))

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

1 个答案: