Deriving Semigroup for HKD records

SG.hs

{-# LANGUAGE
    AllowAmbiguousTypes,
    DeriveGeneric,
    FlexibleInstances,
    QuantifiedConstraints,
    TypeApplications,
    UndecidableInstances
  #-}
import GHC.Generics
import Control.Applicative
import Data.Monoid
import Generic.Data
import Data.Functor.Const
import Data.Coerce

newtype IdentityT f a = IT (f a)

newtype WrapHKD f a = WrapHKD (HKD f a)

type family HKD f a where
  HKD (Const u) a = u
  HKD (IdentityT f) a = f a
  HKD (WrapHKD f) a = WrapHKD f a

data MyRec f = MyRec
  { _field1 :: HKD f Int
  , _field2 :: HKD f Bool
  } deriving Generic

instance (Semigroup u) => Semigroup (MyRec (Const u)) where
  (<>) = gmappend

-- instance (forall a. Semigroup (f a)) => Semigroup (MyRec (IdentityT f)) where
--   (<>) = gmappend

instance Alternative f => Semigroup (MyRec (IdentityT f)) where
  (<>) = gcoerceBinop (gmappend @(MyRec (IdentityT (Alt f))))

instance (forall a. (Semigroup (WrapHKD f a))) =>
  Semigroup (MyRec (WrapHKD f)) where
  (<>) = gmappend

data MyRec' f = MyRec'
  { _field1' :: HKD f Int
  , _field2' :: HKD f Bool
  } deriving Generic

instance (forall a. (Semigroup (WrapHKD f a))) =>
  Semigroup (MyRec' f) where
  (<>) = gcoerceBinop (gmappend @(MyRec' (WrapHKD f)))

instance Semigroup (HKD f a) => Semigroup (WrapHKD f a) where
  (<>) = coerce ((<>) @(HKD f a))

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

gcoerceBinop :: forall a b. (Coercible (Rep a) (Rep b), Generic a, Generic b) => (a -> a -> a) -> (b -> b -> b)
gcoerceBinop (<>) x y = gcoerce (gcoerce x <> gcoerce y)

data MyRec'' f = MyRec''
  { _field1'' :: HKD f Int
  , _field2'' :: HKD f Bool
  } deriving Generic

instance Semigroup (Rep (MyRec'' f) ()) => Semigroup (MyRec'' f) where
  (<>) = gmappend