-- |
-- Module      : Data.RedBlackTree.BinaryTree
-- Copyright   : (c) 2017 Gabriel Aumala
--
-- License     : BSD3
-- Maintainer  : gabriel@criptext.com
-- Stability   : experimental
-- Portability : GHC
--
-- A Binary Search Tree implementation. It exposes various functions to operate
-- on the tree that are used internally by "Data.RedBlackTree". This is meant to be
-- used exclusively by "Data.RedBlackTree.Internal", it is not adequate to be
-- used as a standalone binary tree structure.
module Data.RedBlackTree.BinaryTree (
  BinaryTreeNode (mergeNodes),
  BinaryTree (Leaf, Branch),
  BranchType (LeftBranch, RightBranch),
  BranchZipper,
  TreeBranch (TreeBranch),
  TreeDirection (TreeDirection),
  TreeDirections,
  TreeInsertResult (InsertOk, InsertNotYet, InsertMerge),
  TreeZipper,

  appendLeftChild,
  appendRightChild,
  binaryTreeInsert,
  binaryTreeFind,
  branch2Tree,
  branchZipperInsert,
  getTreeRoot,
  goLeft,
  goUp,
  goRight,
  reconstructAncestor
  ) where

import Data.Maybe


-- | Only types that are members of @BinaryTreeNode@ can be inserted into a
-- "BinaryTree".
--
-- The purpose of the class is to provide a method to merge nodes
-- with equal values since inserting different nodes with equal values can
-- corrupt the tree.
class (Ord a) => BinaryTreeNode a where
  -- | The "BinaryTree" will call this function when it tries to insert a value
  -- that already exists in the tree. The first argument is guaranteed to be the
  -- one that is already in the tree, while the second argument is the node that
  -- the tree is trying to insert. Since the two nodes can't exist in the same tree
  -- The result should be a 'merged' node that will be inserted instead of the
  -- other two.
  mergeNodes :: a -> a -> a

-- | A @BinaryTree@ is either a @Leaf@ (empty) or a @BinaryTreeNode@
-- with 2 @BinaryTree@ children: left and right.
data BinaryTree a = Leaf | Branch (BinaryTree a) a (BinaryTree a)
  deriving (BinaryTree a -> BinaryTree a -> Bool
(BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool) -> Eq (BinaryTree a)
forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
== :: BinaryTree a -> BinaryTree a -> Bool
$c/= :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
/= :: BinaryTree a -> BinaryTree a -> Bool
Eq, Eq (BinaryTree a)
Eq (BinaryTree a) =>
(BinaryTree a -> BinaryTree a -> Ordering)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> Ord (BinaryTree a)
BinaryTree a -> BinaryTree a -> Bool
BinaryTree a -> BinaryTree a -> Ordering
BinaryTree a -> BinaryTree a -> BinaryTree a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (BinaryTree a)
forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
$ccompare :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
compare :: BinaryTree a -> BinaryTree a -> Ordering
$c< :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
< :: BinaryTree a -> BinaryTree a -> Bool
$c<= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
<= :: BinaryTree a -> BinaryTree a -> Bool
$c> :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
> :: BinaryTree a -> BinaryTree a -> Bool
$c>= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
>= :: BinaryTree a -> BinaryTree a -> Bool
$cmax :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
max :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmin :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
min :: BinaryTree a -> BinaryTree a -> BinaryTree a
Ord)

instance (BinaryTreeNode a, Show a) => Show (BinaryTree a) where
  show :: BinaryTree a -> String
show BinaryTree a
tree = BinaryTree a -> Int -> String
forall {a}. Show a => BinaryTree a -> Int -> String
prettyPrintTree BinaryTree a
tree Int
0
    where
      addSpaces :: Int -> String
addSpaces Int
num = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
num Char
' '
      prettyPrintTree :: BinaryTree a -> Int -> String
