import qualified Data.List as List
import Data.List.Ordered
import Test.QuickCheck
import Test.QuickCheck.Arbitrary

prop_member :: NonNegative Int -> Positive Int -> Bool
prop_member (NonNegative n) (Positive d)
    = member n [0,d..] == (n `mod` d == 0)

prop_insertBag_sort       :: [Int] -> Bool
prop_insertBag_sort    xs = foldr insertBag [] xs == sort xs

prop_insertSet_nubSort    :: [Int] -> Bool
prop_insertSet_nubSort xs = foldr insertSet [] xs == nubSort xs

prop_nub :: OrderedList Int -> Bool
prop_nub (Ordered xs) =  List.nub xs == nub xs

prop_nub_isSorted :: [Int] -> Bool
prop_nub_isSorted xs = isSortedBy (<) (nub xs)

prop_nubSort_isSorted :: [Int] -> Bool
prop_nubSort_isSorted xs = isSortedBy (<) (nubSort xs)

prop_isect_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_isect_subset (Ordered xs) (Ordered ys)
    =  let zs = isect xs ys
        in zs `subset` xs && zs `subset` ys

prop_isect_examples
    =  isect  [1,2,3,4] [3,4,5,6]   == [3,4]
    && isect  [1,3,5]   [2,4,6]     == []
    && isect  [2,4,6,8] [3,6,9]     == [6]
    && isect  [1,2,2,2] [1,1,1,2,2] == [1,2,2]

prop_union_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_union_subset (Ordered xs) (Ordered ys)
    =  let zs = union xs ys
        in xs `subset` zs && ys `subset` zs

prop_isect_subset_union :: OrderedList Int -> OrderedList Int -> Bool
prop_isect_subset_union (Ordered xs) (Ordered ys)
    =  isect xs ys `subset` union xs ys

prop_union_examples
    =  union  [1,2,3,4] [3,4,5,6]   == [1..6]
    && union  [1,3,5]   [2,4,6]     == [1..6]
    && union  [2,4,6,8] [3,6,9]     == [2,3,4,6,8,9]
    && union  [1,2,2,2] [1,1,1,2,2] == [1,1,1,2,2,2]

prop_minus_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_minus_subset (Ordered xs) (Ordered ys)
    =  minus xs ys `subset` xs

prop_minus_examples
    =  minus  [1,2,3,4] [3,4,5,6]   == [1,2]
    && minus  [1,3,5]   [2,4,6]     == [1,3,5]
    && minus  [2,4,6,8] [3,6,9]     == [2,4,8]
    && minus  [1,2,2,2] [1,1,1,2,2] == [2]

prop_xunion_subset_union :: OrderedList Int -> OrderedList Int -> Bool
prop_xunion_subset_union (Ordered xs) (Ordered ys)
    =  xunion xs ys `subset` union xs ys

prop_merge_xunion_isect_union :: OrderedList Int -> OrderedList Int -> Bool
prop_merge_xunion_isect_union  (Ordered xs) (Ordered ys)
    = merge (xunion xs ys) (isect xs ys) == union xs ys

prop_merge_union_isect_merge :: OrderedList Int -> OrderedList Int -> Bool
prop_merge_union_isect_merge  (Ordered xs) (Ordered ys)
    = merge (union xs ys) (isect xs ys) == merge xs ys

prop_minus_merge_isect_union :: OrderedList Int -> OrderedList Int -> Bool
prop_minus_merge_isect_union (Ordered xs) (Ordered ys)
    = minus (merge xs ys) (isect xs ys) == union xs ys

prop_minus_union_isect_xunion :: OrderedList Int -> OrderedList Int -> Bool
prop_minus_union_isect_xunion (Ordered xs) (Ordered ys)
    = minus (union xs ys) (isect xs ys) == xunion xs ys

prop_xunion_examples
    =  xunion [1,2,3,4] [3,4,5,6]   == [1,2,5,6]
    && xunion [1,3,5]   [2,4,6]     == [1..6]
    && xunion [2,4,6,8] [3,6,9]     == [2,3,4,8,9]
    && xunion [1,2,2,2] [1,1,1,2,2] == [1,1,2]

