Newtype to specify Rep: deriving Representable via Pair `ShapedBy` Bool

[Icelandjack]

The generic Rep definition is too robotic, if I derive Representable Count I most likely don't want to index by Rep Count = Either () (Either () ()) but by something like data Move = Rock | Paper | Scissors!

data Count a = Count
  { rock     :: a
  , paper    :: a
  , scissors :: a
  }
  deriving stock (Functor, Generic1)
  deriving anyclass Distributive  -- dummy
  deriving anyclass Representable -- Rep Count = () `Either` () `Either` ()

I have implemented a via type that allows us to derive Representable with a specified Rep:

-- >> index (Count 1 2 3) Rock
-- 1
-- >> index (Count 1 2 3) Paper
-- 2
-- >> index (Count 1 2 3) Scissors
-- 3
data Count a = Count ..
  deriving stock (Functor, Generically1)
  deriving anyclass Distributive -- dummy

  deriving Representable via Count `ShapedBy` Move -- Rep Count = Move

data Move = Rock | Paper | Scissors deriving stock Generic

-- >> (pi :# 10) `index` False
-- 3.141592653589793
-- >> (pi :# 10) `index` True
-- 10.0
--
-- >> tabulate @Pair id
-- False :# True
data Pair a = a :# a
  deriving stock (Show, Functor, Generic1)
  deriving anyclass Distributive -- dummy

  deriving Representable via Pair `ShapedBy` Bool -- Rep Pair = Bool

{-# Language BlockArguments           #-}
{-# Language FlexibleContexts         #-}
{-# Language ImportQualifiedPost      #-}
{-# Language InstanceSigs             #-}
{-# Language PolyKinds                #-}
{-# Language RankNTypes               #-}
{-# Language ScopedTypeVariables      #-}
{-# Language StandaloneKindSignatures #-}
{-# Language TypeApplications         #-}
{-# Language TypeFamilies             #-}
{-# Language TypeOperators            #-}
{-# Language UndecidableInstances     #-}

import Data.Coerce
import Data.Distributive
import Data.Functor.Rep hiding (gtabulate, gindex)
import Data.Kind
import GHC.Generics hiding (Rep)
import GHC.Generics qualified as GHC

type    ShapedBy :: (k -> Type) -> argument -> (k -> Type)
newtype ShapedBy f arg a = ShapedBy (f a)

instance (Coercible (GHC.Rep rep ()) (RepToRep f), Generic1 f, Generic rep, GTabulate (Rep1 f), GIndex (Rep1 f)) => Functor (ShapedBy f rep) where
  fmap = fmapRep

instance (Coercible (GHC.Rep rep ()) (RepToRep f), Generic1 f, Generic rep, GTabulate (Rep1 f), GIndex (Rep1 f)) => Distributive (ShapedBy f rep) where
  distribute = distributeRep
  collect = collectRep

instance (Coercible (GHC.Rep rep ()) (RepToRep f), Generic1 f, Generic rep, GTabulate (Rep1 f), GIndex (Rep1 f)) => Representable (ShapedBy f rep) where
  type Rep (ShapedBy f rep) = rep
  index :: ShapedBy f rep a -> (rep -> a)
  index (ShapedBy as) = gindex as . roundtrip where

   roundtrip :: rep -> RepToRep f
   roundtrip = coerce . GHC.from @rep @()

  tabulate :: forall a. (rep -> a) -> ShapedBy f rep a
  tabulate make = ShapedBy $ gtabulate (make . roundtrip) where

   roundtrip :: RepToRep f -> rep
   roundtrip = GHC.to @rep @() . coerce

this uses the GRep' machinary from adjunctions except RepToRep' takes a generic representation and returns another generic representation.

type RepToRep :: (Type -> Type) -> Type
type RepToRep f = RepToRep' (Rep1 f) ()

gtabulate :: Generic1 f => GTabulate (Rep1 f) => (RepToRep f -> a) -> f a
gtabulate = to1 . gtabulate'

gindex :: Generic1 f => GIndex (Rep1 f) => f a -> RepToRep f -> a
gindex = gindex' . from1

type
  RepToRep' :: (Type -> Type) -> (Type -> Type)
type family
  RepToRep' rep
class GTabulate rep where
  gtabulate' :: (RepToRep' rep () -> a) -> rep a
class GIndex rep where
  gindex' :: rep a -> (RepToRep' rep () -> a)

type instance
  RepToRep' Par1 = U1
instance GTabulate Par1 where
  gtabulate' :: (U1 () -> a) -> Par1 a
  gtabulate' f = Par1 (f U1)
instance GIndex Par1 where
  gindex' :: Par1 a -> (U1 () -> a)
  gindex' (Par1 a) U1 = a

type instance
  RepToRep' (rep1 :*: rep2) = RepToRep' rep1 :+: RepToRep' rep2
instance (GTabulate rep1, GTabulate rep2) => GTabulate (rep1 :*: rep2) where
  gtabulate' :: ((RepToRep' rep1 :+: RepToRep' rep2) () -> a) -> (rep1 :*: rep2) a
  gtabulate' f = gtabulate' (f . L1) :*: gtabulate' (f . R1)
instance (GIndex rep1, GIndex rep2) => GIndex (rep1 :*: rep2) where
  gindex' :: (rep1 :*: rep2) a -> ((RepToRep' rep1 :+: RepToRep' rep2) () -> a)
  gindex' (a :*: _) (L1 i) = gindex' a i
  gindex' (_ :*: b) (R1 j) = gindex' b j

type instance
  RepToRep' (Rec1 f) = Rec0 (WrappedRep f)
instance Representable f => GTabulate (Rec1 f) where
  gtabulate' :: forall a. (Rec0 (WrappedRep f) () -> a) -> Rec1 f a
  gtabulate' = coerce do
    tabulate @f @a
instance Representable f => GIndex (Rec1 f) where
  gindex' :: forall a. Rec1 f a -> (Rec0 (WrappedRep f) () -> a)
  gindex' = coerce do
    index @f @a

type instance
  RepToRep' (M1 i c rep) = RepToRep' rep
instance GTabulate rep => GTabulate (M1 i c rep) where
  gtabulate' :: (RepToRep' rep () -> a) -> M1 i c rep a
  gtabulate' = M1 . gtabulate'
instance GIndex rep => GIndex (M1 i c rep) where
  gindex' :: M1 i c rep a -> (RepToRep' rep () -> a)
  gindex' = gindex' . unM1

type instance
  RepToRep' (f :.: rep) = Rec0 (WrappedRep f) :*: RepToRep' rep
instance (Representable f, GTabulate rep) => GTabulate (f :.: rep) where
  gtabulate' :: forall a. ((Rec0 (WrappedRep f) :*: RepToRep' rep) () -> a) -> (f :.: rep) a
  gtabulate' make = Comp1 do tabulate (gtabulate' <$> f) where
     f :: Rep f -> RepToRep' rep () -> a
     f a b = make (K1 (WrapRep a) :*: b)
instance (Representable f, GIndex rep) => GIndex (f :.: rep) where
  gindex' :: (f :.: rep) a -> ((Rec0 (WrappedRep f) :*: RepToRep' rep) () -> a)
  gindex' (Comp1 reps) (K1 (WrapRep a) :*: b) = gindex' (index reps a) b

[Icelandjack]

I haven't tested it much, and the name is up for grabs

[RyanGlScott]

I agree that the Generic1-based default is rather clunky to use, to the point where I'd be surprised if anyone was actually using it in practice. That default predates DerivingVia, and if I were to redesign this part of adjunctions from scratch, I'd reach for a solution similar to yours. That is to say: let's add something like this!

One minor hiccup: although Generically1 now exists in base, it would require an extremely recent version of base to use, and we'd like to have a wider GHC support window in adjunctions. For this reason, I think we should define our own version of Generically1 in adjunctions, but with a more specific name.

[Icelandjack]

It makes sense to add a newtype separate from base. Generically1 doesn't have a configuration parameter anyway.

An 'off-topic' question is how parameters should be handled and what your thoughts are on that. Should they be defined per library or defined in base where there is one common name like Generically? This comes up in this library but others like json and Arbitrary.

generic-random offers a suitable candidate for Arbitrary (Generically a) where everything is generated with uniform probability but it also has newtypes to tinker and customize the instances, is it worth fitting this into a singular mold?

deriving Arbitrary via GenericArbitrary '[2, 3, 5] X
deriving Arbitrary via GenericArbitrary '[1, 2, 3] `AndShrinking` X
deriving Arbitrary via GenericArbitraryRec '[2, 3, 5] X
deriving Arbitrary via GenericArbitraryG CustomGens '[2, 3, 5] X

[RyanGlScott]

I'm not sure what you mean by "parameters" in the context of adjunctions. I was imagining that the only thing you'd need to specify is the type to use as the Rep instance. Are there ever situations where you would want to configure things more than that?

[Icelandjack]

For this ticket we just need to add a single newtype that specifies the Rep type.

Obviously that only works when the generic representation lines up: eventually users will want to specify more intricate isomorphisms. That's not important now though.

I was wondering if all libraries should provide a custom newtype or if GenericallyAs :: Type -> config -> Type belongs in base or not

[Icelandjack]

A similar issue affects Co as well.

For example, we can only derive Comonad when Rep is a monoid

instance (Representable f, Monoid (Rep f)) => Comonad (Co f)

We might wish to have Rep Pair = Bool but get the Comonad behaviour via All or Any:

  deriving Comonad
  via CoOf Any Pair

[RyanGlScott]

For now, my inclination is to do whatever is simplest to specify, and the API you propose in https://github.com/ekmett/adjunctions/issues/71#issue-1177516196 fits the bill. My opinion is that the design space for type-level configurations is murky enough that it's not worth pursuing here—at least, not unless more users specifically ask for one point in the design space.