Is there an efficient, lazy way to fuse foldMap with traverse?

Question

A recent proposal on the Haskell libraries mailing list led me to consider the following:

ft :: (Applicative f, Monoid m, Traversable t)
   -> (b -> m) -> (a -> f b) -> t a -> f m
ft f g xs = foldMap f <$> traverse g xs

I noticed that the Traversable constraint can be weakened to Foldable:

import Data.Monoid (Ap (..))  -- Requires a recent base version

ft :: (Applicative f, Monoid m, Foldable t)
   -> (b -> m) -> (a -> f b) -> t a -> f m
ft f g = getAp . foldMap (Ap . fmap f . g)

In the original proposal, f was supposed to be id, leading to

foldMapA
  :: (Applicative f, Monoid m, Foldable t)
   -> (a -> f m) -> t a -> f m
--foldMapA g = getAp . foldMap (Ap . fmap id . g)
foldMapA g = getAp . foldMap (Ap . g)

which is strictly better than the traverse-then-fold approach.

But in the more general ft, there's a potential problem: fmap could be expensive in the f functor, in which case the fused version could potentially be more expensive than the original!

The usual tools for dealing with expensive fmap are Yoneda and Coyoneda. Since we need to lift many times and only lower once, Coyoneda is the one that can help us:

import Data.Functor.Coyoneda

ft' :: (Applicative f, Monoid m, Foldable t)
    => (b -> m) -> (a -> f b) -> t a -> f m
ft' f g = lowerCoyoneda . getAp
  . foldMap (Ap . fmap f . liftCoyoneda . g)

So now we replace all those expensive fmaps with one (buried in lowerCoyoneda). Problem solved? Not quite.

The trouble with Coyoneda is that its liftA2 is strict. So if we write something like

import Data.Monoid (First (..))

ft' (First . Just) Identity $ 1 : undefined
-- or, importing Data.Functor.Reverse,
ft' (Last . Just) Identity (Reverse $ 1 : undefined)

then it will fail, whereas ft has no trouble with those. Is there a way to have our cake and eat it too? That is, a version that uses only a Foldable constraint, only fmaps O(1) times more than traverse in the f functor, and is just as lazy as ft?

---

Note: we could make liftA2 for Coyoneda somewhat lazier:

liftA2 f m n = liftCoyoneda $
  case (m, n) of
    (Coyoneda g x, Coyoneda h y) -> liftA2 (\p q -> f (g p) (h q)) x y

This is enough to let it produce an answer to ft' (First . Just) Identity $ 1 : 2 : undefined, but not to ft' (First . Just) Identity $ 1 : undefined. I don't see any obvious way to make it lazier than that, because pattern matches on existentials must always be strict.

Answer 1

I don't believe it's possible. Avoiding fmaps at the elements seems to require some knowledge of the structure of the container. For example, the Traversable instance for lists can be written

traverse f (x : xs) = liftA2 (:) (f x) (traverse f xs)

We know that the first argument of (:) is a single element, so we can use liftA2 to combine the process of mapping over the action for that element with the process of combining the result of that action with the result associated with the rest of the list.

In a more generic context, the structure of a fold can be captured faithfully using a magma type with a bogus Monoid instance:

data Magma a = Bin (Magma a) (Magma a) | Leaf a | Nil
  deriving (Functor, Foldable, Traversable)

instance Semigroup (Magma a) where
  (<>) = Bin
instance Monoid (Magma a) where
  mempty = Nil

toMagma :: Foldable t => t a -> Magma a
toMagma = foldMap Leaf

We can write

ft'' :: (Applicative f, Monoid m, Foldable t)
   => (b -> m) -> (a -> f b) -> t a -> f m
ft'' f g = fmap (lowerMagma f) . traverse g . toMagma

lowerMagma :: Monoid m => (a -> m) -> Magma a -> m
lowerMagma f (Bin x y) = lowerMagma f x <> lowerMagma f y
lowerMagma f (Leaf x) = f x
lowerMagma _ Nil = mempty

But there's trouble in the Traversable instance:

traverse f (Leaf x) = Leaf <$> f x

That's exactly the sort of trouble we were trying to avoid. And there's no lazy fix for it. If we encounter Bin l r, we can't lazily determine whether l or r are leaves. So we're stuck. If we allowed a Traversable constraint on ft'', we could capture the result of traversing with a richer sort of magma type (such as one used in lens), which I suspect could let us do something more clever though I haven't found anything yet.