Replacing Functor contexts with quantified Coercible constraints

NewGenerics2.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
-- | Fleshing out a new design for Generic1 that doesn't use Functor contexts
-- for derived instances, but rather Coercible. Why would we want this?
-- Consider this derived Generic1 instance:
--
--   data T f a = T (f [a]) deriving Generic1
-- ==>
--   instance Functor f => Generic1 (T f a) where
--     type Rep1 (T f) =
--       D1 ('MetaData "T" "module" "package" 'True)
--         (C1 ('MetaCons "T" 'PrefixI 'False)
--           (S1 ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
--             (f :.: Rec [])))
--     from1 (T x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x))))
--     to1 (M1 (M1 (M1 x))) = T (fmap unRec1 (unComp1 x))
--
-- This is unsavory for two reasons:
--
-- 1. This requires that f be a Functor. This completely rules out some types
--    that we might want to use here.
-- 2. Moreover, it's inefficient! We're fmapping into a type just to run Rec1
--    and unRec1 (i.e., to wrap and unwrap a newtype).
--
-- Using Coercible instead of Functor resolves these two issues. Coercible
-- instances are autogenerated, so we don't need to worry about a type being
-- a Functor instance. And obviously, it's far more efficient to use coerce
-- than fmap.
module NewGenerics where

import Data.Coerce
import Data.Kind
import GHC.Generics
import NewGenericsAbstract

type Representational1 f = (forall a b. Coercible a b => Coercible (f a) (f b) :: Constraint)

data T f a = T (f [a])
deriving instance Show (f [a]) => Show (T f a)

instance Representational1 f => Generic1 (T f) where
  type Rep1 (T f) =
    D1 ('MetaData "T" "module" "package" 'True)
      (C1 ('MetaCons "T" 'PrefixI 'False)
        (S1 ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
          (f :.: Rec1 [])))
  from1 (T x) = M1 (M1 (M1 (Comp1 (coerce x))))
  to1 (M1 (M1 (M1 x))) = T (coerce (unComp1 x))

roundtrip :: Representational1 f => T f a -> T f a
roundtrip = to1 . from1

-- This works for your favorite types...
roundtripMaybe :: T Maybe a -> T Maybe a
roundtripMaybe = roundtrip

-- ...and it works for abstract types! That is, abstract types whose type parameter's
-- role is either representational or phantom.
--
-- It wouldn't work for abstract types whose parameter's role is nominal, but then
-- again, such a datatype shouldn't have a Functor instance anyways, so we're
-- not losing anything here.
roundtripAbstract :: T Abstract a -> T Abstract a
roundtripAbstract = roundtrip

newtype NotAFunctor a = NotAFunctor (a -> Int)

-- Most importantly, it works for things that aren't Functor instances.
roundtripNotAFunctor :: T NotAFunctor a -> T NotAFunctor a
roundtripNotAFunctor = roundtrip

NewGenericsAbstract.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RoleAnnotations #-}
-- | A simple abstract type
module NewGenericsAbstract (Abstract) where

data Abstract a = Abstract a