Binary tree traversals using left and right folds

BT.hs

module BT where

data T a = E | L a | N a (T a) (T a) deriving Show

-- inorder foldr
inor :: (a -> b -> b) -> b -> T a -> b
inor _ v E         = v
inor f v (L a)     = f a v
inor f v (N a l r) = inor f (f a (inor f v r)) l

-- preorder foldr
prer :: (a -> b -> b) -> b -> T a -> b
prer _ v E         = v
prer f v (L a)     = f a v
prer f v (N a l r) = f a (prer f (prer f v r) l)

-- postorder foldr
posr :: (a -> b -> b) -> b -> T a -> b
posr _ v E         = v
posr f v (L a)     = f a v
posr f v (N a l r) = posr f (posr f (f a v) r) l

-- inorder foldl
inol :: (b -> a -> b) -> b -> T a -> b
inol _ v E         = v
inol f v (L a)     = f v a
inol f v (N a l r) = inol f (f (inol f v r) a) l

-- preorder foldl
prel :: (b -> a -> b) -> b -> T a -> b
prel _ v E         = v
prel f v (L a)     = f v a
prel f v (N a l r) = f (prel f (prel f v r) l) a

-- postorder foldl
posl :: (b -> a -> b) -> b -> T a -> b
posl _ v E         = v
posl f v (L a)     = f v a
posl f v (N a l r) = posl f (posl f (f v a) r) l

t :: T Int
t = N 1 (N 2 (L 4) E) (N 3 (L 6) (L 7))

{-
inor (:) [] t == inol (flip (:)) [] t -- True - [4,2,1,6,3,7]
prer (:) [] t == prel (flip (:)) [] t -- True - [1,2,4,3,6,7]
posr (:) [] t == posl (flip (:)) [] t -- True - [4,2,6,7,3,1]
-}

BT.php

<?php
declare(strict_types=1);

namespace Variant;

use Closure;
use TypeError;

interface Data {
    public function toData();
}

class Blank implements Data {
    public function toData(): void {}
}

class Leaf implements Data {
    /** @var mixed */
    private $data;

    public function __construct($data) {
        $this->data = $data;
    }

    public function toData() {
        return $this->data;
    }
}

class Node implements Data {
    /** @var mixed */
    private $data;
    /** @var Tree */
    private $left;
    /** @var Tree */
    private $right;

    public function __construct($data, Tree $left, Tree $right) {
        $this->data = $data;
        $this->left = $left;
        $this->right = $right;
    }

    public function toData() {
        return $this->data;
    }
    public function left(): Tree {
        return $this->left;
    }

    public function right(): Tree {
        return $this->right;
    }
}

class Tree {
    public const BLANK = 'blank';
    public const LEAF  = 'leaf';
    public const NODE  = 'node';

    /** @var string */
    private $variant;
    /** @var Blank|Leaf|Node */
    private $wrapped;

    private const VARIANTS = [
        self::BLANK,
        self::LEAF,
        self::NODE,
    ];

    public static function blank(Blank $blankNode): self {
        return new self(self::BLANK, $blankNode);
    }

    public static function leaf(Leaf $leaf): self {
        return new self(self::LEAF, $leaf);
    }

    public static function node(Node $node): self {
        return new self(self::NODE, $node);
    }

    public function variant(): string {
        return $this->variant;
    }

    public function unwrap(): Data {
        return $this->wrapped;
    }

    private function __construct(string $variant, Data $wrapped) {
        if (! \in_array($variant, self::VARIANTS, true)) {
            throw new TypeError('Not a variant');
        }
        $this->variant = $variant;
        $this->wrapped = $wrapped;
    }
}

// ----

// (a -> b -> b) -> b -> Tree a -> b
function inOrder(Closure $f, $s, Tree $t) {

    switch ($t->variant()) {
        case Tree::BLANK:
            return $s;
        case Tree::LEAF:
            return $f($t->unwrap()->toData(), $s);
        default:
            return inOrder($f, $f($t->unwrap()->toData(), inOrder($f, $s, $t->unwrap()->right())), $t->unwrap()->left());
    }
}