prettyPrintTree BinaryTree a
Leaf Int
spaces = String
" Leaf"
      prettyPrintTree (Branch BinaryTree a
leftTree a
content BinaryTree a
rightTree) Int
spaces =
        String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
content String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
identation String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"L:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinaryTree a -> String
prettyPrintSubtree BinaryTree a
leftTree String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
identation String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"R:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinaryTree a -> String
prettyPrintSubtree BinaryTree a
rightTree
        where identation :: String
identation = Int -> String
addSpaces (Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
              prettyPrintSubtree :: BinaryTree a -> String
prettyPrintSubtree BinaryTree a
subtree =  BinaryTree a -> Int -> String
prettyPrintTree BinaryTree a
subtree (Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"


-- | A BinaryTree can only have two types of branches: Left or Right
data BranchType = LeftBranch | RightBranch deriving (Int -> BranchType -> ShowS
[BranchType] -> ShowS
BranchType -> String
(Int -> BranchType -> ShowS)
-> (BranchType -> String)
-> ([BranchType] -> ShowS)
-> Show BranchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchType -> ShowS
showsPrec :: Int -> BranchType -> ShowS
$cshow :: BranchType -> String
show :: BranchType -> String
$cshowList :: [BranchType] -> ShowS
showList :: [BranchType] -> ShowS
Show, BranchType -> BranchType -> Bool
(BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool) -> Eq BranchType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchType -> BranchType -> Bool
== :: BranchType -> BranchType -> Bool
$c/= :: BranchType -> BranchType -> Bool
/= :: BranchType -> BranchType -> Bool
Eq, Eq BranchType
Eq BranchType =>
(BranchType -> BranchType -> Ordering)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> BranchType)
-> (BranchType -> BranchType -> BranchType)
-> Ord BranchType
BranchType -> BranchType -> Bool
BranchType -> BranchType -> Ordering
BranchType -> BranchType -> BranchType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BranchType -> BranchType -> Ordering
compare :: BranchType -> BranchType -> Ordering
$c< :: BranchType -> BranchType -> Bool
< :: BranchType -> BranchType -> Bool
$c<= :: BranchType -> BranchType -> Bool
<= :: BranchType -> BranchType -> Bool
$c> :: BranchType -> BranchType -> Bool
> :: BranchType -> BranchType -> Bool
$c>= :: BranchType -> BranchType -> Bool
>= :: BranchType -> BranchType -> Bool
$cmax :: BranchType -> BranchType -> BranchType
max :: BranchType -> BranchType -> BranchType
$cmin :: BranchType -> BranchType -> BranchType
min :: BranchType -> BranchType -> BranchType
Ord)

-- | Minimum necessary to reconstruct the parent of any focused node. First argument
-- is the @BranchType@ of the focused node relative to the parent. Second argument
-- is the parent's node. The third argument is the sibling tree of the focused
-- node.
data TreeDirection a = TreeDirection BranchType a (BinaryTree a)
  deriving (Int -> TreeDirection a -> ShowS
[TreeDirection a] -> ShowS
TreeDirection a -> String
(Int -> TreeDirection a -> ShowS)
-> (TreeDirection a -> String)
-> ([TreeDirection a] -> ShowS)
-> Show (TreeDirection a)
forall a.
(Show a, BinaryTreeNode a) =>
Int -> TreeDirection a -> ShowS
forall a. (Show a, BinaryTreeNode a) => [TreeDirection a] -> ShowS
forall a. (Show a, BinaryTreeNode a) => TreeDirection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a.
(Show a, BinaryTreeNode a) =>
Int -> TreeDirection a -> ShowS
showsPrec :: Int -> TreeDirection a -> ShowS
$cshow :: forall a. (Show a, BinaryTreeNode a) => TreeDirection a -> String
show :: TreeDirection a -> String
$cshowList :: forall a. (Show a, BinaryTreeNode a) => [TreeDirection a] -> ShowS
showList :: [TreeDirection a] -> ShowS
Show, TreeDirection a -> TreeDirection a -> Bool
(TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> Eq (TreeDirection a)
forall a. Eq a => TreeDirection a -> TreeDirection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TreeDirection a -> TreeDirection a -> Bool
== :: TreeDirection a -> TreeDirection a -> Bool
$c/= :: forall a. Eq a => TreeDirection a -> TreeDirection a -> Bool
/= :: TreeDirection a -> TreeDirection a -> Bool
Eq, Eq (TreeDirection a)
Eq (TreeDirection a) =>
(TreeDirection a -> TreeDirection a -> Ordering)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> TreeDirection a)
-> (TreeDirection a -> TreeDirection a -> TreeDirection a)
-> Ord (TreeDirection a)
TreeDirection a -> TreeDirection a -> Bool
TreeDirection a -> TreeDirection a -> Ordering
TreeDirection a -> TreeDirection a -> TreeDirection a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TreeDirection a)
forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
forall a. Ord a => TreeDirection a -> TreeDirection a -> Ordering
forall a.
Ord a =>
TreeDirection a -> TreeDirection a -> TreeDirection a
$ccompare :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Ordering
compare :: TreeDirection a -> TreeDirection a -> Ordering
$c< :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
< :: TreeDirection a -> TreeDirection a -> Bool
$c<= :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
<= :: TreeDirection a -> TreeDirection a -> Bool
$c> :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
> :: TreeDirection a -> TreeDirection a -> Bool
$c>= :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
>= :: TreeDirection a -> TreeDirection a -> Bool
$cmax :: forall a.
Ord a =>
TreeDirection a -> TreeDirection a -> TreeDirection a
max :: TreeDirection a -> TreeDirection a -> TreeDirection a
$cmin :: forall a.
Ord a =>
TreeDirection a -> TreeDirection a -> TreeDirection a
min :: TreeDirection a -> TreeDirection a -> TreeDirection a
Ord)

