[ADP-3272] Add generator functions genNonEmptyDisjoint{Set,Map}. (#…

…4580)

This PR adds the following generators to `Test.QuickCheck.Extra`:

```hs
genNonEmptyDisjointSet :: Ord a =>          Gen a -> Set   a -> Gen (Set   a)
genNonEmptyDisjointMap :: Ord k => Gen k -> Gen v -> Map k v -> Gen (Map k v)
```

These functions are useful in situations where you have a pre-existing
`Set` (or `Map`), and you want to generate another `Set` (or `Map`) that
is guaranteed to be non-empty and disjoint to the original.

## Issue

ADP-3272

lib/test-utils/src/Test/QuickCheck/Extra.hs

@@ -51,9 +51,13 @@ module Test.QuickCheck.Extra
       -- * Partitioning lists
     , partitionList
 
+      -- * Generating and shrinking sets
+    , genNonEmptyDisjointSet
+
       -- * Generating and shrinking maps
     , genMapWith
     , genMapFromKeysWith
+    , genNonEmptyDisjointMap
     , shrinkMapToSubmaps
     , shrinkMapWith
     , shrinkMapValuesWith
@@ -105,6 +109,7 @@ import Prelude
 import Control.Monad
     ( foldM
     , liftM2
+    , replicateM
     )
 import Data.IntCast
     ( intCast
@@ -144,6 +149,7 @@ import Numeric.Natural
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
+    , Positive (getPositive)
     , Property
     , Testable
     , chooseInt
@@ -595,6 +601,24 @@ shrinkNonEmpty shrinkA = mapMaybe NE.nonEmpty . shrinkList shrinkA . NE.toList
 genFunction :: (a -> Gen b -> Gen b) -> Gen b -> Gen (a -> b)
 genFunction coarbitraryFn gen = promote (`coarbitraryFn` gen)
 
+--------------------------------------------------------------------------------
+-- Generating and shrinking sets
+--------------------------------------------------------------------------------
+
+-- | Generates a non-empty 'Set' that is disjoint to an existing 'Set'.
+--
+-- The size of the resultant set depends on the implicit size parameter.
+--
+-- Caution: if the given generator is incapable of generating values that are
+-- outside the existing set, then this function will not terminate.
+--
+genNonEmptyDisjointSet :: Ord a => Gen a -> Set a -> Gen (Set a)
+genNonEmptyDisjointSet genElement0 existingElements = do
+    size <- getPositive <$> arbitrary @(Positive Int)
+    Set.fromList <$> replicateM size genElement
+  where
+    genElement = genElement0 `suchThat` (`Set.notMember` existingElements)
+
 --------------------------------------------------------------------------------
 -- Generating and shrinking key-value maps
 --------------------------------------------------------------------------------
@@ -611,6 +635,18 @@ genMapFromKeysWith :: Ord k => Gen v -> Set k -> Gen (Map k v)
 genMapFromKeysWith genValue =
     fmap Map.fromList . mapM (\k -> (k,) <$> genValue) . Set.toList
 
+-- | Generates a non-empty 'Map' that is disjoint to an existing 'Map'.
+--
+-- The size of the resultant map depends on the implicit size parameter.
+--
+-- Caution: if the given key generator is incapable of generating keys that are
+-- outside the existing map's domain, then this function will not terminate.
+--
+genNonEmptyDisjointMap :: Ord k => Gen k -> Gen v -> Map k v -> Gen (Map k v)
+genNonEmptyDisjointMap genKey genValue existingMap =
+    genMapFromKeysWith genValue =<<
+    genNonEmptyDisjointSet genKey (Map.keysSet existingMap)
+
 -- | Shrinks a 'Map' to list of proper submaps.
 --
 -- Satisfies the following property:

lib/test-utils/test/Test/QuickCheck/ExtraSpec.hs

@@ -87,10 +87,13 @@ import Test.QuickCheck
     , scale
     , shrinkIntegral
     , within
+    , (=/=)
     , (===)
     )
 import Test.QuickCheck.Extra
     ( Pretty (..)
+    , genNonEmptyDisjointMap
+    , genNonEmptyDisjointSet
     , genShrinkSequence
     , genericRoundRobinShrink
     , getDisjointPair
@@ -191,8 +194,28 @@ spec = describe "Test.QuickCheck.ExtraSpec" $ do
                 prop_selectMapEntries_union
                     @Int @Int & property
 
+    describe "Generating and shrinking sets" $ do
+
+        describe "Generation" $ do
+
+            it "prop_genNonEmptyDisjointSet_disjoint" $
+                prop_genNonEmptyDisjointSet_disjoint
+                    @Int & property
+            it "prop_genNonEmptyDisjointSet_nonEmpty" $
+                prop_genNonEmptyDisjointSet_nonEmpty
+                    @Int & property
+
     describe "Generating and shrinking associative maps" $ do
 
+        describe "Generation" $ do
+
+            it "prop_genNonEmptyDisjointMap_disjoint" $
+                prop_genNonEmptyDisjointMap_disjoint
+                    @Int @Int & property
+            it "prop_genNonEmptyDisjointMap_nonEmpty" $
+                prop_genNonEmptyDisjointMap_nonEmpty
+                    @Int @Int & property
+
         describe "Shrinking" $ do
 
             it "prop_shrinkMapToSubmaps_all_isProperSubmapOf" $
@@ -575,6 +598,64 @@ prop_partitionList_LT (PartitionListData (x, y) as) =
     x' = max 0 x
     y' = max 1 (max y x')
 
