Add tests for new Set functions
authorDavid Feuer <David.Feuer@gmail.com>
Fri, 5 Jan 2018 06:33:11 +0000 (01:33 -0500)
committerDavid Feuer <David.Feuer@gmail.com>
Sun, 7 Jan 2018 08:33:22 +0000 (03:33 -0500)
Add QuickCheck properties for `cartesianProduct` and
`disjointUnion`.

tests/set-properties.hs

index 8b08a2a..46ae416 100644 (file)
@@ -21,6 +21,7 @@ import Data.Foldable (all)
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative (Applicative (..), (<$>))
 #endif
+import Control.Applicative (liftA2)
 
 main :: IO ()
 main = defaultMain [ testCase "lookupLT" test_lookupLT
@@ -94,6 +95,8 @@ main = defaultMain [ testCase "lookupLT" test_lookupLT
                    , testProperty "drop"                 prop_drop
                    , testProperty "splitAt"              prop_splitAt
                    , testProperty "powerSet"             prop_powerSet
+                   , testProperty "cartesianProduct"     prop_cartesianProduct
+                   , testProperty "disjointUnion"        prop_disjointUnion
                    ]
 
 -- A type with a peculiar Eq instance designed to make sure keys
@@ -615,6 +618,16 @@ prop_powerSet xs = valid ps .&&. ps === ps'
     lps [] = [[]]
     lps (y : ys) = fmap (y:) (lps ys) ++ lps ys
 
+prop_cartesianProduct :: Set Int -> Set Int -> Property
+prop_cartesianProduct xs ys =
+  valid cp .&&. toList cp === liftA2 (,) (toList xs) (toList ys)
+  where cp = cartesianProduct xs ys
+
+prop_disjointUnion :: Set Int -> Set Int -> Property
+prop_disjointUnion xs ys =
+  valid du .&&. du === union (mapMonotonic Left xs) (mapMonotonic Right ys)
+  where du = disjointUnion xs ys
+
 isLeft :: Either a b -> Bool
 isLeft (Left _) = True
 isLeft _ = False