-- | List of @TreeDirection@
type TreeDirections a = [TreeDirection a]

-- | A @BinaryTree@ zipper. the first value of the tuple is the focused @BinaryTree@,
-- while the second argument is the list of directions used to move up to the
-- parent and other ancestors.
--
-- It is used to navigate up an down in a "BinaryTree".
type TreeZipper a = (BinaryTree a, TreeDirections a)

-- | Holds the data of a @BinaryTree@ created with the @Branch@ constructor. Useful
-- type when you want to guarantee that the element is not a @Leaf@
data TreeBranch a = TreeBranch (BinaryTree a) a (BinaryTree a)
  deriving (TreeBranch a -> TreeBranch a -> Bool
(TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool) -> Eq (TreeBranch a)
forall a. Eq a => TreeBranch a -> TreeBranch a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TreeBranch a -> TreeBranch a -> Bool
== :: TreeBranch a -> TreeBranch a -> Bool
$c/= :: forall a. Eq a => TreeBranch a -> TreeBranch a -> Bool
/= :: TreeBranch a -> TreeBranch a -> Bool
Eq, Eq (TreeBranch a)
Eq (TreeBranch a) =>
(TreeBranch a -> TreeBranch a -> Ordering)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> TreeBranch a)
-> (TreeBranch a -> TreeBranch a -> TreeBranch a)
-> Ord (TreeBranch a)
TreeBranch a -> TreeBranch a -> Bool
TreeBranch a -> TreeBranch a -> Ordering
TreeBranch a -> TreeBranch a -> TreeBranch a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TreeBranch a)
forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
forall a. Ord a => TreeBranch a -> TreeBranch a -> Ordering
forall a. Ord a => TreeBranch a -> TreeBranch a -> TreeBranch a
$ccompare :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Ordering
compare :: TreeBranch a -> TreeBranch a -> Ordering
$c< :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
< :: TreeBranch a -> TreeBranch a -> Bool
$c<= :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
<= :: TreeBranch a -> TreeBranch a -> Bool
$c> :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
> :: TreeBranch a -> TreeBranch a -> Bool
$c>= :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
>= :: TreeBranch a -> TreeBranch a -> Bool
$cmax :: forall a. Ord a => TreeBranch a -> TreeBranch a -> TreeBranch a
max :: TreeBranch a -> TreeBranch a -> TreeBranch a
$cmin :: forall a. Ord a => TreeBranch a -> TreeBranch a -> TreeBranch a
min :: TreeBranch a -> TreeBranch a -> TreeBranch a
Ord)

