fun with Boehm-Berarducci encoding

bbencoding.hs

-- see https://www.haskellforall.com/2021/01/the-visitor-pattern-is-essentially-same.html
{-# LANGUAGE RankNTypes #-}

-- with ADTs:

data Shape
  = Circle Double Double Double
  | Rectangle Double Double Double Double
  deriving (Eq, Show)

area :: Shape -> Double
area (Circle _ _ r) = pi * r ^ 2
area (Rectangle _ _ w h) = w * h

-- with Boehm-Berarducci encoding

type Shape' = forall shape .
     (Double -> Double -> Double -> shape) -- "circle constructor"
  -> (Double -> Double -> Double -> Double -> shape) -- "rectangle constructor"
  -> shape

circle' :: Double -> Double -> Double -> Shape'
circle' x y z = \c _ -> c x y z

rectangle' :: Double -> Double -> Double -> Double -> Shape'
rectangle' x y w h = \_ r -> r x y w h

area' :: Shape' -> Double
area' s = s (\_ _ r -> pi * r ^ 2) (\_ _ w h -> w * h)

-- recursive ADT:

data Tree a
  = Node a (Tree a) (Tree a)
  | Leaf
  deriving (Eq, Show)

preorder :: Tree a -> [a]
preorder Leaf = []
preorder (Node x l r) = x : preorder l <> preorder r

-- recursive B-B encoding

type Tree' a = forall tree .
    (a -> tree -> tree -> tree) -- "node constructor"
 -> tree -- "leaf constructor"
 -> tree

node' :: a -> Tree' a -> Tree' a -> Tree' a
node' x l r = \node leaf -> node x (l node leaf) (r node leaf)

leaf' :: Tree' a
leaf' = \_ leaf -> leaf

preorder' :: Tree' a -> [a]
preorder' tree = tree (\x l r -> x : l ++ r) []