Deriving instances for higher-kinded data

Question

This question is based on the higher-kinded-data pattern, described in this Reasonably Polymorphic blog post.

In the following block of code, I define a type family HKD and a data type Person, where the fields may be either Maybe or Identity.

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies  #-}

import           Data.Aeson

-- "Higher Kinded Data" (http://reasonablypolymorphic.com//blog/higher-kinded-data)
type family HKD f a where
    HKD Identity a = a
    HKD Maybe a = Maybe a

data Person f = Person
  { pName :: HKD f String
  , pAge  :: HKD f Int
  } deriving (Generic)

I then attempt to derive a ToJSON instance for this type.

-- Already provided in imports:
-- instance ToJSON String
-- instance ToJSON Int
-- instance ToJSON a => ToJSON (Maybe a)

instance ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions

Unfortunately I get the following error:

No instance for (ToJSON (HKD f Int)) arising from a use of genericToJSON.

Given that I already have ToJSON Int and ToJSON (Maybe Int), shouldn't GHC be able to derive an instance ToJSON (HKD f Int)? My understanding is that type families act like type aliases with respect to instances. If that's the case, then I cannot define my own instances for it, but it should receive instances from its definions, in this case Int and Maybe Int. Unfortunately the error seems to contradict that.

How can I define a ToJSON instance for my type?

Answer 1

The type family HKD needs to be applied to a known Identity or Maybe to reduce. Otherwise, HKD f Int with an unknown f is just stuck, and we cannot resolve HKD f a constraints for all field types a, except by listing them in the context, for example (ToJSON (HKD f Int), ToJSON (HKD f String)), which is one possible solution but doesn't scale well to large numbers of fields.

Solution 1: Derive the context

The main problem is the tediousness of writing and maintaining the list of field constraints, this is solved by noting that it is really a function of the record type, and that we can define it in Haskell using GHC Generics.

type GToJSONFields a = GFields' ToJSON (Rep a)

-- Every field satisfies constraint c
type family GFields' (c :: * -> Constraint) (f :: * -> *) :: Constraint
type instance GFields' c (M1 i d f) = GFields' c f
type instance GFields' c (f :+: g) = (GFields' c f, GFields' c g)
type instance GFields' c (f :*: g) = (GFields' c f, GFields' c g)
type instance GFields' c U1 = ()
type instance GFields' c (K1 i a) = c a

instance (GToJSONFields (Person f)) => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions

However this instance is nonmodular and inefficient, because it still exposes the internal structure of the record (its field types), and constraints for every single field must be re-solved every time ToJSON (Person f) is used.

Gist of solution 1

Solution 2: Generalize the context

What we really want to write as an instance is this

instance (forall a. ToJSON a => ToJSON (HKD f a)) => ToJSON (Person f) where
  -- ...

which uses a quantified constraint, a new feature currently being implemented in GHC; hopefully the syntax is self-descriptive. But since it is not released yet, what can we do in the meantime?

A quantified constraint is currently encodable using a type class.

class ToJSON_HKD f where
  toJSON_HKD :: ToJSON a => f a -> Value  -- AllowAmbiguousTypes, or wrap this in a newtype (which we will define next anyway)

instance ToJSON_HKD Identity where
  toJSON_HKD = toJSON

instance ToJSON_HKD Maybe where
  toJSON_HKD = toJSON

But genericToJSON would use ToJSON on the fields, not ToJSON_HKD. We can will wrap the fields in a newtype that dispatches ToJSON constraints with a ToJSON_HKD constraint.

newtype Apply f a = Apply (HKD f a)

instance ToJSON_HKD f => ToJSON (Apply f a) where
  toJSON (Apply x) = toJSON_HKD @f @a x

The fields of Person can only be wrapped in HKD Identity or HKD Maybe. We should add one more case for HKD. In fact, let's make it open, and refactor the case for type constructors. We write HKD (Tc Maybe) a instead of HKD Maybe a; this is longer, but the Tc tag can be reused for any other type constructor, e.g., HKD (Tc (Apply f)) a.

-- Redefining HKD
type family HKD f a
type instance HKD Identity a = a
type instance HKD (Tc f) a = f a

data Tc (f :: * -> *)  -- Type-level tag for type constructors

aeson has a ToJSON1 type class whose role is quite similar to ToJSON_HKD, as an encoding of forall a. ToJSON a => ToJSON (f a). Serendipitously, Tc is just the right type to connect those classes.

instance ToJSON1 f => ToJSON_HKD (Tc f) where
  toJSON1_HKD = toJSON1

The next step is the wrapper itself.

wrapApply :: Person f -> Person (Tc (Apply f))
wrapApply = gcoerce

All we are doing is wrapping the fields in a newtype (from HKD f a to HKD (Tc (Apply f)) a, which is equal to Apply f a and representationally equivalent to HKD f a). So this is really a coercion. Unfortunately, coerce will not typecheck here, as Person f has a nominal type parameter (because it uses HKD, which matches on the name f to reduce). However, Person is a Generic type, and the generic representations of the input and expected output of wrapApply are in fact coercible. This gives rise to the following "generic coercion", which makes wrapApply superfluous:

gcoerce :: forall a b
        .  (Generic a, Generic b, Coercible (Rep a ()) (Rep b ()))
        => a -> b
gcoerce = to . (coerce :: Rep a () -> Rep b ()) . from

We conclude: wrap the fields in Apply, and use genericToJSON.

instance ToJSON_HKD f => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions . gcoerce @_ @(Person (Tc (Apply f)))

Gist of solution 2.

Note about the gist: HKD got renamed to (@@), a name borrowed from singletons, and HKD Identity a is rewritten as HKD Id a, making an explicit distinction between the type constructor Identity, and the defunctionalized symbol Id for the identity function. It looks neater to me.

Solution 3: Without type families

The HKD blog post combines two ideas:

1. Parameterizing records over a type constructor f (also called "functor functor pattern");

2. Generalizing f to be a type function, which is possible, even though Haskell doesn't have first-class functions at the type-level, thanks to the technique of defunctionalization.

The main goal of the second idea is to be able to reuse the record Person with unwrapped fields. That seems like quite a cosmetic concern for the amount of complexity type families introduce.

Looking closer, it could be argued that there is really not that much extra complexity. Is it worth it in the end? I don't have a good answer yet.

Just for reference, here's the result of applying the techniques above to a simpler record without the HKD type family.

data Person f = Person
  { name :: f String
  , age :: f Int
  }

We can remove two definitions: ToJSON_HKD (ToJSON1 suffices), and gcoerce (coerce suffices). We replace Apply with this other newtype connecting ToJSON and ToJSON1:

newtype Apply' f a = Apply' (f a)  -- no HKD

instance (ToJSON1 f, ToJSON a) => ToJSON (Apply' f a) where
  toJSON (Apply' x) = toJSON1 x

And we derive ToJSON as follows:

instance ToJSON1 f => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions . coerce @_ @(Person (Apply' f))

---

Caveat: Special field types

aeson has an option to make Maybe fields optional, so they are allowed to be missing in the corresponding JSON object. Well, that option doesn't work with the methods described above. It only affects the fields are known to be Maybe in the definition of the instance, so that fails for solutions 2 and 3 because of the newtypes around all fields.

Furthermore, for solution 1, this

instance {-# OVERLAPPING #-} ToJSON (Person Maybe) where
  toJSON = genericToJSON defaultOptions{omitNothingFields=True}

would behave differently from specializing this other instance after the fact to Person Maybe:

instance ... => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions{omitNothingFields=True}

Answer 2

author of the blog post here. Probably the easiest solution here is to just monomorphize your f parameter:

instance ToJSON (Person Identity) where
  toJSON = genericToJSON defaultOptions

instance ToJSON (Person Maybe) where
  toJSON = genericToJSON defaultOptions

It's kind of ugly, but certainly shippable. I'm in the lab currently trying to figure out better general solutions to this problem, and will let you know if I come up with anything.