HKD deriving ToJSON with generic constraints

hkd-gc.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

import           Data.Coerce
import           Data.Functor.Identity
import           Data.Kind
import           GHC.Generics
import           Data.Aeson

type family HKD s 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)

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)

main = do
  print (encode (Person "John" 33 :: Person Identity))
  print (encode (Person (Just "John") Nothing :: Person Maybe))