-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
-- AVL Tree data type definition.
--
-- This is an internal unstable module, it's contents may change
-- in any way whatsoever and without any warning between minor versions of this package.
-- PVP does not apply.
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Internals.Types
        ( -- * Types
         AVL(..),
        ) where

-- | AVL tree data type.
--
-- The balance factor (BF) of an 'AVL' tree node is defined as the difference between the height of
-- the left and right sub-trees. An 'AVL' tree is ALWAYS height balanced, such that |BF| <= 1.
-- The functions in this library ("Data.Tree.AVL") are designed so that they never construct
-- an unbalanced tree (well that's assuming they're not broken). The 'AVL' tree type defined here
-- has the BF encoded the constructors.
--
-- Some functions in this library return 'AVL' trees that are also \"flat\", which (in the context
-- of this library) means that the sizes of left and right sub-trees differ by at most one and
-- are also flat. Flat sorted trees should give slightly shorter searches than sorted trees which
-- are merely height balanced. Whether or not flattening is worth the effort depends on the number
-- of times the tree will be searched and the cost of element comparison.
--
-- In cases where the tree elements are sorted, all the relevant 'AVL' functions follow the
-- convention that the leftmost tree element is least and the rightmost tree element is
-- the greatest. Bear this in mind when defining general comparison functions. It should
-- also be noted that all functions in this library for sorted trees require that the tree
-- does not contain multiple elements which are \"equal\" (according to whatever criterion
-- has been used to sort the elements).
--
-- It is important to be consistent about argument ordering when defining general purpose
-- comparison functions (or selectors) for searching a sorted tree, such as ..
--
-- @
-- myComp  :: (k -> e -> Ordering)
-- -- or
-- myCComp :: (k -> e -> COrdering a)
-- @
--
-- In these cases the first argument is the search key and the second argument is an element of
-- the 'AVL' tree. For example..
--
-- @
-- key \`myCComp\` element -> Lt  implies key < element, proceed down the left sub-tree
-- key \`myCComp\` element -> Gt  implies key > element, proceed down the right sub-tree
-- @
--
-- This convention is same as that used by the overloaded 'compare' method from 'Ord' class.
--
-- Controlling Strictness.
--
-- The 'AVL' tree data type is declared as non-strict in all it's fields,
-- but all the functions in this library behave as though it is strict in its
-- recursive fields (left and right sub-trees). Strictness in the element field is
-- controlled either by using the strict variants of functions (defined in this library
-- where appropriate), or using strict variants of the combinators defined in "Data.COrdering",
-- or using 'seq' etc. in your own code (in any combining comparisons you define, for example).
--
-- The 'Eq' and 'Ord' instances.
--
-- Begining with version 3.0 these are now derived, and hence are defined in terms of
-- strict structural equality, rather than observational equivalence. The reason for
-- this change is that the observational equivalence abstraction was technically breakable
-- with the exposed API. But since this change, some functions which were previously
-- considered unsafe have become safe to expose (those that measure tree height, for example).
--
-- The 'Read' and 'Show' instances.
--
-- Begining with version 4.0 these are now derived to ensure consistency with 'Eq' instance.
-- (Show now reveals the exact tree structure).
--

data AVL e = E                      -- ^ Empty Tree
           | N (AVL e) e (AVL e)    -- ^ BF=-1 (right height > left height)
           | Z (AVL e) e (AVL e)    -- ^ BF= 0
           | P (AVL e) e (AVL e)    -- ^ BF=+1 (left height > right height)
           deriving(AVL e -> AVL e -> Bool
(AVL e -> AVL e -> Bool) -> (AVL e -> AVL e -> Bool) -> Eq (AVL e)
forall e. Eq e => AVL e -> AVL e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => AVL e -> AVL e -> Bool
== :: AVL e -> AVL e -> Bool
$c/= :: forall e. Eq e => AVL e -> AVL e -> Bool
/= :: AVL e -> AVL e -> Bool
Eq,Eq (AVL e)
Eq (AVL e) =>
(AVL e -> AVL e -> Ordering)
-> (AVL e -> AVL e -> Bool)
-> (AVL e -> AVL e -> Bool)
-> (AVL e -> AVL e -> Bool)
-> (AVL e -> AVL e -> Bool)
-> (AVL e -> AVL e -> AVL e)
-> (AVL e -> AVL e -> AVL e)
-> Ord (AVL e)
AVL e -> AVL e -> Bool
AVL e -> AVL e -> Ordering
AVL e -> AVL e -> AVL e
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 e. Ord e => Eq (AVL e)
forall e. Ord e => AVL e -> AVL e -> Bool
forall e. Ord e => AVL e -> AVL e -> Ordering
forall e. Ord e => AVL e -> AVL e -> AVL e
$ccompare :: forall e. Ord e => AVL e -> AVL e -> Ordering
compare :: AVL e -> AVL e -> Ordering
$c< :: forall e. Ord e => AVL e -> AVL e -> Bool
< :: AVL e -> AVL e -> Bool
$c<= :: forall e. Ord e => AVL e -> AVL e -> Bool
<= :: AVL e -> AVL e -> Bool
$c> :: forall e. Ord e => AVL e -> AVL e -> Bool
> :: AVL e -> AVL e -> Bool
$c>= :: forall e. Ord e => AVL e -> AVL e -> Bool
>= :: AVL e -> AVL e -> Bool
$cmax :: forall e. Ord e => AVL e -> AVL e -> AVL e
max :: AVL e -> AVL e -> AVL e
$cmin :: forall e. Ord e => AVL e -> AVL e -> AVL e
min :: AVL e -> AVL e -> AVL e
Ord,Int -> AVL e -> ShowS
[AVL e] -> ShowS
AVL e -> String
(Int -> AVL e -> ShowS)
-> (AVL e -> String) -> ([AVL e] -> ShowS) -> Show (AVL e)
forall e. Show e => Int -> AVL e -> ShowS
forall e. Show e => [AVL e] -> ShowS
forall e. Show e => AVL e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> AVL e -> ShowS
showsPrec :: Int -> AVL e -> ShowS
$cshow :: forall e. Show e => AVL e -> String
show :: AVL e -> String
$cshowList :: forall e. Show e => [AVL e] -> ShowS
showList :: [AVL e] -> ShowS
Show,ReadPrec [AVL e]
ReadPrec (AVL e)
Int -> ReadS (AVL e)
ReadS [AVL e]
(Int -> ReadS (AVL e))
-> ReadS [AVL e]
-> ReadPrec (AVL e)
-> ReadPrec [AVL e]
-> Read (AVL e)
forall e. Read e => ReadPrec [AVL e]
forall e. Read e => ReadPrec (AVL e)
forall e. Read e => Int -> ReadS (AVL e)
forall e. Read e => ReadS [AVL e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. Read e => Int -> ReadS (AVL e)
readsPrec :: Int -> ReadS (AVL e)
$creadList :: forall e. Read e => ReadS [AVL e]
readList :: ReadS [AVL e]
$creadPrec :: forall e. Read e => ReadPrec (AVL e)
readPrec :: ReadPrec (AVL e)
$creadListPrec :: forall e. Read e => ReadPrec [AVL e]
readListPrec :: ReadPrec [AVL e]
Read)

instance Foldable AVL where
  foldMap :: forall m a. Monoid m => (a -> m) -> AVL a -> m
foldMap a -> m
_f AVL a
E = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (N AVL a
l a
v AVL a
r) = (a -> m) -> AVL a -> m
forall m a. Monoid m => (a -> m) -> AVL a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AVL a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> AVL a -> m
forall m a. Monoid m => (a -> m) -> AVL a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AVL a
r
  foldMap a -> m
f (Z AVL a
l a
v AVL a
r) = (a -> m) -> AVL a -> m
forall m a. Monoid m => (a -> m) -> AVL a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AVL a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> AVL a -> m
forall m a. Monoid m => (a -> m) -> AVL a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AVL a
r
  foldMap a -> m
f (P AVL a
l a
v AVL a
r) = (a -> m) -> AVL a -> m
forall m a. Monoid m => (a -> m) -> AVL a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AVL a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> AVL a -> m
forall m a. Monoid m => (a -> m) -> AVL a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AVL a
r