+--------------------------------------------------------------------------------
+-- Generating sets
+--------------------------------------------------------------------------------
+
+prop_genNonEmptyDisjointSet_disjoint
+    :: (Arbitrary a, Ord a, Show a)
+    => Set a
+    -> Property
+prop_genNonEmptyDisjointSet_disjoint set1 =
+    forAll (genNonEmptyDisjointSet arbitrary set1) $ \set2 ->
+        Set.intersection set1 set2 === Set.empty
+        & cover 10
+            (Set.size set1 >= 10 && Set.size set2 >= 10)
+            "Set.size set1 >= 10 && Set.size set2 >= 10"
+        & checkCoverage
+
+prop_genNonEmptyDisjointSet_nonEmpty
+    :: (Arbitrary a, Ord a, Show a)
+    => Set a
+    -> Property
+prop_genNonEmptyDisjointSet_nonEmpty set1 =
+    forAll (genNonEmptyDisjointSet arbitrary set1) $ \set2 ->
+        Set.size set2 =/= 0
+        & cover 10
+            (Set.size set1 >= 10 && Set.size set2 >= 10)
+            "Set.size set1 >= 10 && Set.size set2 >= 10"
+        & checkCoverage
+
+--------------------------------------------------------------------------------
+-- Generating maps
+--------------------------------------------------------------------------------
+
+prop_genNonEmptyDisjointMap_disjoint
+    :: (Arbitrary k, Show k, Ord k)
+    => (Arbitrary v, Show v, Eq v)
+    => Map k v
+    -> Property
+prop_genNonEmptyDisjointMap_disjoint map1 =
+    forAll (genNonEmptyDisjointMap arbitrary arbitrary map1) $ \map2 ->
+        Map.intersectionWith (,) map1 map2 === Map.empty
+        & cover 10
+            (Map.size map1 >= 10 && Map.size map2 >= 10)
+            "Map.size map1 >= 10 && Map.size map2 >= 10"
+        & checkCoverage
+
+prop_genNonEmptyDisjointMap_nonEmpty
+    :: (Arbitrary k, Show k, Ord k)
+    => (Arbitrary v, Show v, Eq v)
+    => Map k v
+    -> Property
+prop_genNonEmptyDisjointMap_nonEmpty map1 =
+    forAll (genNonEmptyDisjointMap arbitrary arbitrary map1) $ \map2 ->
+        Map.size map2 =/= 0
+        & cover 10
+            (Map.size map1 >= 10 && Map.size map2 >= 10)
+            "Map.size map1 >= 10 && Map.size map2 >= 10"
+        & checkCoverage
+
 --------------------------------------------------------------------------------
 -- Selecting map entries (one at a time)
 --------------------------------------------------------------------------------