Aeson合并对象编码

Question

我希望解析和编写具有一些基本属性和其他一些单独属性的JSON对象。例如，假设我们有两种类型的对象User和Email。这两种类型共享相同的基本属性foo和bar，但它们具有特定于其类型的附加属性：

User:
{"foo": "foo", "bar": "bar", "user": "me", "age": "42"}

Email:
{"foo": "foo", "bar": "bar", "email": "me@example.com"}

我为单独的对象编写了FromJSON和ToJSON实例-- User、Email和Base。现在，我的想法是定义一个包装器对象，将Base和任何其他类型与FromJSON和ToJSON实例结合起来。

data Wrapper a = Wrapper Base a

instance FromJSON a => FromJSON (Wrapper a) where
  parseJSON = withObject "Wrapper" $ \v -> Wrapper <$> parseJSON (Object v) <*> parseJSON (Object v)

instance ToJSON a => ToJSON (Wrapper a) where
  toJSON (Wrapper base a) = Object (toObject "base" (toJSON base) <> toObject "custom" (toJSON a))
    where
      toObject :: Text -> Value -> KeyMap Value
      toObject _ (Object v) = v
      toObject key v = KeyMap.singleton (Key.fromText key) v

  toEncoding = genericToEncoding defaultOptions

FromJSON实现似乎运行得很好。此外，toJSON函数似乎将所有属性打包到一个对象中。不幸的是，我无法找到将两个Encoding合并在一起的解决方案。默认的toEncoding实现将基本属性和自定义属性封装在两个单独的JSON对象中，并且将底层Builder与unsafeToEncoding合并也没有帮助。

有什么aeson功能我完全没有，还是有更简单的方法来解决我的问题？任何帮助都是非常感谢的。谢谢!

更新

感谢Daniel的回答，我定义了一个新的类型类型ToObject，并使包装数据类型更加通用。

newtype Merged a b = Merged (a, b)
  deriving stock (Show, Generic)
  deriving newtype (Eq)

class ToObject a where
  toObject :: a -> Object
  toSeries :: a -> Series

instance (ToObject a, ToObject b) => ToObject (Merged a b) where
  toObject (Merged (a, b)) = toObject a <> toObject b
  toSeries (Merged (a, b)) = toSeries a <> toSeries b

instance (FromJSON a, FromJSON b) => FromJSON (Merged a b) where
  parseJSON = Json.withObject "Merged" $ \v -> fmap Merged ((,) <$> parseJSON (Object v) <*> parseJSON (Object v))

instance (ToObject a, ToObject b) => ToJSON (Merged a b) where
  toJSON = Object . toObject
  toEncoding = Json.pairs . toSeries

Answer 1

您可以使用pairs and pair构建所需的内容。

class ToObject a where toObject :: a -> Series

instance ToObject Base where
    toObject b = "foo" .= foo b <> "bar" .= bar b -- but no Ken, how sad
instance ToObject User where
    toObject u = "user" .= user u <> "age" .= age u
instance ToObject a => ToObject (Wrapper a) where
    toObject (Wrapper base a) = toObject base <> toObject a

instance (ToObject a, ToJSON a) => ToJSON (Wrapper a) where
    toJSON = -- as before
    toEncoding = pairs . toObject