## Fun with Recursion Schemes

## Folding Algebras

I saw this post on reddit recently, and it got me thinking about recursion schemes. One of the primary motivations behind them is the reduction of boilerplate. The classic example is evaluation of arithmetic expressions:

```
data ExprF a
= LitF Integer
| (:+:) a a
| (:*:) a a
deriving Functor
type Expr = Fix ExprF
eval :: Expr -> Integer
= unfix >>> \case
eval LitF n -> n
:+: y -> eval x + eval y
x :*: y -> eval x * eval y x
```

The calls to `eval`

are the
boilerplate: this is where the main recursion scheme, `cata`

can help.

```
evalF :: Expr -> Integer
= cata $ \case
evalF LitF n -> n
:+: y -> x + y
x :*: y -> x * y x
```

I still feel like there’s boilerplate, though. Ideally I’d like to write this:

```
evalF :: Expr -> Integer
= cata $ ??? $ \case
evalF Lit -> id
Add -> (+)
Mul -> (*)
```

The `???`

needs to
be filled in. It’s a little tricky, though: the type of the algebra
changes depending on what expression it’s given. GADTs will allow us to
attach types to cases:

```
data ExprI a r f where
Lit :: ExprI a b (Integer -> b)
Add :: ExprI a b (a -> a -> b)
Mul :: ExprI a b (a -> a -> b)
```

The first type parameter is the same as the first type parameter to
`ExprF`

.
The second is the output type of the algebra, and the third is the type
of the fold required to produce that output type. The third type
parameter *depends* on the case matched in the GADT. Using this,
we can write a function which converts a fold/pattern match to a
standard algebra:

```
foldAlg :: (forall f. ExprI a r f -> f) -> (ExprF a -> r)
LitF i) = f Lit i
foldAlg f (:+: y) = f Add x y
foldAlg f (x :*: y) = f Mul x y foldAlg f (x
```

And finally, we can write the nice evaluation algebra:

```
evalF :: Expr -> Integer
= cata $ foldAlg $ \case
evalF Lit -> id
Add -> (+)
Mul -> (*)
```

I hacked together some quick template Haskell to generate the
matchers over here.
It uses a class `AsPatternFold`

:

```
class AsPatternFold x f | x -> f where
foldMatch :: (forall a. f r a -> a) -> (x -> r)
```

And you generate the extra data type, with an instance, by doing this:

`'ExprF makePatternFolds '`

The code it generates can be used like this:

```
evalF :: Expr -> Integer
= cata $ foldMatch $ \case
evalF LitI -> id
:+|) -> (+)
(:*|) -> (*) (
```

It’s terribly hacky at the moment, I may clean it up later.

## Record Case

There’s another approach to the same idea that is slightly more sensible, using record wildcards. You define a handler for you datatype (an algebra):

```
data ExprAlg a r
= ExprAlg
litF :: Integer -> r
{ (+:) :: a -> a -> r
, (*:) :: a -> a -> r } ,
```

Then, to use it, you define how to interact between the handler and the datatype, like before. The benefit is that record wildcard syntax allows you to piggy back on the function definition syntax, like so:

```
data ExprF a
= LitF Integer
| (:+:) a a
| (:*:) a a
'ExprF
makeHandler '
exprAlg :: ExprF Integer -> Integer
= index ExprFAlg {..} where
exprAlg = id
litF +:) = (+)
(*:) = (*) (
```

This approach is much more principled: the `index`

function, for example, comes from the adjunctions
package, from the `Representable`

class. That’s because those algebras are actually representable
functors, with their representation being the thing they match. They
also conform to a whole bunch of things automatically, letting you
combine them interesting ways.

## Printing Expressions

Properly printing expressions, with minimal parentheses, is a surprisingly difficult problem. Ramsey (1998) provides a solution of the form:

```
Assoc ao po) (Assoc ai pi) =
isParens side (pi <= po && (pi /= po || ai /= ao || ao /= side)
```

Using this, we can write an algebra for printing expressions. It should work in the general case, not just on the expression type defined above, so we need to make another unfixed functor to describe the printing of an expression:

