How can I walk this type with a recursion scheme instead of explicit recursion?

Question

Consider this code:

import Data.Maybe (fromMaybe)

data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)

makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure
makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)
  where
    descend :: MyStructure -> MyStructure
    descend (Foo x) = Foo x
    descend (Bar x y) = Bar x (makeReplacements replacements y)
    descend (Baz x y) = Baz (makeReplacements replacements x) (makeReplacements replacements y)
    descend (Qux x y z w) = Qux x y (makeReplacements replacements z) (makeReplacements replacements w)

It defines a recursive data type, and a function that performs a search-and-replace by walking it. However, I'm using explicit recursion and would like to use a recursion scheme instead.

First, I threw in makeBaseFunctor ''MyStructure. For clarity, I expanded the resulting Template Haskell and the derived Functor instance below. I was then able to rewrite descend:

{-# LANGUAGE DeriveTraversable, TypeFamilies #-}

import Data.Maybe (fromMaybe)
import Data.Functor.Foldable (Base, Recursive(..), Corecursive(..))

data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)

makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure
makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)
  where
    descend :: MyStructure -> MyStructure
    descend = embed . fmap (makeReplacements replacements) . project

-- begin code that would normally be auto-generated
data MyStructureF r = FooF Int | BarF String r | BazF r r | QuxF Bool Bool r r deriving(Foldable,Traversable)

instance Functor MyStructureF where
  fmap _ (FooF x) = FooF x
  fmap f (BarF x y) = BarF x (f y)
  fmap f (BazF x y) = BazF (f x) (f y)
  fmap f (QuxF x y z w) = QuxF x y (f z) (f w)

type instance Base MyStructure = MyStructureF

instance Recursive MyStructure where
  project (Foo x) = FooF x
  project (Bar x y) = BarF x y
  project (Baz x y) = BazF x y
  project (Qux x y z w) = QuxF x y z w

instance Corecursive MyStructure where
  embed (FooF x) = Foo x
  embed (BarF x y) = Bar x y
  embed (BazF x y) = Baz x y
  embed (QuxF x y z w) = Qux x y z w
-- end code that would normally be auto-generated

If I were to stop here, I'd already have a win: I no longer have to write out all of the cases in descend, and I can't accidentally make a mistake like descend (Baz x y) = Baz x (makeReplacements replacements y) (forgetting to replace inside x). However, there's still explicit recursion here, since I'm still using makeReplacements from inside its own definition. How can I rewrite this to remove that, so that I'm doing all of my recursion inside of the recursion schemes?

I'm not sure I've followed your code correctly, but `descend` looks like a paramorphism to me. You want to look at the to-be-folded node first, to see if it should be replaced, and if not then you look at the already-recursively-folded result that a catamorphism would give you. Does the signature of [para](http://hackage.haskell.org/package/recursion-schemes-5.1.3/docs/Data-Functor-Foldable.html#v:para), specialized to your types, look promising? — amalloy, Sep 30 '19 at 22:26
@amalloy `para` is `(Base t (t, a) -> a) -> t -> a`. To me, this looks close but not quite perfect. Wouldn't I actually want `((t, Base t a) -> a) -> t -> a` or `((t, Base t (t, a)) -> a) -> t -> a` so that I can look at the element I'm on? — Joseph Sible-Reinstate Monica, Sep 30 '19 at 22:56

Joseph Sible-Reinstate Monica · Accepted Answer · 2019-10-01T13:40:00.747

I found a solution that I'm reasonably happy with: an apomorphism.

makeReplacements replacements = apo coalg
  where
    coalg :: MyStructure -> MyStructureF (Either MyStructure MyStructure)
    coalg structure = case lookup structure replacements of
      Just replacement -> Left <$> project replacement
      Nothing -> Right <$> project structure

Having thought about this a little more, I also saw a symmetry in this that leads to an equivalent paramorphism:

makeReplacements replacements = para alg
  where
    alg :: MyStructureF (MyStructure, MyStructure) -> MyStructure
    alg structure = case lookup (embed $ fst <$> structure) replacements of
      Just replacement -> replacement
      Nothing -> embed $ snd <$> structure

`apo` looks more apropos to me. In one sense my suggestion of `para`, the dual of `apo`, was very close; in another I was the wrongest it is possible to be! — amalloy, Oct 01 '19 at 21:05

score 3 · Answer 2 · answered Oct 01 '19 at 00:02

Following up from the discussion under your question

para is (Base t (t, a) -> a) -> t -> a. To me, this looks close but not quite perfect. Wouldn't I actually want ((t, Base t a) -> a) -> t -> a or ((t, Base t (t, a)) -> a) -> t -> a so that I can look at the element I'm on?

That's still a paramorphism. The type of para looks weird but it is the more precise one. A pair (t, Base t a) does not encode the invariant that both components are always going to have the "same" constructor.

What you propose still seems like the most natural way of defining makeReplacements, it's just not defined in the recursion-schemes library.

para' :: Recursive t => (t -> Base t a -> a) -> t -> a
para' alg = go where
  go x = alg x (fmap go (project x))

Perhaps it would be more enlightening to implement `para'` in terms of `para`, using `fmap fst` and `fmap snd`? — HTNW, Oct 01 '19 at 02:51
@HTNW Is that even possible without adding a `Corecursive` constraint? Without that, it looks like you can get a `Base t t` but not the `t` you need. — Joseph Sible-Reinstate Monica, Oct 01 '19 at 14:03

How can I walk this type with a recursion scheme instead of explicit recursion?

2 Answers2