[ADP-3272] Add shrinker function shrinkMapToSubmaps. (#4575)

This PR adds a shrinker function `shrinkMapToSubmaps` to
`Test.QuickCheck.Extra`:

```hs
-- | Shrinks a 'Map' to list of proper submaps.
--
-- Satisfies the following property:
--
-- @
-- all (`Map.isProperSubmapOf` m) (shrinkMapToSubmaps m)
-- @
--
shrinkMapToSubmaps :: Ord k => Map k v -> [Map k v]
```

### Issue

ADP-3272

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

@@ -54,6 +54,7 @@ module Test.QuickCheck.Extra
       -- * Generating and shrinking maps
     , genMapWith
     , genMapFromKeysWith
+    , shrinkMapToSubmaps
     , shrinkMapWith
     , shrinkMapValuesWith
 
@@ -610,6 +611,21 @@ genMapFromKeysWith :: Ord k => Gen v -> Set k -> Gen (Map k v)
 genMapFromKeysWith genValue =
     fmap Map.fromList . mapM (\k -> (k,) <$> genValue) . Set.toList
 
+-- | Shrinks a 'Map' to list of proper submaps.
+--
+-- Satisfies the following property:
+--
+-- @
+-- all (`Map.isProperSubmapOf` m) (shrinkMapToSubmaps m)
+-- @
+--
+shrinkMapToSubmaps :: Ord k => Map k v -> [Map k v]
+shrinkMapToSubmaps =
+    shrinkMapBy Map.fromList Map.toList shrinkListToSublist
+  where
+    shrinkListToSublist :: [a] -> [[a]]
+    shrinkListToSublist = shrinkList (const [])
+
 -- | Shrinks a 'Map' with the given key and value shrinking functions.
 --
 shrinkMapWith

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

@@ -100,6 +100,7 @@ import Test.QuickCheck.Extra
     , selectMapEntries
     , selectMapEntry
     , shrinkDisjointPair
+    , shrinkMapToSubmaps
     , shrinkSpace
     , shrinkWhile
     , shrinkWhileSteps
@@ -190,6 +191,17 @@ spec = describe "Test.QuickCheck.ExtraSpec" $ do
                 prop_selectMapEntries_union
                     @Int @Int & property
 
+    describe "Generating and shrinking associative maps" $ do
+
+        describe "Shrinking" $ do
+
+            it "prop_shrinkMapToSubmaps_all_isProperSubmapOf" $
+                prop_shrinkMapToSubmaps_all_isProperSubmapOf
+                    @Int @Int & property
+            it "prop_shrinkMapToSubmaps_unique" $
+                prop_shrinkMapToSubmaps_unique
+                    @Int @Int & property
+
     describe "Evaluating shrinkers" $ do
 
         describe "Generating sequences of shrunken values" $ do
@@ -698,6 +710,36 @@ prop_selectMapEntries_union m0 (Positive (Small i)) =
             "number of selected entries = 0" $
         Map.fromList kvs `Map.union` m1 === m0
 
+--------------------------------------------------------------------------------
+-- Shrinking associative maps
+--------------------------------------------------------------------------------
+
+prop_shrinkMapToSubmaps_all_isProperSubmapOf
+    :: (Ord k, Eq v)
+    => Map k v
+    -> Property
+prop_shrinkMapToSubmaps_all_isProperSubmapOf m =
+    all (`Map.isProperSubmapOf` m) (shrinkMapToSubmaps m)
+        ===
+        True
+    & cover 10
+        (length (shrinkMapToSubmaps m) >= 10)
+        "length (shrinkMapToSubmaps m) >= 10"
+    & checkCoverage
+
+prop_shrinkMapToSubmaps_unique
+    :: (Ord k, Ord v)
+    => Map k v
+    -> Property
+prop_shrinkMapToSubmaps_unique m =
+    length (shrinkMapToSubmaps m)
+        ===
+        length (Set.fromList (shrinkMapToSubmaps m))
+    & cover 10
+        (length (shrinkMapToSubmaps m) >= 10)
+        "length (shrinkMapToSubmaps m) >= 10"
+    & checkCoverage
+
 --------------------------------------------------------------------------------
 -- Generating sequences of shrunken values
 --------------------------------------------------------------------------------