-- |
-- Module      : Data.RedBlackTree.InsertionAlgorithm
-- Copyright   : (c) 2017 Gabriel Aumala
--
-- License     : BSD3
-- Maintainer  : gabriel@criptext.com
-- Stability   : experimental
-- Portability : GHC
--
-- Data types and functions used internally by "Data.RedBlackTree"'s "insert" function.
-- You don't need to know anything about this if you only want to consume the
-- "RedBlackTree" library.

module Data.RedBlackTree.InsertionAlgorithm (
  identifyRBTCase,
  insert,
  RBTCase (Case1, Case2, Case3, Case4, Case5)
) where

import Data.RedBlackTree.BinaryTree
import Data.RedBlackTree.TreeFamily
import Data.RedBlackTree.Internal

-- | The 5 possible cases of red–black tree insertion to handle:
--
-- 1. inserted node is the root node, i.e., first node of red–black tree.
-- Stored as a @WhiteBranch@ because it should always be black.
-- 2. inserted node has a parent, and it is black. The inserted node is stored
-- as a @RedBlackBranch@ along with a @RedBlackDirections@ to reconstruct all of
-- the ancestors.
-- 3. inserted node has a parent and an uncle, and they are both red.
-- 4th parameter is the inserted node as a @WhiteBranch@ because it is assumed
-- to be red. 3rd parameter is the uncle as @WhiteBranch@ because it is also
-- assumed to be red. 2nd parameter is the node content of the grandparent.
-- 1st parameter is a @RedBlackDirections@ to reconstruct all of the remaining
-- ancestors.
-- 4. inserted node is placed to right of left child of grandparent, or to left
-- of right child of grandparent. 5th parameter is the inserted node as a  @RedBlackBranch@ because it is
-- assumed to be red but we don't care about it right now. 4th parameter is the sibling of the inserted node as a @RedBlackTree@.
-- 3rd parameter is the parent as a @RedBlackNode@. 2nd parameter is a @RedBlackDirection@ used to reconstruct the grandparent.
-- 1st parameter is a @RedBlackDirections@ to reconstruct all of the remaining
-- ancestors.
-- 5. inserted node is placed to left of left child of grandparent, or to right
-- of right child of grandparent. 5th parameter is the inserted node as a
-- @RedBlackBranch@ because it is assumed to be red but we don't care about it
-- right now. 4th parameter is the sibling of the inserted node as a
-- @RedBlackTree@. 3rd parameter is content of the parent. 2nd parameter is a
-- @RedBlackDirection@ used to reconstruct the grandparent. 1st parameter is a
-- @RedBlackDirections@ to reconstruct all of the remaining ancestors.
--
-- This datatype holds the minimum information about the tree to be able to
-- handle each case.
data RBTCase a
  = Case1 (WhiteBranch a)
  | Case2 (RedBlackDirections a) (RedBlackBranch a)
  | Case3 (RedBlackDirections a) a (WhiteBranch a) (WhiteBranch a)
  | Case4 (RedBlackDirections a) (RedBlackDirection a) (RedBlackNode a)
    (RedBlackTree a) (RedBlackBranch a)
  | Case5 (RedBlackDirections a) (RedBlackDirection a) a (RedBlackTree a)
    (RedBlackBranch a)
  deriving (RBTCase a -> RBTCase a -> Bool
(RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool) -> Eq (RBTCase a)
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
== :: RBTCase a -> RBTCase a -> Bool
$c/= :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
/= :: RBTCase a -> RBTCase a -> Bool
Eq, Eq (RBTCase a)
Eq (RBTCase a) =>
(RBTCase a -> RBTCase a -> Ordering)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> RBTCase a)
-> (RBTCase a -> RBTCase a -> RBTCase a)
-> Ord (RBTCase a)
RBTCase a -> RBTCase a -> Bool
RBTCase a -> RBTCase a -> Ordering
RBTCase a -> RBTCase a -> RBTCase 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. BinaryTreeNode a => Eq (RBTCase a)
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Ordering
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> RBTCase a
$ccompare :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Ordering
compare :: RBTCase a -> RBTCase a -> Ordering
$c< :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
< :: RBTCase a -> RBTCase a -> Bool
$c<= :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
<= :: RBTCase a -> RBTCase a -> Bool
$c> :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
> :: RBTCase a -> RBTCase a -> Bool
$c>= :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
>= :: RBTCase a -> RBTCase a -> Bool
$cmax :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> RBTCase a
max :: RBTCase a -> RBTCase a -> RBTCase a
$cmin :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> RBTCase a
min :: RBTCase a -> RBTCase a -> RBTCase a
Ord, Int -> RBTCase a -> ShowS
[RBTCase a] -> ShowS
RBTCase a -> String
(Int -> RBTCase a -> ShowS)
-> (RBTCase a -> String)
-> ([RBTCase a] -> ShowS)
-> Show (RBTCase a)
forall a. (BinaryTreeNode a, Show a) => Int -> RBTCase a -> ShowS
forall a. (BinaryTreeNode a, Show a) => [RBTCase a] -> ShowS
forall a. (BinaryTreeNode a, Show a) => RBTCase a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. (BinaryTreeNode a, Show a) => Int -> RBTCase a -> ShowS
showsPrec :: Int -> RBTCase a -> ShowS
$cshow :: forall a. (BinaryTreeNode a, Show a) => RBTCase a -> String
show :: RBTCase a -> String
$cshowList :: forall a. (BinaryTreeNode a, Show a) => [RBTCase a] -> ShowS
showList :: [RBTCase a] -> ShowS
Show)

