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?

Answer 1

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

Answer 2

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))