import Test.QuickCheck
import System.Random

data BST a = Empty | Node (BST a) a (BST a) deriving (Eq, Show)

bt :: Arbitrary a => Gen (BST a)
bt = oneof [return Empty,
            Node <$> bt <*> arbitrary <*> bt]

isBST :: Ord a => BST a -> Bool
isBST t = isBST' Nothing Nothing t
 where isBST' lower upper Empty = True
       isBST' lower upper (Node l x r) =
           maybeBounded lower upper x &&
           isBST' lower (Just x) l &&
           isBST' (Just x) upper r
       maybeBounded Nothing Nothing x = True
       maybeBounded Nothing (Just upper) x = x < upper
       maybeBounded (Just lower) Nothing x = lower < x
       maybeBounded (Just lower) (Just upper) x = lower < x && x < upper

sizedBST :: (Arbitrary a, Ord a, Random a, Enum a) =>
            a -> a -> Int -> Gen (BST a)
sizedBST lo hi 0 = return Empty
sizedBST lo hi n =
  oneof [pure Empty,
         do
           v <- choose (lo,hi)
           l <- sizedBST lo (pred v) (n `div` 2)
           r <- sizedBST (succ v) hi (n `div` 2)
           return $ Node l v r]

bst :: (Arbitrary a, Ord a, Random a, Bounded a, Enum a) => Gen (BST a)
bst = sized $ sizedBST minBound maxBound

insert x Empty = Node Empty x Empty
insert x (Node l y r) | x < y  = Node (insert x l) y r
                      | x == y = Node l y r
                      | x > y  = Node l y (insert x r)

delete x Empty = Empty
delete x (Node l y r)
  | x < y  = Node (delete x l) y r
  | x > y  = Node l y (delete x r)
  | x == y = case (l,r) of
               (Empty, _) -> r
               (l, Empty) -> l
               _          -> let (min, r') = deleteMin r in
                             Node l min r'
  where deleteMin Empty = error "nope"
        deleteMin (Node Empty x r) = (x,r)
        deleteMin (Node l x r) =
          let (min, l') = deleteMin l in
          (min, Node l' x r)

find _ Empty = Nothing
find v (Node l x r)
  | v < x  = v `find` l
  | v == x = Just x
  | v > x  = v `find` r


bsts' :: (Arbitrary a, Ord a) => Gen (BST a)
bsts' = listOf arbitrary >>= return . foldr insert Empty

insertFind :: Int -> BST Int -> Bool
insertFind x t = (find x $ insert x t) /= Nothing

insertValid :: Int -> Property
insertValid x = forAll bt $
                  \t -> isBST t ==> isBST $ insert x t