For Map, test against fromList-like

Author: meooow25

containers-tests/tests/map-properties.hs

@@ -1278,76 +1278,54 @@ instance Arbitrary WhenMatchedSpec where
 
 ----------------------------------------------------------------
 
--- fromAscListWith, fromAscListWithKey, fromDescListWith, fromDescListWithKey
--- all effectively perform a left fold over adjacent elements in the input list
--- using some function as long as the keys are equal.
---
--- The property tests for these functions compare the result against the
--- sequence we would get if we used NE.groupBy instead. We use Magma to check
--- the fold direction (left, not right) and the order of arguments to the fold
--- function (new then old).
-
 data Magma a
   = Inj a
   | Magma a :* Magma a
   deriving (Eq, Show)
 
-groupByK :: Eq k => [(k, a)] -> [(k, NonEmpty a)]
-groupByK =
-    List.map (\ys -> (fst (NE.head ys), NE.map snd ys)) .
-    NE.groupBy ((==) `on` fst)
-
 prop_list :: [Int] -> Bool
 prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
 
 prop_descList :: [Int] -> Bool
 prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
 
--- For a list with keys in decreasing order (downSortedKxs), the sequence we get from fromDescList
--- should be the same as the reverse of the sequence we get if we group by the key and take the last
--- key-value pair in each group.
 prop_fromDescList :: [(Int, A)] -> Property
 prop_fromDescList kxs =
     valid t .&&.
-    toList t === reverse nubLastDownSortedXs
+    t === fromList kxs
   where
     downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
-    nubLastDownSortedXs = [(k, NE.last xs) | (k,xs) <- groupByK downSortedKxs]
     t = fromDescList downSortedKxs
 
--- For a list with keys in decreasing order (downSortedKxs), the sequence we get from
--- fromDescListWith f should be the same as the reverse of the sequence we get if we group by the
--- key and fold all the values for a key with f. fromDescListWith applies f as `f newv oldv`.
 prop_fromDescListWith :: [(Int, A)] -> Property
 prop_fromDescListWith kys =
     valid t .&&.
-    toList t === reverse foldedDownSortedXs
+    t === fromListWith (:*) downSortedKxs
   where
     kxs = [(k, Inj y) | (k,y) <- kys]
     downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
-    foldedDownSortedXs = [(k, Foldable.foldl1 (flip (:*)) xs) | (k,xs) <- groupByK downSortedKxs]
     t = fromDescListWith (:*) downSortedKxs
 
--- For a list with keys in decreasing order (downSortedKxs), the sequence we get from
--- fromDescListWithKey f should be the same as the reverse of the sequence we get if we group by the
--- key and fold all the values for a key with f. fromDescListWith applies f as `f key newv oldv`.
 prop_fromDescListWithKey :: [(Int, A)] -> Property
 prop_fromDescListWithKey kys =
     valid t .&&.
-    toList t === reverse foldedDownSortedXs
+    t === fromListWithKey f downSortedKxs
   where
     kxs = [(k, Inj (Left y)) | (k,y) <- kys]
     downSortedKxs = List.sortBy (comparing (Down . fst)) kxs
-    foldedDownSortedXs = [ (k, Foldable.foldl1 (\acc (Inj (Left x)) -> Inj (Right (k,x)) :* acc) xs)
-                         | (k,xs) <- groupByK downSortedKxs ]
-    t = fromDescListWithKey (\k (Inj (Left x)) acc -> Inj (Right (k,x)) :* acc) downSortedKxs
+    f k (Inj (Left x)) acc = Inj (Right (k,x)) :* acc
+    f _ _ _ = error "prop_fromDescListWithKey"
+    t = fromDescListWithKey f downSortedKxs
 
 prop_fromDistinctDescList :: [(Int, A)] -> Property
 prop_fromDistinctDescList kxs =
     valid t .&&.
     toList t === reverse nubDownSortedKxs
   where
-    nubDownSortedKxs = [(k, NE.head xs) | (k,xs) <- groupByK (List.sortBy (comparing (Down . fst)) kxs)]
+    nubDownSortedKxs =
+      List.map NE.head $
+      NE.groupBy ((==) `on` fst) $
+      List.sortBy (comparing (Down . fst)) kxs
     t = fromDistinctDescList nubDownSortedKxs
 
 prop_ascDescList :: [Int] -> Bool
@@ -1361,51 +1339,43 @@ prop_fromList xs
            t == List.foldr (uncurry insert) empty (zip xs xs)
   where sort_xs = sort xs
 
--- For a list with keys in increasing order (sortedKxs), the sequence we get from fromAscList
--- should be the same as the sequence we get if we group by the key and take the last key-value pair
--- in each group.
 prop_fromAscList :: [(Int, A)] -> Property
 prop_fromAscList kxs =
     valid t .&&.
-    toList t === nubLastSortedXs
+    t === fromList sortedKxs
   where
     sortedKxs = List.sortBy (comparing fst) kxs
-    nubLastSortedXs = [(k, NE.last xs) | (k,xs) <- groupByK sortedKxs]
     t = fromAscList sortedKxs
 
--- For a list with keys in increasing order (sortedKxs), the sequence we get from fromAscListWith f
--- should be the same as the the sequence we get if we group by the key and fold all the values for
--- a key with f. fromAscListWith applies f as `f newv oldv`.
 prop_fromAscListWith :: [(Int, A)] -> Property
 prop_fromAscListWith kys =
     valid t .&&.
-    toList t === foldedSortedKxs
+    t === fromListWith (:*) sortedKxs
   where
     kxs = [(k, Inj y) | (k,y) <- kys]
     sortedKxs = List.sortBy (comparing fst) kxs
-    foldedSortedKxs = [(k, Foldable.foldl1 (flip (:*)) x) | (k,x) <- groupByK sortedKxs]
     t = fromAscListWith (:*) sortedKxs
 
--- For a list with keys in increasing order (sortedKxs), the sequence we get from
--- fromAscListWithKey f should be the same as the the sequence we get if we group by the key and
--- fold all the values for a key with f. fromAscListWithKey applies f as `f key newv oldv`.
 prop_fromAscListWithKey :: [(Int, A)] -> Property
 prop_fromAscListWithKey kys =
     valid t .&&.
-    toList t === foldedSortedKxs
+    t === fromListWithKey f sortedKxs
   where
     kxs = [(k, Inj (Left y)) | (k,y) <- kys]
     sortedKxs = List.sortBy (comparing fst) kxs
-    foldedSortedKxs = [ (k, Foldable.foldl1 (\acc (Inj (Left x)) -> Inj (Right (k,x)) :* acc) xs)
-                      | (k,xs) <- groupByK sortedKxs ]
-    t = fromAscListWithKey (\k (Inj (Left x)) acc -> Inj (Right (k,x)) :* acc) sortedKxs
+    f k (Inj (Left x)) acc = Inj (Right (k,x)) :* acc
+    f _ _ _ = error "prop_fromAscListWithKey"
+    t = fromAscListWithKey f sortedKxs
 
 prop_fromDistinctAscList :: [(Int, A)] -> Property
 prop_fromDistinctAscList kxs =
     valid t .&&.
     toList t === nubSortedKxs
   where
-    nubSortedKxs = [(k, NE.head xs) | (k,xs) <- groupByK (List.sortBy (comparing fst) kxs)]
+    nubSortedKxs =
+      List.map NE.head $
+      NE.groupBy ((==) `on` fst) $
+      List.sortBy (comparing fst) kxs
     t = fromDistinctAscList nubSortedKxs
 
 ----------------------------------------------------------------