// (a -> b -> b) -> b -> Tree a -> b
function preOrder(Closure $f, $s, Tree $t) {
    switch ($t->variant()) {
        case Tree::BLANK:
            return $s;
        case Tree::LEAF:
            return $f($t->unwrap()->toData(), $s);
        default:
            return $f($t->unwrap()->toData(), preOrder($f, preOrder($f, $s, $t->unwrap()->right()), $t->unwrap()->left()));
    }
}

// (a -> b -> b) -> b -> Tree a -> b
function postOrder(Closure $f, $s, Tree $t) {
    switch ($t->variant()) {
        case Tree::BLANK:
            return $s;
        case Tree::LEAF:
            return $f($t->unwrap()->toData(), $s);
        default:
            return postOrder($f, postOrder($f, $f($t->unwrap()->toData(), $s), $t->unwrap()->right()), $t->unwrap()->left());
    }
}

// ----

/**
 *    1
 *  2   3
 * 4   6 7
 */
$tree =
    Tree::node(new Node(1,
        Tree::node(new Node(2,
            Tree::leaf(new Leaf(4)),
            Tree::blank(new Blank())
        )),
        Tree::node(new Node(3,
            Tree::leaf(new Leaf(6)),
            Tree::leaf(new Leaf(7))
        ))
    ));

// a -> [a] -> [a]
$cons = function ($x, array $xs): array {
    \array_unshift($xs, $x);
    return $xs;
};

\assert(inOrder($cons, [], $tree) === [4, 2, 1, 6, 3, 7]);
\assert(preOrder($cons, [], $tree) === [1, 2, 4, 3, 6, 7]);
\assert(postOrder($cons, [], $tree) === [4, 2, 6, 7, 3, 1]);

BTD.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
--{-# OPTIONS_GHC -ddump-deriv #-}

module BTD where

-- middle tree
data Tm a = Lm a | Nm (Tm a) a (Tm a) deriving (Show, Functor, Foldable)
-- front tree
data Tf a = Lf a | Nf a (Tf a) (Tf a) deriving (Show, Functor, Foldable)
-- back tree
data Tb a = Lb a | Nb (Tb a) (Tb a) a deriving (Show, Functor, Foldable)

-- derived inorder
fti :: (a -> b -> b) -> b -> Tm a -> b
fti f v (Lm a)     = f a v
fti f v (Nm l a r) = (\l v -> fti f v l) l (f a ((\r v -> fti f v r) r v))

-- derived preorder
fte :: (a -> b -> b) -> b -> Tf a -> b
fte f v (Lf a)     = f a v
fte f v (Nf a l r) = f a ((\l v -> fte f v l) l ((\r v -> fte f v r) r v))

-- derived postorder
fto :: (a -> b -> b) -> b -> Tb a -> b
fto f v (Lb a)     = f a v
fto f v (Nb l r a) = (\l v -> fto f v l) l ((\r v -> fto f v r) r (f a v))

tm :: Tm Int
tm = Nm (Nm (Lm 4) 2 (Lm 5)) 1 (Nm (Lm 6) 3 (Lm 7))

tf :: Tf Int
tf = Nf 1 (Nf 2 (Lf 4) (Lf 5)) (Nf 3 (Lf 6) (Lf 7))

tb :: Tb Int
tb = Nb (Nb (Lb 4) (Lb 5) 2) (Nb (Lb 6) (Lb 7) 3) 1

{-
fti (:) [] tm == foldr (:) [] tm -- True - [4,2,5,1,6,3,7]
fte (:) [] tf == foldr (:) [] tf -- True - [1,2,4,5,3,6,7]
fto (:) [] tb == foldr (:) [] tb -- True - [4,5,2,6,7,3,1]
-}