instance (BinaryTreeNode a, Show a) => Show (TreeBranch a) where
  show :: TreeBranch a -> String
show (TreeBranch BinaryTree a
leftChild a
content BinaryTree a
rightChild) =
    BinaryTree a -> String
forall a. Show a => a -> String
show (BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree a
leftChild a
content BinaryTree a
rightChild)

-- | A @TreeBranch@ zipper. It is identical to @TreeZipper@ except for the fact
-- that @Leaf@ values are not allowed in the zipper.
type BranchZipper a = (TreeBranch a, TreeDirections a)

-- | The result from inserting a node to the left or right of a tree can be:
--
-- - (@InsertOk insertedTree directionToNewTree@) if there is a leaf at the
-- attempted insert position
-- - (@InsertNotYet obstructingTree directionToObstructingTree nodeToInsert@) if there
-- already is a tree obstructing the desired position, we must go further down
-- - (@InsertMerge mergedBranch@) the node to insert is equal to the tree's node so they were merged
-- and the tree's size remains the same
data TreeInsertResult a =
  InsertOk (TreeBranch a) (TreeDirection a)
  | InsertNotYet (BinaryTree a) (TreeDirection a) a
  | InsertMerge (TreeBranch a)
  deriving (Int -> TreeInsertResult a -> ShowS
[TreeInsertResult a] -> ShowS
TreeInsertResult a -> String
(Int -> TreeInsertResult a -> ShowS)
-> (TreeInsertResult a -> String)
-> ([TreeInsertResult a] -> ShowS)
-> Show (TreeInsertResult a)
forall a.
(BinaryTreeNode a, Show a) =>
Int -> TreeInsertResult a -> ShowS
forall a.
(BinaryTreeNode a, Show a) =>
[TreeInsertResult a] -> ShowS
forall a.
(BinaryTreeNode a, Show a) =>
TreeInsertResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a.
(BinaryTreeNode a, Show a) =>
Int -> TreeInsertResult a -> ShowS
showsPrec :: Int -> TreeInsertResult a -> ShowS
$cshow :: forall a.
(BinaryTreeNode a, Show a) =>
TreeInsertResult a -> String
show :: TreeInsertResult a -> String
$cshowList :: forall a.
(BinaryTreeNode a, Show a) =>
[TreeInsertResult a] -> ShowS
showList :: [TreeInsertResult a] -> ShowS
Show, TreeInsertResult a -> TreeInsertResult a -> Bool
(TreeInsertResult a -> TreeInsertResult a -> Bool)
-> (TreeInsertResult a -> TreeInsertResult a -> Bool)
-> Eq (TreeInsertResult a)
forall a. Eq a => TreeInsertResult a -> TreeInsertResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TreeInsertResult a -> TreeInsertResult a -> Bool
== :: TreeInsertResult a -> TreeInsertResult a -> Bool
$c/= :: forall a. Eq a => TreeInsertResult a -> TreeInsertResult a -> Bool
/= :: TreeInsertResult a -> TreeInsertResult a -> Bool
Eq)


isLeftTreeDirection :: (BinaryTreeNode a) => TreeDirection a -> Bool
isLeftTreeDirection :: forall a. BinaryTreeNode a => TreeDirection a -> Bool
isLeftTreeDirection (TreeDirection BranchType
branchType a
_ BinaryTree a
_) = BranchType
branchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch

