Every witherable is a crosswalk

[mniip]

If we take a list and imagine extending it to fill all missing locations (locations past the end of the list) with a default value, e.g. like xs ++ repeat defx, then such constructions can be losslessly zipped together:

zipWith f (xs ++ repeat defx) (ys ++ repeat defy)
  = alignWith (uncurry f . fromThese defx defy) xs ys ++ repeat (f defx defy)

Of course if we have xs ++ repeat defx we can no longer take it apart into the "main" part and the "filler" part. Instead we may want do bookkeeping to keep them separate like this:

data FillList a = FillList [a] a
  deriving (Functor)
instance Applicative FillList where
  pure x = FillList [] x
  liftA2 f (FillList xs defx) (FillList ys defy)
    = FillList (alignWith (uncurry f . fromThese defx defy) xs ys) (f defx defy)

This easily generalizes to an arbitrary Align:

data Fill f a = Fill (f a) a
  deriving (Functor)
instance Align f => Applicative (Fill f) where
  pure x = Fill nil x
  liftA2 f (Fill xs defx) (Fill ys defy)
    = Fill (alignWith (uncurry f . fromThese defx defy) xs ys) (f defx defy)

Thus we have an Applicative that in a certain sense losslessly captures the Align operation:

alignWith' :: (Functor f, Applicative (Fill f)) => (These a b -> c) -> f a -> f b -> f c
alignWith' f xs ys = case liftA2 (alignWith @Maybe f)
    (Fill (Just <$> xs) Nothing)
    (Fill (Just <$> ys) Nothing)
  of Fill zs _defz -> fromJust <$> zs

The fromJust there is unfortunate but it's valid (it ultimately relies on functoriality and the fact that uncurry (align @Maybe) . fromThese Nothing Nothing . bimap Just Just = Just). (If anyone has any clever ideas regarding how to get rid of it, I'm all ears).

Generalizing to zipping arbitrarily many structures we obtain:

\xss -> case traverse (\xs -> Fill (Just <$> xs) Nothing) xss of
  Fill ys _defy -> ys
:: (Traversable t, Align f) => t (f a) -> f (t (Maybe a))

If t supports a catMaybes operation, i.e. is Filterable, we can turn into f (t a), and this operation in fact coincides with sequenceL:

sequenceL' :: (Traversable t, Filterable t, Align f) => t (f a) -> f (t a)
sequenceL' xs = case traverse (\x -> Fill (Just <$> x) Nothing) xs of
  Fill ys _ -> catMaybes <$> ys

Witherable is essentially Traversable + Filterable, so every Witherable is a Crosswalk. QuickCheck agrees:

> quickCheck $ \xs -> sequenceL' xs === sequenceL @Maybe @Maybe @Int xs
+++ OK, passed 100 tests.
> quickCheck $ \xs -> sequenceL' xs === sequenceL @Maybe @[] @Int xs
+++ OK, passed 100 tests.
> quickCheck $ \xs -> sequenceL' xs === sequenceL @Maybe @(Map Int) @Int xs
+++ OK, passed 100 tests.
> quickCheck $ \xs -> sequenceL' xs === sequenceL @[] @Maybe @Int xs
+++ OK, passed 100 tests.
> quickCheck $ \xs -> sequenceL' xs === sequenceL @[] @[] @Int xs
+++ OK, passed 100 tests.
> quickCheck $ \xs -> sequenceL' xs === sequenceL @[] @(Map Int) @Int xs
+++ OK, passed 100 tests.

An even more remarkable result is that every Crosswalk is almost a Filterable:

almostCatMaybes :: forall t a. Crosswalk t => t (Maybe a) -> Maybe (t a)
almostCatMaybes = sequenceL @t @Maybe @a

where the function returns Nothing in case all of the inputs were Nothing. This is significant for e.g. t ~ NonEmpty. But if we're implementing sequenceL from catMaybes then the catMaybes is never invoked with a container full of Nothing's (for a reason similar to the alignWith' case), so we can use catMaybes = fromJust . almostCatMaybes. This leads us to the final remarkable fact:

The complete behavior of sequenceL can be recovered from its Maybe specialization:

class Crosswalk t where
  {-# MINIMAL almostCatMaybes | sequenceL #-}
  almostCatMaybes :: t (Maybe a) -> Maybe (t a)
  almostCatMaybes = sequenceL

  sequenceL :: Align f => t (f a) -> f (t a)
  default sequenceL :: (Traversable t, Align f) => t (f a) -> f (t a)
  sequenceL xs = case traverse (\x -> Fill (Just <$> x) Nothing) xs of
    Fill ys _ -> fromJust . almostCatMaybes <$> ys