Applying a local match/rewrite globally using recursion schemes

Question

{-# LANGUAGE FlexibleContexts, DeriveFoldable, TemplateHaskell,
    TypeFamilies, DeriveFunctor, DeriveTraversable #-}
import Control.Applicative
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
import Data.Maybe

I want to rewrite a tree using a "local" rewriter:

data SKI = S | K | I | App SKI SKI deriving (Show)

makeBaseFunctor ''SKI

type Rewrite a = a -> Maybe a

match :: Rewrite SKI
match x = case x of
    App I x -> Just x
    _ -> Nothing

So I wrote rewriteGlobal function that applies the same match at different points in the tree. It takes a "local" Rewrite t and returns a global one. I only walk the tree once, there are no attempts to apply rewrites more than once per tree node until no more rewrites are possible.

However there are 2 ways to rewrite the tree. Each rewrite operates either on already rewritten subtree (WithChildren mode) or "original" subtree (WithoutChildren mode). In the latter case, the higher rewrite "wins".

Ignoring constraints on t, the type of rewriteGlobal is:

data ChildRewrites = WithChildren | WithoutChildren

rewriteGlobal :: ChildRewrites -> Rewrite t -> Rewrite t

Here is an implementation:

rewriteGlobal flag rewriteFn = para $ liftA2 (<|>)
    (rewriteFn . handleChildren flag)
    liftChildRewrites

handleChildren WithChildren = embed . fmap (uncurry fromMaybe)
handleChildren WithoutChildren = embed . fmap fst

liftChildRewrites cons | any (isJust . snd) cons = Just $ handleChildren WithChildren cons
liftChildRewrites _ = Nothing

liftChildRewrites and liftA2 (<|>) look particularly ugly.

The question is: cannot I do any better? The code is already short, so it's not about making it shorter. But am I heading in the right direction, or there are better approaches to distribution of local matches than a paramorphism, e.g. a better data structure, a monadic approach or a recursion scheme?

I don't have binders/names/capture avoiding substitutions, so (P)HOAS and similar approaches probably won't be any better. And I'm not implementing the SKI calculus, it's only a motivating example.

The following code can be used to test:

test = App I $ App S $ App I $ K

bar = [rewrite WithChildren match test, rewrite WithoutChildren match test]

The question is: are there any specific structures/methods designed for local rewrites? It's only opinion-based if such specialized approaches don't exist and general methods is the best I can do.

Applying a local match/rewrite globally using recursion schemes

0 Answers0