-- <pre>
------------------------------------------------------------
-- A 2-3 Tree has two kinds of branching (non-leaf) nodes.
-- They have either 2 or 3 sub trees.
-- There are also two kinds of leaf nodes that store either
-- one or two elements.

data Tree:: Nat ~> *0 ~> *0 where
  Empty:: Tree Z a
  Leaf1:: a -> Tree Z a
  Leaf2:: a -> a -> Tree Z a
  Node1:: Tree n a -> a -> Tree n a -> Tree (S n) a
  Node2::  Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree (S n) a

---------------------------------------------------------------
-- 2-3 Trees maintain a variation of the binary search tree invariant

-- 1) There are no duplicate lements in the tree.
-- 2) In a leaf node (Leaf x y) it is an invariant that x<y
-- 3) In a branching node (Node1 t1 x t2) it is an invariant
--    that all values found in t1 are less than x, and all
--    values found in t2 are greater than x
-- 4) In a branching node (Node2 t1 x t2 y t3) it is an invariant
--    that all values found in t1 are less than x, and all
--    values found in t2 are greater than x and less than y
--    and all values found in t3 are greater than y
-- 5) The Empty Tree is never stored as a sub tree of a Node1
--    or Node2 (Or returned as the value of insert).

------------------------------------------------------------
-- finding values in a 2-3 Tree is just like binary search

find :: Int -> Tree n Int -> Bool
find n Empty = False
find n (Leaf1 x)
  | n==x = True
  | otherwise = False
find n (Leaf2 x y)
  | n==x = True
  | n==y = True
  | otherwise = False
find n (Node1 t1 x t2)
  | n<x  = find n t1
  | n==x = True
  | n>x  = find n t2
find n (Node2 t1 x t2 y t3)
  | n<x  = find n t1
  | n==x = True
  | n<y  = find n t2
  | n==y = True
  | n>y  = find n t3

-------------------------------------------------------------------
otherwise = True

data Growth:: *0 ~> *0 ~>*0 where
  Same  :: a -> Growth a b
  Taller:: b -> Growth a b

-- When inserting a value into a 2-3 Tree, the tree may grow
-- in Height, or may increase in branching factor from 2 to 3.
-- We use the type Growth to record this information

insert :: Int -> Tree n Int -> Growth (Tree n Int) (Tree (S n) Int)
insert x Empty = Same (Leaf1 x)
insert x (t@(Leaf1 y))
  | x<y  = Same (Leaf2 x y)
  | x==y = Same t
  | x>y  = Same (Leaf2 y x)
insert x (t@(Leaf2 y z))
  | x<y  = Taller (Node1 (Leaf1 x) y (Leaf1 z))
  | x==y = Same t
  | x<z  = Taller (Node1 (Leaf1 y) x (Leaf1 z))
  | x==z = Same t
  | x>z  = Taller (Node1 (Leaf1 y) z (Leaf1 x))
insert x (t@(Node1 t1 y t2))
  | x<y  = case insert x t1 of
             Same t1' -> Same (Node1 t1' y t2)
             Taller (Node1 m b n) -> Same (Node2 m b n y t2)
             Taller (Node2 i b j c k) -> Taller (Node1 (Node1 i b j) c (Node1 k y t2))
  | x==y = Same t
  | x>y  = case insert x t2 of
             Same t2' -> Same (Node1 t1 y t2')
             Taller (Node1 m b n) -> Same (Node2 t1 y m b n)
             Taller (Node2 i b j c k) -> Taller (Node1 (Node1 t1 y i) b (Node1 j c k))
insert x (t@(Node2 t1 y t2 z t3))
  | x<y  = case insert x t1 of
             Same t1' -> Same (Node2 t1' y t2 z t3)
             Taller t1' -> Taller (Node1 t1' y (Node1 t2 z t3))
  | x==y = Same t
  | x<z  = case insert x t2 of
             Same t2' -> Same (Node2 t1 y t2' z t3)
             Taller (Node1 t4 w t5) -> Taller (Node1 (Node1 t1 y t4) w (Node1 t5 z t3))
             Taller (Node2 t4 u t5 v t6) -> Taller (Node1 (Node2 t1 y t4 u t5) v (Node1 t6 z t3))
  | x==z = Same t
  | x>z  = case insert x t3 of
             Same t3' -> Same (Node2 t1 y t2 z t3')
             Taller t3' -> Taller (Node1 (Node1 t1 y t2) z t3')


--------------------------------------------

data Shrinks :: Nat ~> *0 ~>*0 where
  NoChange :: Tree n a -> Shrinks n a
  Shorter  :: Tree n a -> Shrinks (S n) a

delete:: Int -> Tree n Int -> Shrinks n Int
delete n (t@(Leaf1 x))
  | n==x = NoChange Empty
  | otherwise = NoChange t
delete n (t@(Leaf2 x y))
  | n==x = NoChange(Leaf1 y)
  | n==y = NoChange(Leaf1 x)
delete n (t@(Node1 t1 x t2))
  | n<x = case (delete n t1,t2) of
           (NoChange t1',_) -> NoChange(Node1 t1' x t2)
           (Shorter t1',Node1 t3 y t4) -> Shorter( Node2 t1' x t3 y t4 )
           (Shorter t1',Node2 t3 y t4 z t5) -> NoChange(Node1 (Node1 t1' x t3) y (Node1 t4 z t5))
  | n==x = undefined
  | n>x = undefined

merge2 :: Tree n Int -> Tree n Int -> Growth (Tree n Int) (Tree (S n) Int)
merge2 (Leaf1 x) (Leaf1 y) = Same (Leaf2 x y)
merge2 (Leaf1 x) (Leaf2 y z) = Taller(Node1 (Leaf1 x) y (Leaf1 z))
merge2 (Leaf2 x y) (Leaf1 z) = Taller(Node1 (Leaf1 x) y (Leaf1 z))
merge2 (Leaf2 w x) (Leaf2 y z) = Taller(Node1 (Leaf1 w) x (Leaf2 y z))
merge2 (Node1 t1 x t2) (Node1 t3 y t4) =

</pre>