```
data Side = L | R deriving Eq
data ShowExpr t e
= ShowLit { _repr :: t }
| Prefix { _repr :: t, _assoc :: (Int,Side), _child :: e }
| Postfix { _repr :: t, _assoc :: (Int,Side), _child :: e }
| Binary { _repr :: t, _assoc :: (Int,Side), _lchild :: e
_rchild :: e }
,deriving Functor
'ShowExpr makeLenses '
```

The lenses are probably overkill. For printing, we need not only the precedence of the current level, but also the precedence one level below. Seems like the perfect case for a zygomorphism:

```
showExprAlg :: Semigroup t
=> (t -> t)
-> ShowExpr t (Maybe (Int,Side), t)
-> t
= \case
showExprAlg prns ShowLit t -> t
Prefix t s (q,y) -> t <> ifPrns R s q y
Postfix t s (p,x) -> ifPrns L s p x <> t
Binary t s (p,x) (q,y) -> ifPrns L s p x <> t <> ifPrns R s q y
where
Just (ip,ia))
ifPrns sid (op,oa) (| ip < op || ip == op && (ia /= oa || sid /= oa) = prns
= id ifPrns _ _ _
```

The first argument to this algebra is the parenthesizing function.
This algebra works fine for when the `ShowExpr`

type
is already constructed:

```
showExpr' :: Semigroup t => (t -> t) -> Fix (ShowExpr t) -> t
= zygo (preview assoc) . showExprAlg showExpr'
```

But we still need to construct the `ShowExpr`

from
something else first. `hylo`

might
be a good fit:

`hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b`

But that performs a catamorphism after an anamorphism, and we want a zygomorphism after an anamorphism. Luckily, the recursion-schemes library is constructed in such a way that different schemes can be stuck together relatively easily:

```
hylozygo :: Functor f
=> (f a -> a) -> (f (a, b) -> b) -> (c -> f c) -> c -> b
= ghylo (distZygo x) distAna y (fmap Identity . z)
hylozygo x y z
showExpr :: Semigroup t
=> (t -> t)
-> (e -> ShowExpr t e)
-> e -> t
= hylozygo (preview assoc) . showExprAlg showExpr
```

Let’s try it out, with a right-associative operator this time to make things more difficult:

```
data ExprF a
= LitF Integer
| (:+:) a a
| (:*:) a a
| (:^:) a a
deriving Functor
'ExprF
makeHandler '
newtype Expr = Expr { runExpr :: ExprF Expr }
instance Num Expr where
fromInteger = Expr . LitF
+ y = Expr (x :+: y)
x * y = Expr (x :*: y)
x
infixr 8 ^*
(^*) :: Expr -> Expr -> Expr
^* y = Expr (x :^: y)
x
instance Show Expr where
show =
showExpr-> "(" ++ x ++ ")")
(\x index ExprFAlg {..} . runExpr)
(where
= ShowLit . show
litF +:) = Binary " + " (6,L)
(*:) = Binary " * " (7,L)
(^:) = Binary " ^ " (8,R) (
```

Since we only specified `Semigroup`

in
the definition of `showExpr`

, we
can use the more efficient difference-list definition of `Show`

:

```
instance Show Expr where
showsPrec _ =
. showExpr
appEndo Endo . showParen True . appEndo)
(index ExprFAlg {..} . runExpr)
(where
= ShowLit . Endo . shows
litF +:) = Binary (Endo (" + " ++)) (6,L)
(*:) = Binary (Endo (" * " ++)) (7,L)
(^:) = Binary (Endo (" ^ " ++)) (8,R)
(
1 ^* 2 ^* 3 -- 1 ^ 2 ^ 3
1 ^* 2) ^* 3 -- (1 ^ 2) ^ 3
(1 * 2 + 3 :: Expr -- 1 * 2 + 3
1 * (2 + 3) :: Expr -- 1 * (2 + 3)
```

*Software—Practice & Experience*28 (12): 1327–1356. http://www.cs.tufts.edu/%7Enr/pubs/unparse-abstract.html.