{-# OPTIONS -Wall #-}

-- A definition of binary trees in Haskell
-- It corresponds roughly to this Java class:
--   public class Tree <E> {
--     class Node {
--       E contents;
--       Node left, right;  // null means no sub tree
--     }
--     Node root;  // null means empty tree
--   }

data Tree a =
      Empty
    | Node a (Tree a) (Tree a)


-- inOrder makes an in-order list of the values in the tree
-- If it's a BST then the list will be sorted.

inOrder :: Tree a -> [a]
inOrder t =
    case t of
        Empty        -> []
        Node x t1 t2 -> inOrder t1 ++ [x] ++ inOrder t2

-- inOrder' does the same thing, but is defined using pattern matching on function definition level
-- instead of a case expression.

inOrder' :: Tree a -> [a]
inOrder' Empty          = []
inOrder' (Node x t1 t2) = inOrder' t1 ++ [x] ++ inOrder' t2


-- isComplete determines whether the tree is complete (has the shape of a binary heap)

isComplete :: Tree a -> Bool
isComplete t =
    case isComplete' t of
        Perf _  -> True
        Compl _ -> True
        Incompl -> False

-- Recursively, we need more information about a sub tree than whether it's complete.
-- Compl is used locally to provide this information.

data Compl =
    Perf Int   -- The tree is perfect with the provided height.
  | Compl Int  -- The tree is complete, but not perfect, with the provided height.
  | Incompl    -- The tree is not complete.
 deriving Show

isComplete' :: Tree a -> Compl
isComplete' Empty = Perf 0
isComplete' (Node _ t1 t2) = 
    case (isComplete' t1, isComplete' t2) of
        (Perf h1, Perf h2)  | h1 == h2               -> Perf (h1+1)
        (Perf h1, Perf h2)  | h1 == h2+1             -> Compl (h1+1)
        (Compl h1, Perf h2) | h1 == h2+1             -> Compl (h1+1)
        (Perf h1, Compl h2) | h1 == h2               -> Compl (h1+1)
        _                                            -> Incompl


-- isBST determines whether the tree is a BST

isBST :: Ord a => Tree a -> Bool
isBST t = case isBST' t of
            BST _ _  -> True
            NoBST    -> False
            EmptyBST -> True

-- Recursively, we need more information about a sub tree than whether it's a BST.
-- BST is used locally to provide this information.

data BST a =
    BST a a   -- It's a BST with smallest and largest value in the sub tree provided by the two arguments.
  | NoBST     -- It's not a BST.
  | EmptyBST  -- It's the empty tree, which is a BST.

isBST' :: Ord a => Tree a -> BST a
isBST' Empty = EmptyBST
isBST' (Node x t1 t2) = 
    case (isBST' t1, isBST' t2) of
        (BST min1 max1, BST min2 max2) | max1 < x && x < min2 -> BST min1 max2
        (EmptyBST, EmptyBST)                                  -> BST x x
        (BST min1 max1, EmptyBST)      | max1 < x             -> BST min1 x
        (EmptyBST, BST min2 max2)      | x < min2             -> BST x max2
        _                                                     -> NoBST


-- isBSTalt is an alternative implementation of isBST
-- Instead of having a richer return type than Bool,
-- information about the acceptable range of values is provided in the recursive calls.

isBSTalt :: Ord a => Tree a -> Bool
isBSTalt t = isBST'' t Nothing Nothing

-- The first Maybe a is the value which must be smaller than all values in the sub tree, or Nothing if there is no such value.
-- The second Maybe a is the same but must be larger than all values in the sub tree.
-- In the call to isBST'' in the top level function there is no lower or upper limits, so the arguments are both Nothing.

isBST'' :: Ord a => Tree a -> Maybe a -> Maybe a -> Bool
isBST'' t mmin mmax = 
    case t of
        Empty -> True
        Node x t1 t2 -> case mmin of {Nothing -> True; Just y -> y < x } &&
                        case mmax of {Nothing -> True; Just y -> x < y } &&
                        isBST'' t1 mmin (Just x)                         &&
                        isBST'' t2 (Just x) mmax

-- Examples of trees:

ex1 :: Tree Int
ex1 = Node 5 (Node 3 (Node 1 Empty Empty) Empty) (Node 9 (Node 7 Empty Empty) Empty)

ex2 :: Tree Int
ex2 = Node 5 (Node 3 (Node 1 Empty Empty) (Node 6 Empty Empty)) (Node 9 (Node 7 Empty Empty) Empty)

main :: IO ()
main = do
 putStrLn $ show $ isComplete ex1
 putStrLn $ show $ isComplete ex2
 putStrLn $ show $ isBST ex1
 putStrLn $ show $ isBST ex2
 putStrLn $ show $ isBSTalt ex1
 putStrLn $ show $ isBSTalt ex2
 putStrLn $ show $ inOrder ex1