使用Aeson合并JSON对象编码的问题与优化实现方案

我需要解析和写入包含公共基础属性与专属个性化属性的JSON对象。例如，User和Email两类对象共享foo、bar基础属性，同时各有专属属性：

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

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

我已经为User、Email和Base编写了FromJSON与ToJSON实例，尝试定义Wrapper类型来组合Base与其他具备JSON实例的类型：

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可以将所有属性打包为单个对象，但toEncoding无法合并两个Encoding——默认实现会把基础属性与自定义属性放入两个独立的JSON对象，用unsafeToEncoding合并底层Builder也无效。想问下是不是遗漏了Aeson的功能，或者有没有更简便的解决方案？

感谢Daniel Wagner的解答，我定义了新类型类ToObject，并将Wrapper改为更通用的Merged类型：

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

内容的提问来源于stack exchange，提问作者Lando-L