Aeson merge object encodings

Question

I want to parse and write JSON objects that have some base attributes in common and some additional individual attributes. For example, let's say we have two types of objects User and Email. Both types share the same base attributes foo and bar, but they have additional attributes specific to their type:

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

Email:
{"foo": "foo", "bar": "bar", "email": "[email protected]"}

I have written FromJSON and ToJSON instances for the separate objects User, Email, and Base. Now my idea was to define a wrapper object combining Base and any other type with FromJSON and ToJSON instances.

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

The FromJSON implementations seems to work just fine. Also the toJSON function appears to pack all attributes into a single object. Unfortunately, I couldn't find a solution to merge the two Encodings together. The default toEncoding implementation packs the base and custom attributes in two separate JSON objects and merging the underlaying Builder with unsafeToEncoding doesn't help either.

Is there any aeson functionality I am missing completely or is there a much easier approach to solve my problem? Any help is appreciated. Thanks!

---

Update

Thanks to Daniel Wagner's answer I defined to a new typeclass ToObject and made the Wrapper data type a little more generic.

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

You can build what you need using 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