-- | Identify all insertion cases in which it is assumed that the inserted
-- node has a grandparent.
identifyCases345 :: (BinaryTreeNode a) => RedBlackDirections a ->
  RedBlackDirection a -> RedBlackDirection a -> RedBlackBranch a -> RBTCase a
identifyCases345 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackDirection a
-> RedBlackBranch a
-> RBTCase a
identifyCases345 RedBlackDirections a
directions
  (TreeDirection BranchType
grandparentBranchType RedBlackNode a
grandparentNode
  (Branch BinaryTree (RedBlackNode a)
leftCousin (RedBlackNode RedBlack
Red a
uncleContent) BinaryTree (RedBlackNode a)
rightCousin))
  TreeDirection (RedBlackNode a)
parentDirection RedBlackBranch a
newBranch =
    case BranchType
grandparentBranchType of
      BranchType
LeftBranch ->
        RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
forall a.
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
Case3 RedBlackDirections a
directions a
grandparentContent WhiteBranch a
whiteParent WhiteBranch a
whiteUncle
      BranchType
RightBranch ->
        RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
forall a.
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
Case3 RedBlackDirections a
directions a
grandparentContent WhiteBranch a
whiteUncle WhiteBranch a
whiteParent
  where uncleNode :: RedBlackNode a
uncleNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
uncleContent
        uncleBranch :: RedBlackBranch a
