content: import qualified Data.IntSet as IntSet
  import Data.List (nub,sort)
  import qualified Data.List as List
  import Data.Monoid (mempty)
  import Data.Set
  import Prelude hiding (lookup, null, map, filter, foldr, foldl)
  import Test.Framework
  import Test.Framework.Providers.HUnit
  import Test.Framework.Providers.QuickCheck2
  import Test.HUnit hiding (Test, Testable)
  import Test.QuickCheck
  
  main :: IO ()
  main = defaultMainWithOpts [ testCase "lookupLT" test_lookupLT
                             , testCase "lookupGT" test_lookupGT
                             , testCase "lookupLE" test_lookupLE
                             , testCase "lookupGE" test_lookupGE
                             , testProperty "prop_Valid" prop_Valid
                             , testProperty "prop_Single" prop_Single
                             , testProperty "prop_Member" prop_Member
                             , testProperty "prop_NotMember" prop_NotMember
                             , testProperty "prop_LookupLT" prop_LookupLT
                             , testProperty "prop_LookupGT" prop_LookupGT
                             , testProperty "prop_LookupLE" prop_LookupLE
                             , testProperty "prop_LookupGE" prop_LookupGE
                             , testProperty "prop_InsertValid" prop_InsertValid
                             , testProperty "prop_InsertDelete" prop_InsertDelete
                             , testProperty "prop_DeleteValid" prop_DeleteValid
                             , testProperty "prop_Join" prop_Join
                             , testProperty "prop_Merge" prop_Merge
                             , testProperty "prop_UnionValid" prop_UnionValid
                             , testProperty "prop_UnionInsert" prop_UnionInsert
                             , testProperty "prop_UnionAssoc" prop_UnionAssoc
                             , testProperty "prop_UnionComm" prop_UnionComm
                             , testProperty "prop_DiffValid" prop_DiffValid
                             , testProperty "prop_Diff" prop_Diff
                             , testProperty "prop_IntValid" prop_IntValid
                             , testProperty "prop_Int" prop_Int
                             , testProperty "prop_Ordered" prop_Ordered
                             , testProperty "prop_List" prop_List
                             , testProperty "prop_DescList" prop_DescList
                             , testProperty "prop_AscDescList" prop_AscDescList
                             , testProperty "prop_fromList" prop_fromList
                             , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
                             , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
                             , testProperty "prop_isSubsetOf" prop_isSubsetOf
                             , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
                             , testProperty "prop_size" prop_size
                             , testProperty "prop_findMax" prop_findMax
                             , testProperty "prop_findMin" prop_findMin
                             , testProperty "prop_ord" prop_ord
                             , testProperty "prop_readShow" prop_readShow
                             , testProperty "prop_foldR" prop_foldR
                             , testProperty "prop_foldR'" prop_foldR'
                             , testProperty "prop_foldL" prop_foldL
                             , testProperty "prop_foldL'" prop_foldL'
                             , testProperty "prop_map" prop_map
                             , testProperty "prop_maxView" prop_maxView
                             , testProperty "prop_minView" prop_minView
                             , testProperty "prop_split" prop_split
                             , testProperty "prop_splitMember" prop_splitMember
                             , testProperty "prop_partition" prop_partition
                             , testProperty "prop_filter" prop_filter
                             ] opts
    where
      opts = mempty { ropt_test_options = Just $ mempty { topt_maximum_generated_tests = Just 500
                                                        , topt_maximum_unsuitable_generated_tests = Just 500
                                                        }
                    }
  
  ----------------------------------------------------------------
  -- Unit tests
  ----------------------------------------------------------------
  
  test_lookupLT :: Assertion
  test_lookupLT = do
      lookupLT 3 (fromList [3, 5]) @?= Nothing
      lookupLT 5 (fromList [3, 5]) @?= Just 3
  
  test_lookupGT :: Assertion
  test_lookupGT = do
     lookupGT 4 (fromList [3, 5]) @?= Just 5
     lookupGT 5 (fromList [3, 5]) @?= Nothing
  
  test_lookupLE :: Assertion
  test_lookupLE = do
     lookupLE 2 (fromList [3, 5]) @?= Nothing
     lookupLE 4 (fromList [3, 5]) @?= Just 3
     lookupLE 5 (fromList [3, 5]) @?= Just 5
  
  test_lookupGE :: Assertion
  test_lookupGE = do
     lookupGE 3 (fromList [3, 5]) @?= Just 3
     lookupGE 4 (fromList [3, 5]) @?= Just 5
     lookupGE 6 (fromList [3, 5]) @?= Nothing
  
  {--------------------------------------------------------------------
    Arbitrary, reasonably balanced trees
  --------------------------------------------------------------------}
  instance (Enum a) => Arbitrary (Set a) where
      arbitrary = sized (arbtree 0 maxkey)
        where maxkey = 10000
  
              arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a)
              arbtree lo hi n = do t <- gentree lo hi n
                                   if balanced t then return t else arbtree lo hi n
                where gentree lo hi n
                        | n <= 0    = return Tip
                        | lo >= hi  = return Tip
                        | otherwise = do  i  <- choose (lo,hi)
                                          m  <- choose (1,70)
                                          let (ml,mr) | m==(1::Int) = (1,2)
                                                      | m==2        = (2,1)
                                                      | m==3        = (1,1)
                                                      | otherwise   = (2,2)
                                          l  <- gentree lo (i-1) (n `div` ml)
                                          r  <- gentree (i+1) hi (n `div` mr)
                                          return (bin (toEnum i) l r)
  
  {--------------------------------------------------------------------
    Valid tree's
  --------------------------------------------------------------------}
  forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property
  forValid f = forAll arbitrary $ \t ->
  --    classify (balanced t) "balanced" $
      classify (size t == 0) "empty" $
      classify (size t > 0  && size t <= 10) "small" $
      classify (size t > 10 && size t <= 64) "medium" $
      classify (size t > 64) "large" $
      balanced t ==> f t
  
  forValidUnitTree :: Testable a => (Set Int -> a) -> Property
  forValidUnitTree f = forValid f
  
  prop_Valid :: Property
  prop_Valid = forValidUnitTree $ \t -> valid t
  
  {--------------------------------------------------------------------
    Single, Member, Insert, Delete
  --------------------------------------------------------------------}
  prop_Single :: Int -> Bool
  prop_Single x = (insert x empty == singleton x)
  
  prop_Member :: [Int] -> Int -> Bool
  prop_Member xs n =
    let m  = fromList xs
    in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
  
  prop_NotMember :: [Int] -> Int -> Bool
  prop_NotMember xs n =
    let m  = fromList xs
    in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
  
  test_LookupSomething :: (Int -> Set Int -> Maybe Int) -> (Int -> Int -> Bool) -> [Int] -> Bool
  test_LookupSomething lookup' cmp xs =
    let odd_sorted_xs = filter_odd $ nub $ sort xs
        t = fromList odd_sorted_xs
        test x = case List.filter (`cmp` x) odd_sorted_xs of
                   []             -> lookup' x t == Nothing
                   cs | 0 `cmp` 1 -> lookup' x t == Just (last cs) -- we want largest such element
                      | otherwise -> lookup' x t == Just (head cs) -- we want smallest such element
    in all test xs
  
    where filter_odd [] = []
          filter_odd [_] = []
          filter_odd (_ : o : xs) = o : filter_odd xs
  
  prop_LookupLT :: [Int] -> Bool
  prop_LookupLT = test_LookupSomething lookupLT (<)
  
  prop_LookupGT :: [Int] -> Bool
  prop_LookupGT = test_LookupSomething lookupGT (>)
  
  prop_LookupLE :: [Int] -> Bool
  prop_LookupLE = test_LookupSomething lookupLE (<=)
  
  prop_LookupGE :: [Int] -> Bool
  prop_LookupGE = test_LookupSomething lookupGE (>=)
  
  prop_InsertValid :: Int -> Property
  prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t)
  
  prop_InsertDelete :: Int -> Set Int -> Property
  prop_InsertDelete k t = not (member k t) ==> delete k (insert k t) == t
  
  prop_DeleteValid :: Int -> Property
  prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t))
  
  {--------------------------------------------------------------------
    Balance
  --------------------------------------------------------------------}
  prop_Join :: Int -> Property
  prop_Join x = forValidUnitTree $ \t ->
      let (l,r) = split x t
      in valid (join x l r)
  
  prop_Merge :: Int -> Property
  prop_Merge x = forValidUnitTree $ \t ->
      let (l,r) = split x t
      in valid (merge l r)
  
  {--------------------------------------------------------------------
    Union
  --------------------------------------------------------------------}
  prop_UnionValid :: Property
  prop_UnionValid
    = forValidUnitTree $ \t1 ->
      forValidUnitTree $ \t2 ->
      valid (union t1 t2)
  
  prop_UnionInsert :: Int -> Set Int -> Bool
  prop_UnionInsert x t = union t (singleton x) == insert x t
  
  prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
  prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
  
  prop_UnionComm :: Set Int -> Set Int -> Bool
  prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1)
  
  prop_DiffValid :: Property
  prop_DiffValid = forValidUnitTree $ \t1 ->
      forValidUnitTree $ \t2 ->
      valid (difference t1 t2)
  
  prop_Diff :: [Int] -> [Int] -> Bool
  prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys))
                    == List.sort ((List.\\) (nub xs)  (nub ys))
  
  prop_IntValid :: Property
  prop_IntValid = forValidUnitTree $ \t1 ->
      forValidUnitTree $ \t2 ->
      valid (intersection t1 t2)
  
  prop_Int :: [Int] -> [Int] -> Bool
  prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys))
                   == List.sort (nub ((List.intersect) (xs)  (ys)))
  
  {--------------------------------------------------------------------
    Lists
  --------------------------------------------------------------------}
  prop_Ordered :: Property
  prop_Ordered = forAll (choose (5,100)) $ \n ->
      let xs = [0..n::Int]
      in fromAscList xs == fromList xs
  
  prop_List :: [Int] -> Bool
  prop_List xs = (sort (nub xs) == toList (fromList xs))
  
  prop_DescList :: [Int] -> Bool
  prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
  
  prop_AscDescList :: [Int] -> Bool
  prop_AscDescList xs = toAscList s == reverse (toDescList s)
    where s = fromList xs
  
  prop_fromList :: [Int] -> Bool
  prop_fromList xs
    = case fromList xs of
        t -> t == fromAscList sort_xs &&
             t == fromDistinctAscList nub_sort_xs &&
             t == List.foldr insert empty xs
    where sort_xs = sort xs
          nub_sort_xs = List.map List.head $ List.group sort_xs
  
  {--------------------------------------------------------------------
    Set operations are like IntSet operations
  --------------------------------------------------------------------}
  toIntSet :: Set Int -> IntSet.IntSet
  toIntSet = IntSet.fromList . toList
  
  -- Check that Set Int.isProperSubsetOf is the same as Set.isProperSubsetOf.
  prop_isProperSubsetOf :: Set Int -> Set Int -> Bool
  prop_isProperSubsetOf a b = isProperSubsetOf a b == IntSet.isProperSubsetOf (toIntSet a) (toIntSet b)
  
  -- In the above test, isProperSubsetOf almost always returns False (since a
  -- random set is almost never a subset of another random set).  So this second
  -- test checks the True case.
  prop_isProperSubsetOf2 :: Set Int -> Set Int -> Bool
  prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where
    c = union a b
  
  prop_isSubsetOf :: Set Int -> Set Int -> Bool
  prop_isSubsetOf a b = isSubsetOf a b == IntSet.isSubsetOf (toIntSet a) (toIntSet b)
  
  prop_isSubsetOf2 :: Set Int -> Set Int -> Bool
  prop_isSubsetOf2 a b = isSubsetOf a (union a b)
  
  prop_size :: Set Int -> Bool
  prop_size s = size s == List.length (toList s)
  
  prop_findMax :: Set Int -> Property
  prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
  
  prop_findMin :: Set Int -> Property
  prop_findMin s = not (null s) ==> findMin s == minimum (toList s)
  
  prop_ord :: Set Int -> Set Int -> Bool
  prop_ord s1 s2 = s1 `compare` s2 == toList s1 `compare` toList s2
  
  prop_readShow :: Set Int -> Bool
  prop_readShow s = s == read (show s)
  
  prop_foldR :: Set Int -> Bool
  prop_foldR s = foldr (:) [] s == toList s
  
  prop_foldR' :: Set Int -> Bool
  prop_foldR' s = foldr' (:) [] s == toList s
  
  prop_foldL :: Set Int -> Bool
  prop_foldL s = foldl (flip (:)) [] s == List.foldl (flip (:)) [] (toList s)
  
  prop_foldL' :: Set Int -> Bool
  prop_foldL' s = foldl' (flip (:)) [] s == List.foldl' (flip (:)) [] (toList s)
  
  prop_map :: Set Int -> Bool
  prop_map s = map id s == s
  
  prop_maxView :: Set Int -> Bool
  prop_maxView s = case maxView s of
      Nothing -> null s
      Just (m,s') -> m == maximum (toList s) && s == insert m s' && m `notMember` s'
  
  prop_minView :: Set Int -> Bool
  prop_minView s = case minView s of
      Nothing -> null s
      Just (m,s') -> m == minimum (toList s) && s == insert m s' && m `notMember` s'
  
  prop_split :: Set Int -> Int -> Bool
  prop_split s i = case split i s of
      (s1,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && i `delete` s == union s1 s2
  
  prop_splitMember :: Set Int -> Int -> Bool
  prop_splitMember s i = case splitMember i s of
      (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
  
  prop_partition :: Set Int -> Int -> Bool
  prop_partition s i = case partition odd s of
      (s1,s2) -> all odd (toList s1) && all even (toList s2) && s == s1 `union` s2
  
  prop_filter :: Set Int -> Int -> Bool
  prop_filter s i = partition odd s == (filter odd s, filter even s)
  