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

```haskell {-# 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. ```haskell 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.