module BinaryTreeZipper where

(|>) = flip ($)

data BinaryTree a
  = Node a (BinaryTree a) (BinaryTree a)
  | Empty
  deriving (Show)

data BinaryTreeZipper a = Z (BinaryTree a, Path a)
  deriving (Show)

type PathStep a =
  ( a                                     -- parent node value
  , Either (BinaryTree a) (BinaryTree a)  -- left or right child
  )

type Path a = [PathStep a]

goDownLeft, goDownRight, goUp, goLeft, goRight :: BinaryTreeZipper a -> BinaryTreeZipper a

goDownLeft (Z (Node x left right, up)) = Z (left, (x, Right right) : up)
goDownRight (Z (Node x left right, up)) = Z (right, (x, Left left) : up)

goUp (Z (t, (x, Left left) : up)) = Z (Node x left t, up)
goUp (Z (t, (x, Right right) : up)) = Z (Node x t right, up)

goLeft (Z (t, (x, Left left) : up)) = Z (left, (x, Right t) : up)
goRight (Z (t, (x, Right right) : up)) = Z (right, (x, Left t) : up)

fromTree :: BinaryTree a -> BinaryTreeZipper a
fromTree t = Z (t, [])

toTree :: BinaryTreeZipper a -> BinaryTree a
toTree (Z (t, [])) = t
toTree (Z (t, (x, Right right) : up)) = toTree (Z (Node x t right, up))
toTree (Z (t, (x, Left left) : up)) = toTree (Z (Node x left t, up))