uncleBranch = BinaryTree (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree (RedBlackNode a)
leftCousin RedBlackNode a
uncleNode BinaryTree (RedBlackNode a)
rightCousin
        parentBranch :: RedBlackBranch a
parentBranch = RedBlackBranch a
-> TreeDirection (RedBlackNode a) -> RedBlackBranch a
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor RedBlackBranch a
newBranch TreeDirection (RedBlackNode a)
parentDirection
        grandparentDirection :: TreeDirection (RedBlackNode a)
grandparentDirection = BranchType
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> TreeDirection (RedBlackNode a)
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
grandparentBranchType
          RedBlackNode a
grandparentNode (BinaryTree (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> BinaryTree (RedBlackNode a)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree (RedBlackNode a)
leftCousin RedBlackNode a
uncleNode BinaryTree (RedBlackNode a)
rightCousin)
        RedBlackNode RedBlack
_ a
grandparentContent = RedBlackNode a
grandparentNode
        whiteUncle :: WhiteBranch a
whiteUncle = RedBlackBranch a -> WhiteBranch a
forall a. BinaryTreeNode a => RedBlackBranch a -> WhiteBranch a
removeBranchColor RedBlackBranch a
uncleBranch
        whiteParent :: WhiteBranch a
whiteParent = RedBlackBranch a -> WhiteBranch a
forall a. BinaryTreeNode a => RedBlackBranch a -> WhiteBranch a
removeBranchColor RedBlackBranch a
parentBranch
identifyCases345 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection TreeDirection (RedBlackNode a)
parentDirection RedBlackBranch a
newBranch
  | BranchType
grandparentBranchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
/= BranchType
parentBranchType =
    RedBlackDirections a
-> TreeDirection (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> RedBlackBranch a
-> RBTCase a
forall a.
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
Case4 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection RedBlackNode a
parentNode BinaryTree (RedBlackNode a)
siblingTree RedBlackBranch a
newBranch
  | BranchType
grandparentBranchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
parentBranchType =
    RedBlackDirections a
-> TreeDirection (RedBlackNode a)
-> a
-> BinaryTree (RedBlackNode a)
-> RedBlackBranch a
-> RBTCase a
forall a.
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
Case5 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection a
parentContent BinaryTree (RedBlackNode a)
siblingTree RedBlackBranch a
newBranch
  where TreeDirection BranchType
grandparentBranchType RedBlackNode a
_ BinaryTree (RedBlackNode a)
_ = TreeDirection (RedBlackNode a)
grandparentDirection
        TreeDirection BranchType
parentBranchType RedBlackNode a
parentNode BinaryTree (RedBlackNode a)
siblingTree = TreeDirection (RedBlackNode a)
parentDirection
        RedBlackNode RedBlack
_ a
parentContent =  RedBlackNode a
parentNode

identifyRBTCase :: (BinaryTreeNode a) => TreeFamily (RedBlackNode a) ->
  RBTCase a
identifyRBTCase :: forall a.
BinaryTreeNode a =>
TreeFamily (RedBlackNode a) -> RBTCase a
identifyRBTCase (IsRoot TreeBranch (RedBlackNode a)
rootBranch) = WhiteBranch a -> RBTCase a
forall a. WhiteBranch a -> RBTCase a
Case1 (TreeBranch (RedBlackNode a) -> WhiteBranch a
forall a. BinaryTreeNode a => RedBlackBranch a -> WhiteBranch a
removeBranchColor TreeBranch (RedBlackNode a)
rootBranch)
identifyRBTCase (HasParent TreeDirection (RedBlackNode a)
direction TreeBranch (RedBlackNode a)
insertedBranch) = RedBlackDirections a -> TreeBranch (RedBlackNode a) -> RBTCase a
forall a. RedBlackDirections a -> RedBlackBranch a -> RBTCase a
Case2 [] TreeBranch (RedBlackNode a)
parentBranch
  where parentBranch :: TreeBranch (RedBlackNode a)
parentBranch = TreeBranch (RedBlackNode a)
-> TreeDirection (RedBlackNode a) -> TreeBranch (RedBlackNode a)
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch (RedBlackNode a)
insertedBranch TreeDirection (RedBlackNode a)
direction
identifyRBTCase (HasGrandparent RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection
  TreeDirection (RedBlackNode a)
parentDirection TreeBranch (RedBlackNode a)
insertedBranch) =
    if TreeBranch (RedBlackNode a)
parentBranch TreeBranch (RedBlackNode a) -> RedBlack -> Bool
forall a.
BinaryTreeNode a =>
TreeBranch (RedBlackNode a) -> RedBlack -> Bool
`branchIsColor` RedBlack
Black
      then RedBlackDirections a -> TreeBranch (RedBlackNode a) -> RBTCase a
forall a. RedBlackDirections a -> RedBlackBranch a -> RBTCase a
Case2 (TreeDirection (RedBlackNode a)
grandparentDirectionTreeDirection (RedBlackNode a)
-> RedBlackDirections a -> RedBlackDirections a
forall a. a -> [a] -> [a]
:RedBlackDirections a
directions) TreeBranch (RedBlackNode a)
parentBranch
      else RedBlackDirections a
-> TreeDirection (RedBlackNode a)
-> TreeDirection (RedBlackNode a)
-> TreeBranch (RedBlackNode a)
-> RBTCase a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackDirection a
-> RedBlackBranch a
-> RBTCase a
identifyCases345 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection TreeDirection (RedBlackNode a)
parentDirection
      TreeBranch (RedBlackNode a)
insertedBranch
  where parentBranch :: TreeBranch (RedBlackNode a)
parentBranch = TreeBranch (RedBlackNode a)
-> TreeDirection (RedBlackNode a) -> TreeBranch (RedBlackNode a)
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch (RedBlackNode a)
insertedBranch TreeDirection (RedBlackNode a)
parentDirection
        grandparentBranch :: TreeBranch (RedBlackNode a)
grandparentBranch = TreeBranch (RedBlackNode a)
-> TreeDirection (RedBlackNode a) -> TreeBranch (RedBlackNode a)
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch (RedBlackNode a)
parentBranch
          TreeDirection (RedBlackNode a)
grandparentDirection
        TreeDirection BranchType
_ RedBlackNode a
_ BinaryTree (RedBlackNode a)
uncleTree = TreeDirection (RedBlackNode a)
parentDirection
        TreeBranch BinaryTree (RedBlackNode a)
_ RedBlackNode a
parentContent BinaryTree (RedBlackNode a)
_ = TreeBranch (RedBlackNode a)
parentBranch
        TreeBranch BinaryTree (RedBlackNode a)
_ RedBlackNode a
grandparentContent BinaryTree (RedBlackNode a)
_ = TreeBranch (RedBlackNode a)
grandparentBranch

handleRBTCase1 :: (BinaryTreeNode a) => WhiteBranch a -> RedBlackTree a
handleRBTCase1 :: forall a. BinaryTreeNode a => WhiteBranch a -> RedBlackTree a
handleRBTCase1 WhiteBranch a
whiteRoot = BinaryTree (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> BinaryTree (RedBlackNode a)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree (RedBlackNode a)
leftChild RedBlackNode a
rootNode BinaryTree (RedBlackNode a)
rightChild
  where WhiteBranch BinaryTree (RedBlackNode a)
leftChild a
content BinaryTree (RedBlackNode a)
rightChild = WhiteBranch a
whiteRoot
        rootNode :: RedBlackNode a
rootNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Black a
content

handleRBTCase2 :: (BinaryTreeNode a) => RedBlackDirections a -> RedBlackBranch a
  -> RedBlackTree a
handleRBTCase2 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a -> RedBlackBranch a -> RedBlackTree a
handleRBTCase2 RedBlackDirections a
directionsFromRoot RedBlackBranch a
newBranch = RedBlackBranch a -> BinaryTree (RedBlackNode a)
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree RedBlackBranch a
rootBranch
  where branchZipper :: (RedBlackBranch a, RedBlackDirections a)
branchZipper = (RedBlackBranch a
newBranch, RedBlackDirections a
directionsFromRoot)
        (RedBlackBranch a
rootBranch, RedBlackDirections a
_) = (RedBlackBranch a, RedBlackDirections a)
-> (RedBlackBranch a, RedBlackDirections a)
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (RedBlackBranch a, RedBlackDirections a)
branchZipper

handleRBTCase3 :: (BinaryTreeNode a) => RedBlackDirections a -> a ->
  WhiteBranch a -> WhiteBranch a -> RedBlackTree a
handleRBTCase3 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RedBlackTree a
handleRBTCase3 RedBlackDirections a
directionsFromRoot a
grandparentContent WhiteBranch a
leftWBranch WhiteBranch a
rightWBranch =
  (RBTCase a -> RedBlackTree a
forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (RBTCase a -> RedBlackTree a)
-> (BranchZipper (RedBlackNode a) -> RBTCase a)
-> BranchZipper (RedBlackNode a)
-> RedBlackTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFamily (RedBlackNode a) -> RBTCase a
forall a.
BinaryTreeNode a =>
TreeFamily (RedBlackNode a) -> RBTCase a
identifyRBTCase (TreeFamily (RedBlackNode a) -> RBTCase a)
-> (BranchZipper (RedBlackNode a) -> TreeFamily (RedBlackNode a))
-> BranchZipper (RedBlackNode a)
-> RBTCase a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchZipper (RedBlackNode a) -> TreeFamily (RedBlackNode a)
forall a. BinaryTreeNode a => BranchZipper a -> TreeFamily a
getTreeFamily) BranchZipper (RedBlackNode a)
repaintedGrandparentZipper
  where newLeftChild :: RedBlackTree a
newLeftChild = WhiteBranch a -> RedBlack -> RedBlackTree a
forall a.
BinaryTreeNode a =>
WhiteBranch a -> RedBlack -> RedBlackTree a
whiteBranch2Tree WhiteBranch a
leftWBranch RedBlack
Black
        newRightChild :: RedBlackTree a
newRightChild = WhiteBranch a -> RedBlack -> RedBlackTree a
forall a.
BinaryTreeNode a =>
WhiteBranch a -> RedBlack -> RedBlackTree a
whiteBranch2Tree WhiteBranch a
rightWBranch RedBlack
Black
        newNode :: RedBlackNode a
newNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
grandparentContent
        newBranch :: TreeBranch (RedBlackNode a)
newBranch = RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> TreeBranch (RedBlackNode a)
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
newLeftChild RedBlackNode a
newNode RedBlackTree a
newRightChild
        repaintedGrandparentZipper :: BranchZipper (RedBlackNode a)
repaintedGrandparentZipper = (TreeBranch (RedBlackNode a)
newBranch, RedBlackDirections a
directionsFromRoot)

handleRBTCase4 :: (BinaryTreeNode a) =>
  RedBlackDirections a ->
  RedBlackDirection a ->
  RedBlackNode a ->
  RedBlackTree a ->
  RedBlackBranch a ->
  RedBlackTree a
handleRBTCase4 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase4 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection RedBlackNode a
parentNode RedBlackTree a
siblingTree
  RedBlackBranch a
latestBranch =
  RBTCase a -> RedBlackTree a
forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
forall a.
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
Case5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
newParentContent
  RedBlackTree a
newSiblingTree RedBlackBranch a
newLatestBranch)
  where TreeBranch RedBlackTree a
latestLeftTree (RedBlackNode RedBlack
_ a
childContent)
          RedBlackTree a
latestRightTree = RedBlackBranch a
latestBranch
        TreeDirection BranchType
grandparentDirectionType RedBlackNode a
_ RedBlackTree a
_ = RedBlackDirection a
grandparentDirection
        newParentContent :: a
newParentContent = a
childContent
        newLatestNode :: RedBlackNode a
newLatestNode = RedBlackNode a
parentNode
        newLatestBranch :: RedBlackBranch a
newLatestBranch = if BranchType
grandparentDirectionType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch then
          RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
siblingTree RedBlackNode a
newLatestNode RedBlackTree a
latestLeftTree else
          RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
latestRightTree RedBlackNode a
newLatestNode RedBlackTree a
siblingTree
        newSiblingTree :: RedBlackTree a
newSiblingTree = if BranchType
grandparentDirectionType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch then
          RedBlackTree a
latestRightTree else RedBlackTree a
latestLeftTree

handleRBTCase5 :: (BinaryTreeNode a) =>
  RedBlackDirections a ->
  RedBlackDirection a ->
  a ->
  RedBlackTree a ->
  RedBlackBranch a ->
  RedBlackTree a
handleRBTCase5 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
parentContent
  RedBlackTree a
siblingTree RedBlackBranch a
latestBranch =
  RedBlackBranch a -> RedBlackTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree RedBlackBranch a
postRotationRootBranch
  where TreeDirection BranchType
grandparentDirectionType RedBlackNode a
grandparentNode RedBlackTree a
uncleTree =
          RedBlackDirection a
grandparentDirection
        RedBlackNode RedBlack
_ a
grandparentContent = RedBlackNode a
grandparentNode
        newTopNode :: RedBlackNode a
newTopNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Black a
parentContent
        rotatedGrandparentNode :: RedBlackNode a
rotatedGrandparentNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
grandparentContent
        latestTree :: RedBlackTree a
latestTree = RedBlackBranch a -> RedBlackTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree RedBlackBranch a
latestBranch
        needsRightRotation :: Bool
needsRightRotation = BranchType
grandparentDirectionType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch
        newSiblingTree :: RedBlackTree a
newSiblingTree = if Bool
needsRightRotation
          then RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch RedBlackTree a
siblingTree RedBlackNode a
rotatedGrandparentNode RedBlackTree a
uncleTree
          else RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch RedBlackTree a
uncleTree RedBlackNode a
rotatedGrandparentNode RedBlackTree a
siblingTree
        rotatedBranch :: RedBlackBranch a
rotatedBranch = if Bool
needsRightRotation
          then RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
latestTree RedBlackNode a
newTopNode RedBlackTree a
newSiblingTree
          else RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
newSiblingTree RedBlackNode a
newTopNode RedBlackTree a
latestTree
        rotatedBranchZipper :: (RedBlackBranch a, RedBlackDirections a)
rotatedBranchZipper = (RedBlackBranch a
rotatedBranch, RedBlackDirections a
directions)
        (RedBlackBranch a
postRotationRootBranch, RedBlackDirections a
_) = (RedBlackBranch a, RedBlackDirections a)
-> (RedBlackBranch a, RedBlackDirections a)
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (RedBlackBranch a, RedBlackDirections a)
rotatedBranchZipper

handleRBTCase :: (BinaryTreeNode a) => RBTCase a -> RedBlackTree a
handleRBTCase :: forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (Case1 WhiteBranch a
whiteRoot) = WhiteBranch a -> RedBlackTree a
forall a. BinaryTreeNode a => WhiteBranch a -> RedBlackTree a
handleRBTCase1 WhiteBranch a
whiteRoot
handleRBTCase (Case2 RedBlackDirections a
directionsFromRoot RedBlackBranch a
newBranch) =
  RedBlackDirections a -> RedBlackBranch a -> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a -> RedBlackBranch a -> RedBlackTree a
handleRBTCase2 RedBlackDirections a
directionsFromRoot RedBlackBranch a
newBranch
handleRBTCase (Case3 RedBlackDirections a
directionsFromRoot a
content WhiteBranch a
leftWBranch WhiteBranch a
rightWBranch) =
  RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RedBlackTree a
handleRBTCase3 RedBlackDirections a
directionsFromRoot a
content WhiteBranch a
leftWBranch WhiteBranch a
rightWBranch
handleRBTCase (Case4 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection RedBlackNode a
parentNode RedBlackTree a
siblingTree
  RedBlackBranch a
latestBranch) =
    RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase4 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection RedBlackNode a
parentNode RedBlackTree a
siblingTree
  RedBlackBranch a
latestBranch
handleRBTCase (Case5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
parentContent
  RedBlackTree a
siblingTree RedBlackBranch a
latestBranch) =
    RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
parentContent
  RedBlackTree a
siblingTree RedBlackBranch a
latestBranch

-- | inserts a new node to the tree, performing the necessary rotations to
-- guarantee that the red black properties are kept after the insertion.
insert :: (BinaryTreeNode a) => RedBlackTree a -> a -> RedBlackTree a
insert :: forall a. BinaryTreeNode a => RedBlackTree a -> a -> RedBlackTree a
insert RedBlackTree a
tree a
newItem = if RedBlackNode a
insertedNode RedBlackNode a -> RedBlack -> Bool
forall a. BinaryTreeNode a => RedBlackNode a -> RedBlack -> Bool
`isColor` RedBlack
Black
                      then RedBlackTree a
newTreeWithNewItem
                      else (RBTCase a -> RedBlackTree a
forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (RBTCase a -> RedBlackTree a)
-> (TreeFamily (RedBlackNode a) -> RBTCase a)
-> TreeFamily (RedBlackNode a)
-> RedBlackTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFamily (RedBlackNode a) -> RBTCase a
forall a.
BinaryTreeNode a =>
TreeFamily (RedBlackNode a) -> RBTCase a
identifyRBTCase) TreeFamily (RedBlackNode a)
insertedTreeFamily
  where newNode :: RedBlackNode a
newNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
newItem
        (TreeBranch (RedBlackNode a)
insertedTreeBranch, TreeDirections (RedBlackNode a)
directions) = RedBlackTree a
-> RedBlackNode a
-> (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
forall a. BinaryTreeNode a => BinaryTree a -> a -> BranchZipper a
binaryTreeInsert RedBlackTree a
tree RedBlackNode a
newNode
        TreeBranch RedBlackTree a
_ RedBlackNode a
insertedNode RedBlackTree a
_ = TreeBranch (RedBlackNode a)
insertedTreeBranch
        insertedBranchZipper :: (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
insertedBranchZipper = (TreeBranch (RedBlackNode a)
insertedTreeBranch, TreeDirections (RedBlackNode a)
directions)
        (TreeBranch (RedBlackNode a)
rootBranch, TreeDirections (RedBlackNode a)
_) = (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
-> (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
insertedBranchZipper
        newTreeWithNewItem :: RedBlackTree a
newTreeWithNewItem = TreeBranch (RedBlackNode a) -> RedBlackTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree TreeBranch (RedBlackNode a)
rootBranch
        insertedTreeFamily :: TreeFamily (RedBlackNode a)
insertedTreeFamily = (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
-> TreeFamily (RedBlackNode a)
forall a. BinaryTreeNode a => BranchZipper a -> TreeFamily a
getTreeFamily (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
insertedBranchZipper