Improving DeriveTraversable

[David Feuer]

The role system is not currently able to use GND to derive Traversable
instances. While we wait for future research to solve that problem, I
think it would be nice to address a problem that can arise with
DeriveTraversable: when newtypes stack up, fmaps also stack up. I've
come up with a trick that I think could help solve the problem in at
least some important cases. There may be a nicer solution (perhaps
using associated types?), but I haven't found it yet. What I don't
know is whether this arrangement works for all important "shapes" of
newtypes, or what might be involved in automating it.

-- Represents a traversal that may come up with a type that's
-- a bit off, but not too far off. If you think about Coyoneda, this type
-- might make more sense. Whereas Coyoneda builds up larger and
-- larger *function compositions*, we just keep changing the coercion
-- types.
data Trav t b where
  Trav :: Coercible x (t b)
       => (forall f a . Applicative f => (a -> f b) -> t a -> f x)
       -> Trav t b

class (Foldable t, Functor t) => Traversable t where
  traverse :: Applicative f
           => (a -> f b) -> t a -> f (t b)

  -- This new method is not intended to be exported by Data.Traversable,
  -- but only by some ghc-special module.
  trav :: Trav t b
  trav = Trav traverse
  {-# INLINE trav #-}


Here are some sample newtype instances.

-- Convenience function from Data.Profunctor.Unsafe

(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
_ #. g = coerce g
{-# INLINE (#.) #-}

-- Convenience function for changing a Trav type
retrav :: Coercible u t => (forall a . u a -> t a) -> Trav t b -> Trav u b
retrav extr (Trav t) = Trav ((. extr) #. t)

-- Function for defining traverse proper. Note that this should
-- *only* be used to define traverse for newtype wrappers;
-- for other types, it will add an unnecessary fmap.

travTraverse :: forall f t a b . (Traversable t, Applicative f)
             => (a -> f b) -> t a -> f (t b)
travTraverse = case trav :: Trav t b of
  Trav t -> \f xs -> fmap coerce (t f xs)
{-# INLINE travTraverse #-}

-- Sample types

newtype F t x = F {getF :: t x} deriving (Functor, Foldable)
newtype G t x = G {getG :: t x} deriving (Functor, Foldable)
newtype H f x = H {getH :: F (G f) x} deriving (Functor, Foldable)

instance Traversable t => Traversable (F t) where
  traverse = travTraverse
  trav = retrav getF trav

instance Traversable t => Traversable (G t) where
  traverse = travTraverse
  trav = retrav getG trav

instance Traversable t => Traversable (H t) where
  traverse = travTraverse
  trav = retrav getH trav

With these instances, traversing H t a will perform one fmap instead of three.


David Feuer