Recursion Schemes in Haskell

RecursionSchemesExample.hs

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}

import qualified Data.Text as T
import ClassyPrelude
import Data.Functor.Foldable

data Expr a
  = NumLit Int
  | Add a a
  | Div a a
  deriving (Show, Functor)

type ExprF = Fix Expr

type instance Base (Fix Expr) = Expr

litExpr :: Int -> ExprF
litExpr = Fix . NumLit

addExpr :: ExprF -> ExprF -> ExprF
addExpr a b = Fix $ Add a b

divExpr :: ExprF -> ExprF -> ExprF
divExpr a b = Fix $ Div a b

exprEvaluatorCata :: ExprF -> Int
exprEvaluatorCata = cata algebra
  where
    algebra :: Expr Int -> Int
    algebra expr = case expr of
      NumLit a -> a
      (Add a b) -> a + b
      (Div a b) -> a `ClassyPrelude.div` b

main :: IO ()
main = do
  let lit' = litExpr 5
  print $ exprEvaluatorCata lit'

  let add' = addExpr lit' (litExpr 15)
  print $ exprEvaluatorCata add'

  let div' = divExpr (litExpr 40) (litExpr 20)
  print $ exprEvaluatorCata div'

  let mixedExpression = divExpr add' div' -- equivalent to: (5 + 15) / (40 / 20) => 20 / 2 => 10
  print $ exprEvaluatorCata mixedExpression