Use newtypes for Arbitrary sorted lists

containers-tests/containers-tests.cabal

@@ -329,7 +329,7 @@ library test-utils
     IntSetValidity
     Utils.ArbitrarySetMap
     Utils.MergeFunc
-    Utils.NubSorted
+    Utils.QuickCheck
     Utils.QuickCheckClasses
     Utils.Strictness
 

containers-tests/test-utils/Utils/NubSorted.hs → containers-tests/test-utils/Utils/QuickCheck.hs

@@ -1,12 +1,20 @@
-module Utils.NubSorted
+{-# LANGUAGE CPP #-}
+
+-- | Useful newtypes with Arbitrary instances.
+module Utils.QuickCheck
   ( NubSorted(..)
   , NubSortedOnFst(..)
+  , SortedOnFst(..)
   ) where
 
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Ord (comparing)
 import Test.QuickCheck
+#if !MIN_VERSION_QuickCheck(2,17,0)
+import Data.Coerce (coerce)
+import Data.Ord (Down(..))
+#endif
 
 newtype NubSorted a = NubSorted { getNubSorted :: [a] }
   deriving Show
@@ -31,3 +39,17 @@ nubSortBy cmp =
   map NonEmpty.head .
   NonEmpty.groupBy (\x y -> cmp x y == EQ) .
   List.sortBy cmp
+
+newtype SortedOnFst a b = SortedOnFst { getSortedOnFst :: [(a, b)] }
+  deriving Show
+
+instance (Ord a, Arbitrary a, Arbitrary b) => Arbitrary (SortedOnFst a b) where
+  arbitrary = SortedOnFst . List.sortBy (comparing fst) <$> arbitrary
+  shrink =
+    map (SortedOnFst . List.sortBy (comparing fst)) . shrink . getSortedOnFst
+
+#if !MIN_VERSION_QuickCheck(2,17,0)
+instance Arbitrary a => Arbitrary (Down a) where
+  arbitrary = Down <$> arbitrary
+  shrink (Down x) = coerce (shrink x)
+#endif

containers-tests/tests/intmap-properties.hs

@@ -18,6 +18,7 @@ import Control.Applicative (Applicative(..))
 import Control.Arrow ((&&&))
 import Control.Monad ((<=<))
 import Control.Monad.Trans.Writer.Lazy
+import Data.Coerce (coerce)
 import qualified Data.Either as Either
 import qualified Data.Foldable as Foldable
 import Data.Monoid
@@ -44,6 +45,7 @@ import Test.QuickCheck.Function (apply)
 import Test.QuickCheck.Poly (A, B, C, OrdA)
 import qualified Test.QuickCheck.Classes.Base as Laws
 
+import Utils.QuickCheck (NubSortedOnFst(..), SortedOnFst(..))
 import Utils.QuickCheckClasses (testLaws)
 
 default (Int)
@@ -2151,64 +2153,58 @@ prop_mapKeysMonotonic (Positive a) b m =
 prop_compare :: IntMap OrdA -> IntMap OrdA -> Property
 prop_compare m1 m2 = compare m1 m2 === compare (toList m1) (toList m2)
 
-prop_fromAscList :: [(Int, A)] -> Property
-prop_fromAscList kxs =
+prop_fromAscList :: SortedOnFst Int A -> Property
+prop_fromAscList (SortedOnFst kxs) =
   valid t .&&.
-  t === fromList sortedKxs
+  t === fromList kxs
   where
-    sortedKxs = List.sortBy (comparing fst) kxs
-    t = fromAscList sortedKxs
+    t = fromAscList kxs
 
-prop_fromAscListWith :: Fun (A, A) A -> [(Int, A)] -> Property
-prop_fromAscListWith f kxs =
+prop_fromAscListWith :: Fun (A, A) A -> SortedOnFst Int A -> Property
+prop_fromAscListWith f (SortedOnFst kxs) =
   valid t .&&.
-  t === fromListWith (applyFun2 f) sortedKxs
+  t === fromListWith (applyFun2 f) kxs
   where
-    sortedKxs = List.sortBy (comparing fst) kxs
-    t = fromAscListWith (applyFun2 f) sortedKxs
+    t = fromAscListWith (applyFun2 f) kxs
 
-prop_fromAscListWithKey :: Fun (Int, A, A) A -> [(Int, A)] -> Property
-prop_fromAscListWithKey f kxs =
+prop_fromAscListWithKey :: Fun (Int, A, A) A -> SortedOnFst Int A -> Property
+prop_fromAscListWithKey f (SortedOnFst kxs) =
   valid t .&&.
-  t === fromListWithKey (applyFun3 f) sortedKxs
+  t === fromListWithKey (applyFun3 f) kxs
   where
-    sortedKxs = List.sortBy (comparing fst) kxs
-    t = fromAscListWithKey (applyFun3 f) sortedKxs
+    t = fromAscListWithKey (applyFun3 f) kxs
 
-prop_fromAscListUpsert :: Fun (A, Maybe B) B -> [(Int, A)] -> Property
-prop_fromAscListUpsert f kxs =
+prop_fromAscListUpsert :: Fun (A, Maybe B) B -> SortedOnFst Int A -> Property
+prop_fromAscListUpsert f (SortedOnFst kxs) =
   valid t .&&.
-  t === fromListUpsert (applyFun2 f) sortedKxs
+  t === fromListUpsert (applyFun2 f) kxs
   where
-    sortedKxs = List.sortBy (comparing fst) kxs
-    t = fromAscListUpsert (applyFun2 f) sortedKxs
+    t = fromAscListUpsert (applyFun2 f) kxs
 
-prop_fromDistinctAscList :: [(Int, A)] -> Property
-prop_fromDistinctAscList kxs =
+prop_fromDistinctAscList :: NubSortedOnFst Int A -> Property
+prop_fromDistinctAscList (NubSortedOnFst kxs) =
   valid t .&&.
-  toList t === nubSortedKxs
+  t === fromList kxs .&&.
+  toList t === kxs
   where
-    nubSortedKxs =
-      List.map NE.head $
-      NE.groupBy ((==) `on` fst) $
-      List.sortBy (comparing fst) kxs
-    t = fromDistinctAscList nubSortedKxs
+    t = fromDistinctAscList kxs
 
-prop_fromDescList :: [(Int, A)] -> Property
-prop_fromDescList kxs =
+prop_fromDescList :: SortedOnFst (Down Int) A -> Property
+prop_fromDescList kxs' =
   valid t .&&.
-  t === fromList sortedKxs
+  t === fromList kxs
   where
-    sortedKxs = List.sortBy (comparing (Down . fst)) kxs
-    t = fromDescList sortedKxs
+    kxs = coerce kxs' :: [(Int, A)]
+    t = fromDescList kxs
 
-prop_fromDescListUpsert :: Fun (A, Maybe B) B -> [(Int, A)] -> Property
-prop_fromDescListUpsert f kxs =
+prop_fromDescListUpsert
+  :: Fun (A, Maybe B) B -> SortedOnFst (Down Int) A -> Property
+prop_fromDescListUpsert f kxs' =
   valid t .&&.
-  t === fromListUpsert (applyFun2 f) sortedKxs
+  t === fromListUpsert (applyFun2 f) kxs
   where
-    sortedKxs = List.sortBy (comparing (Down . fst)) kxs
-    t = fromDescListUpsert (applyFun2 f) sortedKxs
+    kxs = coerce kxs' :: [(Int, A)]
+    t = fromDescListUpsert (applyFun2 f) kxs
 
 prop_fromListWith :: Fun (A, A) A -> [(Int, A)] -> Property
 prop_fromListWith f kxs =

containers-tests/tests/intmap-strictness.hs

@@ -12,9 +12,8 @@ import Data.Function (on)
 import Data.Functor.Compose
 import Data.Functor.Identity (Identity(..))
 import qualified Data.List as List
-import qualified Data.List.NonEmpty as NE
 import Data.Maybe (catMaybes, mapMaybe)
-import Data.Ord (Down(..), comparing)
+import Data.Ord (Down(..))
 import Test.ChasingBottoms.IsBottom
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import Test.Tasty.QuickCheck (testProperty)
@@ -39,7 +38,7 @@ import qualified Data.IntMap.Merge.Lazy as LMerge
 import Data.Containers.ListUtils
 
 import Utils.MergeFunc (WhenMatchedFunc(..), WhenMissingFunc(..))
-import Utils.NubSorted (NubSortedOnFst(..))
+import Utils.QuickCheck (NubSortedOnFst(..), SortedOnFst(..))
 import Utils.Strictness
   (Bot(..), Func, Func2, Func3, applyFunc, applyFunc2, applyFunc3)
 
@@ -162,100 +161,102 @@ prop_lazyFromListUpsert fun kvs = isNotBottomProp (L.fromListUpsert f kvs')
     f = coerce (applyFunc2 fun) :: A -> Maybe B -> B
     kvs' = coerce kvs :: [(Key, A)]
 
-prop_strictFromAscList :: [(Key, Bot A)] -> Property
+prop_strictFromAscList :: SortedOnFst Key (Bot A) -> Property
 prop_strictFromAscList kvs =
   isBottom (M.fromAscList kvs') === isBottom (M.fromList kvs')
   where
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_lazyFromAscList :: [(Key, Bot A)] -> Property
+prop_lazyFromAscList :: SortedOnFst Key (Bot A) -> Property
 prop_lazyFromAscList kvs = isNotBottomProp (L.fromAscList kvs')
   where
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_strictFromAscListWith :: Func2 A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_strictFromAscListWith
+  :: Func2 A A (Bot A) -> SortedOnFst Key (Bot A) -> Property
 prop_strictFromAscListWith fun kvs =
   isBottom (M.fromAscListWith f kvs') === isBottom (M.fromListWith f kvs')
   where
     f = coerce (applyFunc2 fun)
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_lazyFromAscListWith :: Func2 A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_lazyFromAscListWith
+  :: Func2 A A (Bot A) -> SortedOnFst Key (Bot A) -> Property
 prop_lazyFromAscListWith fun kvs = isNotBottomProp (L.fromAscListWith f kvs')
   where
     f = coerce (applyFunc2 fun)
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_strictFromAscListWithKey
-  :: Func3 Key A A (Bot A) -> [(Key, Bot A)] -> Property
+  :: Func3 Key A A (Bot A) -> SortedOnFst Key (Bot A) -> Property
 prop_strictFromAscListWithKey fun kvs =
   isBottom (M.fromAscListWithKey f kvs') ===
   isBottom (M.fromListWithKey f kvs')
   where
     f = coerce (applyFunc3 fun)
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_lazyFromAscListWithKey
-  :: Func3 Key A A (Bot A) -> [(Key, Bot A)] -> Property
+  :: Func3 Key A A (Bot A) -> SortedOnFst Key (Bot A) -> Property
 prop_lazyFromAscListWithKey fun kvs =
   isNotBottomProp (L.fromAscListWithKey f kvs')
   where
     f = coerce (applyFunc3 fun)
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_strictFromAscListUpsert
-  :: Func2 A (Maybe B) (Bot B) -> [(Key, Bot A)] -> Property
+  :: Func2 A (Maybe B) (Bot B) -> SortedOnFst Key (Bot A) -> Property
 prop_strictFromAscListUpsert fun kvs =
   isBottom (M.fromAscListUpsert f kvs') === isBottom (M.fromListUpsert f kvs')
   where
     f = coerce (applyFunc2 fun) :: A -> Maybe B -> B
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_lazyFromAscListUpsert
-  :: Func2 A (Maybe B) (Bot B) -> [(Key, Bot A)] -> Property
+  :: Func2 A (Maybe B) (Bot B) -> SortedOnFst Key (Bot A) -> Property
 prop_lazyFromAscListUpsert fun kvs =
   isNotBottomProp (L.fromAscListUpsert f kvs')
   where
     f = coerce (applyFunc2 fun) :: A -> Maybe B -> B
-    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_strictFromDistinctAscList :: [(Key, Bot A)] -> Property
+prop_strictFromDistinctAscList :: NubSortedOnFst Key (Bot A) -> Property
 prop_strictFromDistinctAscList kvs =
   isBottom (M.fromDistinctAscList kvs') === isBottom (M.fromList kvs')
   where
-    kvs' = uniqOn fst $ List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_lazyFromDistinctAscList :: [(Key, Bot A)] -> Property
+prop_lazyFromDistinctAscList :: NubSortedOnFst Key (Bot A) -> Property
 prop_lazyFromDistinctAscList kvs = isNotBottomProp (L.fromDistinctAscList kvs')
   where
-    kvs' = uniqOn fst $ List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_strictFromDescList :: [(Key, Bot A)] -> Property
+prop_strictFromDescList :: SortedOnFst (Down Key) (Bot A) -> Property
 prop_strictFromDescList kvs =
   isBottom (M.fromDescList kvs') === isBottom (M.fromList kvs')
   where
-    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
-prop_lazyFromDescList :: [(Key, Bot A)] -> Property
+prop_lazyFromDescList :: SortedOnFst (Down Key) (Bot A) -> Property
 prop_lazyFromDescList kvs = isNotBottomProp (L.fromDescList kvs')
   where
-    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_strictFromDescListUpsert
-  :: Func2 A (Maybe B) (Bot B) -> [(Key, Bot A)] -> Property
+  :: Func2 A (Maybe B) (Bot B) -> SortedOnFst (Down Key) (Bot A) -> Property
 prop_strictFromDescListUpsert fun kvs =
   isBottom (M.fromDescListUpsert f kvs') === isBottom (M.fromListUpsert f kvs')
   where
     f = coerce (applyFunc2 fun) :: A -> Maybe B -> B
-    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_lazyFromDescListUpsert
-  :: Func2 A (Maybe B) (Bot B) -> [(Key, Bot A)] -> Property
+  :: Func2 A (Maybe B) (Bot B) -> SortedOnFst (Down Key) (Bot A) -> Property
 prop_lazyFromDescListUpsert fun kvs =
   isNotBottomProp (L.fromDescListUpsert f kvs')
   where
     f = coerce (applyFunc2 fun) :: A -> Maybe B -> B
-    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(Key, A)]
+    kvs' = coerce kvs :: [(Key, A)]
 
 prop_strictInsert :: Key -> Bot A -> IntMap A -> Property
 prop_strictInsert k (Bot x) m = isBottom (M.insert k x m) === isBottom x
@@ -1186,10 +1187,6 @@ const2 x _ _ = x
 const3 :: a -> b -> c -> d -> a
 const3 x _ _ _ = x
 
--- | Keep the first of adjacent equal elements.
-uniqOn :: Eq b => (a -> b) -> [a] -> [a]
-uniqOn f = map NE.head . NE.groupBy ((==) `on` f)
-
 {--------------------------------------------------------------------
   Merge stuff
 --------------------------------------------------------------------}

containers-tests/tests/intset-properties.hs

@@ -1,13 +1,15 @@
 {-# LANGUAGE CPP #-}
 import Control.Applicative (Const(..))
 import Data.Bits ((.&.), popCount)
+import Data.Coerce (coerce)
 import Data.Word (Word)
 import Data.IntSet
 import Data.List (nub,sort)
 import qualified Data.List as List
 import Data.Maybe (listToMaybe)
 import qualified Data.Maybe as Maybe
 import Data.Monoid (mempty)
+import Data.Ord (Down(..))
 import Data.Proxy (Proxy(..))
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
@@ -20,6 +22,7 @@ import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck hiding ((.&.))
 import qualified Test.QuickCheck.Classes.Base as Laws
 
+import Utils.QuickCheck (NubSorted(..))
 import Utils.QuickCheckClasses (testLaws)
 
 main :: IO ()
@@ -567,31 +570,32 @@ prop_deleteMin s = toList (deleteMin s) === if null s then [] else tail (toList
 prop_deleteMax :: IntSet -> Property
 prop_deleteMax s = toList (deleteMax s) === if null s then [] else init (toList s)
 
-prop_fromAscList :: [Int] -> Property
-prop_fromAscList xs =
+prop_fromAscList :: SortedList Int -> Property
+prop_fromAscList (Sorted xs) =
     valid t .&&.
-    toList t === nubSortedXs
+    t === fromList xs .&&.
+    toList t === nubXs
   where
-    sortedXs = sort xs
-    nubSortedXs = List.map NE.head $ NE.group sortedXs
-    t = fromAscList sortedXs
+    nubXs = List.map NE.head $ NE.group xs
+    t = fromAscList xs
 
-prop_fromDistinctAscList :: [Int] -> Property
-prop_fromDistinctAscList xs =
+prop_fromDistinctAscList :: NubSorted Int -> Property
+prop_fromDistinctAscList (NubSorted xs) =
     valid t .&&.
-    toList t === nubSortedXs
+    t === fromList xs .&&.
+    toList t === xs
   where
-    nubSortedXs = List.map NE.head $ NE.group $ sort xs
-    t = fromDistinctAscList nubSortedXs
+    t = fromDistinctAscList xs
 
-prop_fromDescList :: [Int] -> Property
-prop_fromDescList xs =
+prop_fromDescList :: SortedList (Down Int) -> Property
+prop_fromDescList xs' =
     valid t .&&.
-    toList t === nubSortedXs
+    t === fromList xs .&&.
+    toList t === reverse nubXs
   where
-    sortedXs = sort xs
-    nubSortedXs = List.map NE.head $ NE.group sortedXs
-    t = fromDescList (reverse sortedXs)
+    xs = coerce xs' :: [Int]
+    nubXs = List.map NE.head $ NE.group xs
+    t = fromDescList xs
 
 prop_compareSize :: IntSet -> Int -> Property
 prop_compareSize t c = compareSize t c === compare (size t) c