Is it possible to get all contexts of a Traversable lazily?

Question

lens offers holesOf, which is a somewhat more general and powerful version of this hypothetical function:

holesList :: Traversable t
          => t a -> [(a, a -> t a)]

Given a container, holesList produces a list of elements of the container along with functions for replacing those elements.

The type of holesList, like that of the real holesOf, fails to capture the fact that the number of pairs produced will equal the number of elements of the container. A much more beautiful type, therefore, would be

holes :: Traversable t
      => t a -> t (a, a -> t a)

We could implement holes by using holesList to make a list and then traversing in State to slurp the elements back in. But this is unsatisfactory for two reasons, one of which has practical consequences:

1. The slurping code will have an unreachable error call to handle the case where the list runs empty before the traversal is complete. This is disgusting, but probably doesn't matter much to someone using the function.

2. Containers that extend infinitely to the left, or that bottom out on the left, won't work at all. Containers that extend very far to the left will be very inefficient to handle.

I'm wondering if there's any way around these problems. It's quite possible to capture the shape of the traversal using something like Magma in lens:

data FT a r where
  Pure :: r -> FT a r
  Single :: a -> FT a a
  Map :: (r -> s) -> FT a r -> FT a s
  Ap :: FT a (r -> s) -> FT a r -> FT a s

instance Functor (FT a) where
  fmap = Map
instance Applicative (FT a) where
  pure = Pure
  (<*>) = Ap

runFT :: FT a t -> t
runFT (Pure t) = t
runFT (Single a) = a
runFT (Map f x) = f (runFT x)
runFT (Ap fs xs) = runFT fs (runFT xs)

Now we have

runFT . traverse Single = id

traverse Single makes a tree full of elements along with the function applications needed to build them into a container. If we replace an element in the tree, we can runFT the result to get a container with that element replaced. Unfortunately, I am stuck: I don't know what the next step might look like.

---

Vague thoughts: adding another type parameter might help change element types. The Magma type does something like this, and it goes back at least as far as Zemyla's comment on Van Laarhoven's blog post about FunList.

Answer 1

Your existing solution calls runMag once for every branch in the tree defined by Ap constructors.

I haven't profiled anything, but as runMag is itself recursive, this might slow things down in a large tree.

An alternative would be to tie the knot so you're only (in effect) calling runMag once for the entire tree:

data Mag a b c where
  One :: a -> Mag a b b
  Pure :: c -> Mag a b c
  Ap :: Mag a b (c -> d) -> Mag a b c -> Mag a b d

instance Functor (Mag a b) where
  fmap = Ap . Pure

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes = \t -> 
    let m :: Mag a b (t b)
        m = traverse One t 
    in fst $ go id m m
  where
    go :: (x -> y)
       -> Mag a (a, a -> y) z
       -> Mag a a x
       -> (z, x)
    go f (One a)    (One _)    = ((a, f), a)
    go _ (Pure z)   (Pure x)   = (z, x)
    go f (Ap mg mi) (Ap mh mj) = 
      let ~(g, h) = go (f . ($j)) mg mh
          ~(i, j) = go (f .   h ) mi mj
      in (g i, h j)
    go _ _ _ = error "only called with same value twice, constructors must match"

Answer 2

I have not managed to find a really beautiful way to do this. That might be because I'm not clever enough, but I suspect it is an inherent limitation of the type of traverse. But I have found a way that's only a little bit ugly! The key indeed seems to be the extra type argument that Magma uses, which gives us the freedom to build a framework expecting a certain element type and then fill in the elements later.

data Mag a b t where
  Pure :: t -> Mag a b t
  Map :: (x -> t) -> Mag a b x -> Mag a b t
  Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
  One :: a -> Mag a b b

instance Functor (Mag a b) where
  fmap = Map

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

-- We only ever call this with id, so the extra generality
-- may be silly.
runMag :: forall a b t. (a -> b) -> Mag a b t -> t
runMag f = go
  where
    go :: forall u. Mag a b u -> u
    go (Pure t) = t
    go (One a) = f a
    go (Map f x) = f (go x)
    go (Ap fs xs) = go fs (go xs)

We recursively descend a value of type Mag x (a, a -> t a) (t (a, a -> t a)) in parallel with one of type Mag a a (t a) using the latter to produce the a and a -> t a values and the former as a framework for building t (a, a -> t) from those values. x will actually be a; it's left polymorphic to make the "type tetris" a little less confusing.

-- Precondition: the arguments should actually be the same;
-- only their types will differ. This justifies the impossibility
-- of non-matching constructors.
smash :: forall a x t u.
         Mag x (a, a -> t) u
      -> Mag a a t
      -> u
smash = go id
  where
    go :: forall r b.
          (r -> t)
       -> Mag x (a, a -> t) b
       -> Mag a a r
       -> b
    go f (Pure x) _ = x
    go f (One x) (One y) = (y, f)
    go f (Map g x) (Map h y) = g (go (f . h) x y)
    go f (Ap fs xs) (Ap gs ys) =
      (go (f . ($ runMag id ys)) fs gs)
      (go (f . runMag id gs) xs ys)
    go _ _ _ = error "Impossible!"

We actually produce both Mag values (of different types!) using a single call to traverse. These two values will actually be represented by a single structure in memory.

holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes t = smash mag mag
  where
    mag :: Mag a b (t b)
    mag = traverse One t

Now we can play with fun values like

holes (Reverse [1..])

where Reverse is from Data.Functor.Reverse.