prop_merge_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_merge_subset (Ordered xs) (Ordered ys)
    =  union xs ys `subset` merge xs ys

prop_merge_examples
    =  merge [1,2,3,4] [3,4,5,6]   == [1,2,3,3,4,4,5,6]
    && merge [1,3,5]   [2,4,6]     == [1,2,3,4,5,6]
    && merge [2,4,6,8] [3,6,9]     == [2,3,4,6,6,8,9]
    && merge [1,2,2,2] [1,1,1,2,2] == [1,1,1,1,2,2,2,2,2]

prop_nub_examples
    =  nub [1,1,1,2,2] == [1,2]
    && nub [2,0,1,3,3] == [2,3]

safeHead []    = Nothing
safeHead (a:_) = Just a

newtype HeadOrderedLists x = HeadOrdered [[x]] deriving (Eq, Ord, Show, Read)

instance (Ord a, Arbitrary a) => Arbitrary (HeadOrderedLists a) where
   arbitrary =  (HeadOrdered . sortOn' safeHead . map sort) `fmap` arbitrary
   shrink _ = []

prop_mergeAll :: HeadOrderedLists Int -> Bool
prop_mergeAll (HeadOrdered xss)
    = foldr merge [] xss == mergeAll xss

prop_unionAll :: HeadOrderedLists Int -> Bool
prop_unionAll (HeadOrdered xss)
    = foldr union [] xss == unionAll xss

broken_unionAll :: HeadOrderedLists Int -> Bool
broken_unionAll (HeadOrdered xss)
    = foldr union [] xss == foldr union' [] xss
  where
      union' []     ys = ys
      union' (x:xs) ys = x : union xs ys

prop_broken_unionAll = expectFailure broken_unionAll

main = do
   putStr "prop_member: " >> quickCheck prop_member
   putStr "prop_insertBag_sort: " >> quickCheck prop_insertBag_sort
   putStr "prop_insertSet_nubSort: " >> quickCheck prop_insertSet_nubSort
   putStr "prop_nub: " >> quickCheck prop_nub
   putStr "prop_nub_isSorted: " >> quickCheck prop_nub_isSorted
   putStr "prop_nubSort_isSorted: " >> quickCheck prop_nubSort_isSorted
   putStr "prop_isect_subset: " >> quickCheck prop_isect_subset
   putStr "prop_isect_examples: " >> quickCheck prop_isect_examples
   putStr "prop_union_subset: " >> quickCheck prop_union_subset
   putStr "prop_isect_subset_union: " >> quickCheck prop_isect_subset_union
   putStr "prop_union_examples: " >> quickCheck prop_union_examples
   putStr "prop_minus_subset: " >> quickCheck prop_minus_subset
   putStr "prop_minus_examples: " >> quickCheck prop_minus_examples
   putStr "prop_xunion_subset_union: " >> quickCheck prop_xunion_subset_union
   putStr "prop_merge_xunion_isect_union: " >> quickCheck prop_merge_xunion_isect_union
   putStr "prop_merge_union_isect_merge: " >> quickCheck prop_merge_union_isect_merge
   putStr "prop_minus_merge_isect_union: " >> quickCheck prop_minus_merge_isect_union
   putStr "prop_minus_union_isect_xunion: " >> quickCheck prop_minus_union_isect_xunion
   putStr "prop_xunion_examples: " >> quickCheck prop_xunion_examples
   putStr "prop_merge_subset: " >> quickCheck prop_merge_subset
   putStr "prop_merge_examples: " >> quickCheck prop_merge_examples
   putStr "prop_nub_examples: " >> quickCheck prop_nub_examples
   putStr "prop_mergeAll: " >> quickCheck prop_mergeAll
   putStr "prop_unionAll: " >> quickCheck prop_unionAll
   putStr "prop_broken_unionAll: " >> quickCheck prop_broken_unionAll