Deriving Comonad through many different ways

repvia.hs

newtype (f `RepVia` via) a = RepVia (f a)

instance (Representable f, Coercible via (Rep f)) => Functor (f `RepVia` via) where
 fmap :: forall a b. (a -> b) -> ((f `RepVia` via) a -> (f `RepVia` via) b)
 fmap = coerce $ fmapRep @f @a @b

instance (Representable f, Coercible via (Rep f)) => Distributive (f `RepVia` via) where
 collect :: forall g a b. Functor g => (a -> (f `RepVia` via) b) -> (g a -> (f `RepVia` via) (g b))
 collect = coerce (collect @f @g @a @b)

instance (Representable f, Coercible via (Rep f)) => Representable (f `RepVia` via) where
 type Rep (f `RepVia` via) = via

 index :: (f `RepVia` via) a -> (via -> a)
 index (RepVia as) = coerce >>> index as

 tabulate :: (via -> a) -> (f `RepVia` via) a
 tabulate make = RepVia $ tabulate (\(coerce -> via) -> make via)

instance (Representable f, Coercible via (Rep f), Monoid via) => Comonad (f `RepVia` via) where
 extract :: forall a. (f `RepVia` via) a -> a
 extract = extractRep

 duplicate :: (f `RepVia` via) a -> (f `RepVia` via) ((f `RepVia` via) a)
 duplicate = duplicateRep

 extend :: ((f `RepVia` via) a -> b) -> ((f `RepVia` via) a -> (f `RepVia` via) b)
 extend = extendRep

data Pair a = a:#a
 deriving
 stock Show

 deriving (Functor, Comonad)
 via Pair `RepVia` Any
 -- >> extract (1·2)
 -- 1
 -- >> duplicate ((1·2) · (10·20))
 -- ((1·2) · (10·20)) · ((10·20) · (10·20))


 -- via Pair `RepVia` All
 -- >> extract (1·2)
 -- 2
 -- >> duplicate ((1·2) · (10·20))
 -- ((1·2) · (1·2)) · ((1·2) · (10·20))

instance Distributive Pair where
 distribute = distributeRep

instance Representable Pair where
 type Rep Pair = Bool

 index :: Pair a -> (Bool -> a)
 index (f:#t) = bool f t

 tabulate :: (Bool -> a) -> Pair a
 tabulate make = make False :# make True