-- |
-- Module      : Data.RedBlackTree.TreeFamily
-- Copyright   : (c) 2017 Gabriel Aumala
--
-- License     : BSD3
-- Maintainer  : gabriel@criptext.com
-- Stability   : experimental
-- Portability : GHC
--
-- @TreeFamily@ is a structure that is used to describe the hierarchy of a tree
-- in which a new branch has been isenrted at the bottom. With this we can quickly answer
-- questions like is the new branch the root? Does it only have parent? Does have
-- a grandparent or more ancestors?. This is used internally by
-- "Data.RedBlackTree.InsertionAlgorithm" to identify insertion cases and handle
-- the appropriately.
module Data.RedBlackTree.TreeFamily (
  getTreeFamily,
  TreeFamily (IsRoot, HasParent, HasGrandparent)
) where

import Data.RedBlackTree.BinaryTree
-- | Describes the hierarchy 3 kinds of non empty trees:
--
-- 1. A tree with only 1 item. (@IsRoot@).
-- 2. A tree with a 2 level herarchy: parent and child. ()@HasParent@).
-- 3. A tree with a hierarchy of at least 3 levels: grandparent, parent and
-- child. (@HasGrandparent@)
data TreeFamily a =
  IsRoot (TreeBranch a) |
  HasParent (TreeDirection a) (TreeBranch a) |
  HasGrandparent (TreeDirections a) (TreeDirection a) (TreeDirection a)
    (TreeBranch a)

getTreeFamily' :: (BinaryTreeNode a) => BranchZipper a -> TreeDirection a ->
  TreeBranch a -> TreeFamily a
getTreeFamily' (parentBranch, []) direction branch =
  HasParent direction branch
getTreeFamily' (_, grandparentDirection:xs) parentDirection branch =
  HasGrandparent xs grandparentDirection parentDirection branch

-- | Takes a zipper focusing on a branch and returns a @TreeFamily@ structure
-- relative to that branch.
getTreeFamily :: (BinaryTreeNode a) => BranchZipper a -> TreeFamily a
getTreeFamily (branch, []) = IsRoot branch
getTreeFamily (branch, direction:xs) =
  getTreeFamily' parentZipper direction branch
  where parentBranch = reconstructAncestor branch direction
        parentZipper = (parentBranch, xs)