getTreeContent :: (BinaryTreeNode a) => BinaryTree a -> Maybe a
getTreeContent :: forall a. BinaryTreeNode a => BinaryTree a -> Maybe a
getTreeContent (Branch BinaryTree a
_ a
content BinaryTree a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
content
getTreeContent BinaryTree a
Leaf = Maybe a
forall a. Maybe a
Nothing

branch2Tree :: (BinaryTreeNode a) => TreeBranch a -> BinaryTree a
branch2Tree :: forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree (TreeBranch BinaryTree a
leftChild a
content BinaryTree a
rightChild) =
  BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree a
leftChild a
content BinaryTree a
rightChild

-- Move the zipper down to the left child, returns nothing if focused node is
--  leaf
goLeft :: (BinaryTreeNode a) => BranchZipper a -> TreeZipper a
goLeft :: forall a. BinaryTreeNode a => BranchZipper a -> TreeZipper a
goLeft (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) =
  (BinaryTree a
leftChild, BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
LeftBranch a
treeNode BinaryTree a
rightChildTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
xs)

-- Move the zipper down to the right child, returns nothing if focused node is
-- a leaf
goRight :: (BinaryTreeNode a) => BranchZipper a -> TreeZipper a
goRight :: forall a. BinaryTreeNode a => BranchZipper a -> TreeZipper a
goRight (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) =
  (BinaryTree a
rightChild, BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
RightBranch a
treeNode BinaryTree a
leftChildTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
xs)

-- get the parent of a branch given the direction from the parent to the branch
reconstructAncestor :: (BinaryTreeNode a) => TreeBranch a -> TreeDirection a ->
  TreeBranch a
reconstructAncestor :: forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch a
currentBranch (TreeDirection BranchType
branchType a
parentContent
  BinaryTree a
sibling) =
  if BranchType
branchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch
    then BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
currentTree a
parentContent BinaryTree a
sibling
    else BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
sibling a
parentContent BinaryTree a
currentTree
    where currentTree :: BinaryTree a
currentTree = TreeBranch a -> BinaryTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree TreeBranch a
currentBranch

-- Move the zipper up to the parent, returns nothing directions list is empty
goUp :: (BinaryTreeNode a) => BranchZipper a -> Maybe (BranchZipper a)
goUp :: forall a.
BinaryTreeNode a =>
BranchZipper a -> Maybe (BranchZipper a)
goUp (TreeBranch a
_, []) = Maybe (TreeBranch a, TreeDirections a)
forall a. Maybe a
Nothing
goUp (TreeBranch a
currentBranch, TreeDirection a
direction:TreeDirections a
xs) =
  (TreeBranch a, TreeDirections a)
-> Maybe (TreeBranch a, TreeDirections a)
forall a. a -> Maybe a
Just (TreeBranch a -> TreeDirection a -> TreeBranch a
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch a
currentBranch TreeDirection a
direction, TreeDirections a
xs)

getTreeRoot :: (BinaryTreeNode a) => BranchZipper a -> BranchZipper a
getTreeRoot :: forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (TreeBranch a
branch, []) = (TreeBranch a
branch, [])
getTreeRoot (TreeBranch a, TreeDirections a)
zipper = case (TreeBranch a, TreeDirections a)
-> Maybe (TreeBranch a, TreeDirections a)
forall a.
BinaryTreeNode a =>
BranchZipper a -> Maybe (BranchZipper a)
goUp (TreeBranch a, TreeDirections a)
zipper of
  Just (TreeBranch a, TreeDirections a)
prevZipper -> (TreeBranch a, TreeDirections a)
-> (TreeBranch a, TreeDirections a)
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (TreeBranch a, TreeDirections a)
prevZipper
  Maybe (TreeBranch a, TreeDirections a)
Nothing -> (TreeBranch a, TreeDirections a)
zipper

appendLeftChild :: (BinaryTreeNode a) => TreeBranch a -> a -> TreeInsertResult a
appendLeftChild :: forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendLeftChild (TreeBranch BinaryTree a
leftChild a
treeContent BinaryTree a
rightChild) a
nodeToAppend =
  if BinaryTree a
leftChild BinaryTree a -> BinaryTree a -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryTree a
forall a. BinaryTree a
Leaf then
    TreeBranch a -> TreeDirection a -> TreeInsertResult a
forall a. TreeBranch a -> TreeDirection a -> TreeInsertResult a
InsertOk TreeBranch a
newBranch TreeDirection a
newDirection
  else
    BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
forall a.
BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
InsertNotYet BinaryTree a
leftChild TreeDirection a
newDirection a
nodeToAppend
  where newBranch :: TreeBranch a
newBranch = BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
forall a. BinaryTree a
Leaf a
nodeToAppend BinaryTree a
forall a. BinaryTree a
Leaf
        newDirection :: TreeDirection a
newDirection = BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
LeftBranch a
treeContent BinaryTree a
rightChild

appendRightChild :: (BinaryTreeNode a) => TreeBranch a -> a ->
  TreeInsertResult a
appendRightChild :: forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendRightChild (TreeBranch BinaryTree a
leftChild a
treeContent BinaryTree a
rightChild) a
nodeToAppend =
  if BinaryTree a
rightChild BinaryTree a -> BinaryTree a -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryTree a
forall a. BinaryTree a
Leaf then
    TreeBranch a -> TreeDirection a -> TreeInsertResult a
forall a. TreeBranch a -> TreeDirection a -> TreeInsertResult a
InsertOk TreeBranch a
newBranch TreeDirection a
newDirection
  else
    BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
forall a.
BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
InsertNotYet BinaryTree a
rightChild TreeDirection a
newDirection a
nodeToAppend
  where newBranch :: TreeBranch a
newBranch = BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
forall a. BinaryTree a
Leaf a
nodeToAppend BinaryTree a
forall a. BinaryTree a
Leaf
        newDirection :: TreeDirection a
newDirection = BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
RightBranch a
treeContent BinaryTree a
leftChild


appendWithMerge :: (BinaryTreeNode a) => TreeBranch a -> a ->
  TreeInsertResult a
appendWithMerge :: forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendWithMerge (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild) a
nodeToAppend =
  TreeBranch a -> TreeInsertResult a
forall a. TreeBranch a -> TreeInsertResult a
InsertMerge (BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
leftChild a
mergedNode BinaryTree a
rightChild)
  where mergedNode :: a
mergedNode = a -> a -> a
forall a. BinaryTreeNode a => a -> a -> a
mergeNodes a
treeNode a
nodeToAppend

insertOrGoDown :: (BinaryTreeNode a) => TreeDirections a -> TreeInsertResult a
  -> BranchZipper a
insertOrGoDown :: forall a.
BinaryTreeNode a =>
TreeDirections a -> TreeInsertResult a -> BranchZipper a
insertOrGoDown TreeDirections a
treeDirections (InsertMerge TreeBranch a
newBranch) =
  (TreeBranch a
newBranch, TreeDirections a
treeDirections)
insertOrGoDown TreeDirections a
treeDirections (InsertOk TreeBranch a
newBranch TreeDirection a
newDirection) =
  (TreeBranch a
newBranch, TreeDirection a
newDirectionTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
treeDirections)
insertOrGoDown TreeDirections a
treeDirections (InsertNotYet BinaryTree a
existingChild TreeDirection a
directionToChild
  a
childToInsert) =
  TreeZipper a -> a -> BranchZipper a
forall a. BinaryTreeNode a => TreeZipper a -> a -> BranchZipper a
treeZipperInsert (BinaryTree a
existingChild, TreeDirection a
directionToChildTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
treeDirections)
    a
childToInsert

branchZipperToTreeZipper :: (BinaryTreeNode a) => BranchZipper a -> TreeZipper a
branchZipperToTreeZipper :: forall a. BinaryTreeNode a => BranchZipper a -> TreeZipper a
branchZipperToTreeZipper (TreeBranch BinaryTree a
leftChild a
content BinaryTree a
rightChild, TreeDirections a
xs) =
  (BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree a
leftChild a
content BinaryTree a
rightChild, TreeDirections a
xs)

branchZipperInsert :: (BinaryTreeNode a) => BranchZipper a -> a ->
  BranchZipper a
branchZipperInsert :: forall a. BinaryTreeNode a => BranchZipper a -> a -> BranchZipper a
branchZipperInsert (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) a
newNode =
  TreeDirections a
-> TreeInsertResult a -> (TreeBranch a, TreeDirections a)
forall a.
BinaryTreeNode a =>
TreeDirections a -> TreeInsertResult a -> BranchZipper a
insertOrGoDown TreeDirections a
xs (TreeBranch a -> a -> TreeInsertResult a
appendFunction TreeBranch a
focusedBranch a
newNode)
  where
    focusedBranch :: TreeBranch a
focusedBranch = BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild
    appendFunction :: TreeBranch a -> a -> TreeInsertResult a
appendFunction
      | a
newNode a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
treeNode = TreeBranch a -> a -> TreeInsertResult a
forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendLeftChild
      | a
newNode a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
treeNode = TreeBranch a -> a -> TreeInsertResult a
forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendRightChild
      | Bool
otherwise = TreeBranch a -> a -> TreeInsertResult a
forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendWithMerge

treeZipperInsert :: (BinaryTreeNode a) => TreeZipper a -> a -> BranchZipper a
treeZipperInsert :: forall a. BinaryTreeNode a => TreeZipper a -> a -> BranchZipper a
treeZipperInsert (BinaryTree a
Leaf, TreeDirections a
xs) a
newNode = (BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
forall a. BinaryTree a
Leaf a
newNode BinaryTree a
forall a. BinaryTree a
Leaf, TreeDirections a
xs)
treeZipperInsert (Branch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) a
newNode =
  BranchZipper a -> a -> BranchZipper a
forall a. BinaryTreeNode a => BranchZipper a -> a -> BranchZipper a
branchZipperInsert (BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) a
newNode

-- | inserts an item to the "BinaryTree". Returns a @BranchZipper@ focusing
-- on the recently inserted branch.
binaryTreeInsert :: (BinaryTreeNode a) => BinaryTree a -> a -> BranchZipper a
binaryTreeInsert :: forall a. BinaryTreeNode a => BinaryTree a -> a -> BranchZipper a
binaryTreeInsert BinaryTree a
tree = TreeZipper a -> a -> BranchZipper a
forall a. BinaryTreeNode a => TreeZipper a -> a -> BranchZipper a
treeZipperInsert TreeZipper a
forall {a}. (BinaryTree a, [a])
treeZipper
  where treeZipper :: (BinaryTree a, [a])
treeZipper = (BinaryTree a
tree, [])

-- | Looks up an item in the "BinaryTree". Returns "Nothing" if it was not found.
binaryTreeFind :: (BinaryTreeNode a) => BinaryTree a -> a -> Maybe a
binaryTreeFind :: forall a. BinaryTreeNode a => BinaryTree a -> a -> Maybe a
binaryTreeFind BinaryTree a
Leaf a
_ = Maybe a
forall a. Maybe a
Nothing
binaryTreeFind (Branch BinaryTree a
leftTree a
content BinaryTree a
rightTree) a
target
  | a
target a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
content = a -> Maybe a
forall a. a -> Maybe a
Just a
content
  | a
target a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
content = BinaryTree a -> a -> Maybe a
forall a. BinaryTreeNode a => BinaryTree a -> a -> Maybe a
binaryTreeFind BinaryTree a
leftTree a
target
  | a
target a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
content = BinaryTree a -> a -> Maybe a
forall a. BinaryTreeNode a => BinaryTree a -> a -> Maybe a
binaryTreeFind BinaryTree a
rightTree a
target