Published on April 25, 2017

In response to the traverse-with-class 1.0 announcement, user Gurkenglas asks:

Can you use something like this to do something like

`gzipWith (+) :: (Int, Double) -> (Int, Double) -> (Int, Double)`

?

There are two separate challenges here:

- How do we traverse two structures in lockstep?
- How do we make sure that the values we are combining are of the same type?

Because traverse-with-class implements Michael D. Adams’s generic zipper, I first thought that it would suffice to traverse the two values simultaneously. That didn’t quite work out. That zipper is designed to traverse the structure in all four directions: not just left and right, but also up and down. Therefore, if we want to traverse an `(Int, Double)`

tuple with a `Num`

constraint, all possible substructures — including `(Int, Double)`

itself — must satisfy that constraint. The way this manifests itself is through `Rec c`

constraints, which cannot be satisfied for tuples without defining extra `Num`

instances.

It is possible to design a restricted zipper that would only travel left and right and will not impose any unnecessary constraints. But because we need only a simple one-way traversal, we can get away with something even simpler — a free applicative functor. (Indeed, a free applicative is a building block in Adams’s zipper.)

This is simple and beautiful: because a free applicative functor is an applicative functor, we can `gtraverse`

with it; and because a free applicative functor is essentially a heterogeneous list, we can zip two such things together.

Another way we could approach this is by using Oleg’s Zipper from any Traversable, which is based on the continuation monad. I haven’t tried it, but I think it should work, too.

Now we arrive at the second challenge. In traverse-with-class, when we traverse a heterogeneous value, we observe each field as having an existential type `exists a . c a => a`

. If the type of `(+)`

was something like `(Num a1, Num a2) => a1 -> a2 -> a1`

— as it is in many object-oriented languages — it would be fine. But in Haskell, we can only add two `Num`

values if they are of the same type.

Packages like one-liner or generics-sop use a type-indexed generic representation, so we can assert field-wise type equality of two structures at compile time. traverse-with-class is not typed in this sense, so we need to rely on run-time type checks via `Typeable`

.

The full code for `gzipWith`

is given below. Note that relying on Ørjan’s free applicative has two important consequences:

- We zip from right to left, so that
`gzipWith @Num (+) [1,2,3] [1,2]`

evaluates to`[3,5]`

, not`[2,4]`

. - For
`GTraversable`

instances that are right-associated (e.g. the standard`GTraversable`

instance for lists), the complexity is quadratic.

I believe that both of these issues can be resolved, but I don’t have the time to spend on this at the moment.

```
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances,
ConstraintKinds, RankNTypes, AllowAmbiguousTypes, TypeApplications,
UndecidableInstances, GADTs, UndecidableSuperClasses,
FlexibleContexts, TypeOperators #-}
import Data.Typeable
import Data.Generics.Traversable
-- TypeableAnd c is a synonym for (c a, Typeable a)
class (c a, Typeable a) => TypeableAnd c a
instance (c a, Typeable a) => TypeableAnd c a
-- Ørjan Johansen’s free applicative functor
data Free c a
= Pure a
| forall b. (c b, Typeable b) => Snoc (Free c (b -> a)) b
instance Functor (Free c) where
fmap f (Pure x) = Pure $ f x
fmap f (Snoc lft x) = Snoc (fmap (f .) lft) x
instance Applicative (Free c) where
pure = Pure
tx <*> Pure e = fmap ($ e) tx
tx <*> Snoc ty az = Snoc ((.) <$> tx <*> ty) az
unit :: TypeableAnd c b => b -> Free c b
unit = Snoc (Pure id)
toFree :: forall c a . GTraversable (TypeableAnd c) a => a -> Free c a
toFree = gtraverse @(TypeableAnd c) unit
fromFree :: Free c a -> a
fromFree free =
case free of
Pure a -> a
Snoc xs x -> fromFree xs x
zipFree :: (forall b . c b => b -> b -> b) -> Free c a -> Free c a -> Free c a
zipFree f free1 free2 =
case (free1, free2) of
(Pure a1, _) -> Pure a1
(_, Pure a2) -> Pure a2
(Snoc xs1 (x1 :: b1), Snoc xs2 (x2 :: b2)) ->
case (eqT :: Maybe (b1 :~: b2)) of
Nothing -> error "zipFree: incompatible types"
Just Refl -> Snoc (zipFree f xs1 xs2) (f x1 x2)
gzipWith
:: forall c a . GTraversable (TypeableAnd c) a
=> (forall b . c b => b -> b -> b)
-> a -> a -> a
gzipWith f a1 a2 = fromFree $ zipFree f (toFree @c a1) (toFree @c a2)
zippedTuple :: (Int, Double)
zippedTuple = gzipWith @Num (+) (1, 1) (3, pi)
-- (4,4.141592653589793)
```