选择具有重叠定义的最正确的 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)
有没有一种方法可以编写 VersionedThing
的 FromJSON
实例,使其始终解析 "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
现在我们可以使用上面的附加工具编写您的两个解析器,一切都应该可以正常工作了。 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}))
我有一种不寻常的用例,用于支持通过 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)
有没有一种方法可以编写 VersionedThing
的 FromJSON
实例,使其始终解析 "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
现在我们可以使用上面的附加工具编写您的两个解析器,一切都应该可以正常工作了。 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}))