1{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} 2{-# OPTIONS_GHC -fno-warn-orphans #-} -- because of Arbitrary (HashMap k v) 3 4-- | Tests for the 'Data.HashMap.Lazy' module. We test functions by 5-- comparing them to a simpler model, an association list. 6 7module Main (main) where 8 9import Control.Monad ( guard ) 10import qualified Data.Foldable as Foldable 11#if MIN_VERSION_base(4,10,0) 12import Data.Bifoldable 13#endif 14import Data.Function (on) 15import Data.Hashable (Hashable(hashWithSalt)) 16import qualified Data.List as L 17import Data.Ord (comparing) 18#if defined(STRICT) 19import Data.HashMap.Strict (HashMap) 20import qualified Data.HashMap.Strict as HM 21import qualified Data.Map.Strict as M 22#else 23import Data.HashMap.Lazy (HashMap) 24import qualified Data.HashMap.Lazy as HM 25import qualified Data.Map.Lazy as M 26#endif 27import Test.QuickCheck (Arbitrary(..), Property, (==>), (===), forAll, elements) 28import Test.Framework (Test, defaultMain, testGroup) 29import Test.Framework.Providers.QuickCheck2 (testProperty) 30#if MIN_VERSION_base(4,8,0) 31import Data.Functor.Identity (Identity (..)) 32#endif 33import Control.Applicative (Const (..)) 34import Test.QuickCheck.Function (Fun, apply) 35import Test.QuickCheck.Poly (A, B) 36 37-- Key type that generates more hash collisions. 38newtype Key = K { unK :: Int } 39 deriving (Arbitrary, Eq, Ord, Read, Show) 40 41instance Hashable Key where 42 hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20 43 44instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where 45 arbitrary = fmap (HM.fromList) arbitrary 46 47------------------------------------------------------------------------ 48-- * Properties 49 50------------------------------------------------------------------------ 51-- ** Instances 52 53pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool 54pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==) 55 56pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool 57pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=) 58 59-- We cannot compare to `Data.Map` as ordering is different. 60pOrd1 :: [(Key, Int)] -> Bool 61pOrd1 xs = compare x x == EQ 62 where 63 x = HM.fromList xs 64 65pOrd2 :: [(Key, Int)] -> [(Key, Int)] -> [(Key, Int)] -> Bool 66pOrd2 xs ys zs = case (compare x y, compare y z) of 67 (EQ, o) -> compare x z == o 68 (o, EQ) -> compare x z == o 69 (LT, LT) -> compare x z == LT 70 (GT, GT) -> compare x z == GT 71 (LT, GT) -> True -- ys greater than xs and zs. 72 (GT, LT) -> True 73 where 74 x = HM.fromList xs 75 y = HM.fromList ys 76 z = HM.fromList zs 77 78pOrd3 :: [(Key, Int)] -> [(Key, Int)] -> Bool 79pOrd3 xs ys = case (compare x y, compare y x) of 80 (EQ, EQ) -> True 81 (LT, GT) -> True 82 (GT, LT) -> True 83 _ -> False 84 where 85 x = HM.fromList xs 86 y = HM.fromList ys 87 88pOrdEq :: [(Key, Int)] -> [(Key, Int)] -> Bool 89pOrdEq xs ys = case (compare x y, x == y) of 90 (EQ, True) -> True 91 (LT, False) -> True 92 (GT, False) -> True 93 _ -> False 94 where 95 x = HM.fromList xs 96 y = HM.fromList ys 97 98pReadShow :: [(Key, Int)] -> Bool 99pReadShow xs = M.fromList xs == read (show (M.fromList xs)) 100 101pFunctor :: [(Key, Int)] -> Bool 102pFunctor = fmap (+ 1) `eq_` fmap (+ 1) 103 104pFoldable :: [(Int, Int)] -> Bool 105pFoldable = (L.sort . Foldable.foldr (:) []) `eq` 106 (L.sort . Foldable.foldr (:) []) 107 108pHashable :: [(Key, Int)] -> [Int] -> Int -> Property 109pHashable xs is salt = 110 x == y ==> hashWithSalt salt x === hashWithSalt salt y 111 where 112 xs' = L.nubBy (\(k,_) (k',_) -> k == k') xs 113 ys = shuffle is xs' 114 x = HM.fromList xs' 115 y = HM.fromList ys 116 -- Shuffle the list using indexes in the second 117 shuffle :: [Int] -> [a] -> [a] 118 shuffle idxs = L.map snd 119 . L.sortBy (comparing fst) 120 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..]) 121 122------------------------------------------------------------------------ 123-- ** Basic interface 124 125pSize :: [(Key, Int)] -> Bool 126pSize = M.size `eq` HM.size 127 128pMember :: Key -> [(Key, Int)] -> Bool 129pMember k = M.member k `eq` HM.member k 130 131pLookup :: Key -> [(Key, Int)] -> Bool 132pLookup k = M.lookup k `eq` HM.lookup k 133 134pLookupOperator :: Key -> [(Key, Int)] -> Bool 135pLookupOperator k = M.lookup k `eq` (HM.!? k) 136 137pInsert :: Key -> Int -> [(Key, Int)] -> Bool 138pInsert k v = M.insert k v `eq_` HM.insert k v 139 140pDelete :: Key -> [(Key, Int)] -> Bool 141pDelete k = M.delete k `eq_` HM.delete k 142 143newtype AlwaysCollide = AC Int 144 deriving (Arbitrary, Eq, Ord, Show) 145 146instance Hashable AlwaysCollide where 147 hashWithSalt _ _ = 1 148 149-- White-box test that tests the case of deleting one of two keys from 150-- a map, where the keys' hash values collide. 151pDeleteCollision :: AlwaysCollide -> AlwaysCollide -> AlwaysCollide -> Int 152 -> Property 153pDeleteCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==> 154 HM.member toKeep $ HM.delete toDelete $ 155 HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)] 156 where 157 which = idx `mod` 3 158 toDelete 159 | which == 0 = k1 160 | which == 1 = k2 161 | which == 2 = k3 162 | otherwise = error "Impossible" 163 toKeep 164 | which == 0 = k2 165 | which == 1 = k3 166 | which == 2 = k1 167 | otherwise = error "Impossible" 168 169pInsertWith :: Key -> [(Key, Int)] -> Bool 170pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1 171 172pAdjust :: Key -> [(Key, Int)] -> Bool 173pAdjust k = M.adjust succ k `eq_` HM.adjust succ k 174 175pUpdateAdjust :: Key -> [(Key, Int)] -> Bool 176pUpdateAdjust k = M.update (Just . succ) k `eq_` HM.update (Just . succ) k 177 178pUpdateDelete :: Key -> [(Key, Int)] -> Bool 179pUpdateDelete k = M.update (const Nothing) k `eq_` HM.update (const Nothing) k 180 181pAlterAdjust :: Key -> [(Key, Int)] -> Bool 182pAlterAdjust k = M.alter (fmap succ) k `eq_` HM.alter (fmap succ) k 183 184pAlterInsert :: Key -> [(Key, Int)] -> Bool 185pAlterInsert k = M.alter (const $ Just 3) k `eq_` HM.alter (const $ Just 3) k 186 187pAlterDelete :: Key -> [(Key, Int)] -> Bool 188pAlterDelete k = M.alter (const Nothing) k `eq_` HM.alter (const Nothing) k 189 190 191-- We choose the list functor here because we don't fuss with 192-- it in alterF rules and because it has a sufficiently interesting 193-- structure to have a good chance of breaking if something is wrong. 194pAlterF :: Key -> Fun (Maybe A) [Maybe A] -> [(Key, A)] -> Property 195pAlterF k f xs = 196 fmap M.toAscList (M.alterF (apply f) k (M.fromList xs)) 197 === 198 fmap toAscList (HM.alterF (apply f) k (HM.fromList xs)) 199 200#if !MIN_VERSION_base(4,8,0) 201newtype Identity a = Identity {runIdentity :: a} 202instance Functor Identity where 203 fmap f (Identity x) = Identity (f x) 204#endif 205 206pAlterFAdjust :: Key -> [(Key, Int)] -> Bool 207pAlterFAdjust k = 208 runIdentity . M.alterF (Identity . fmap succ) k `eq_` 209 runIdentity . HM.alterF (Identity . fmap succ) k 210 211pAlterFInsert :: Key -> [(Key, Int)] -> Bool 212pAlterFInsert k = 213 runIdentity . M.alterF (const . Identity . Just $ 3) k `eq_` 214 runIdentity . HM.alterF (const . Identity . Just $ 3) k 215 216pAlterFInsertWith :: Key -> Fun Int Int -> [(Key, Int)] -> Bool 217pAlterFInsertWith k f = 218 runIdentity . M.alterF (Identity . Just . maybe 3 (apply f)) k `eq_` 219 runIdentity . HM.alterF (Identity . Just . maybe 3 (apply f)) k 220 221pAlterFDelete :: Key -> [(Key, Int)] -> Bool 222pAlterFDelete k = 223 runIdentity . M.alterF (const (Identity Nothing)) k `eq_` 224 runIdentity . HM.alterF (const (Identity Nothing)) k 225 226pAlterFLookup :: Key 227 -> Fun (Maybe A) B 228 -> [(Key, A)] -> Bool 229pAlterFLookup k f = 230 getConst . M.alterF (Const . apply f :: Maybe A -> Const B (Maybe A)) k 231 `eq` 232 getConst . HM.alterF (Const . apply f) k 233 234pSubmap :: [(Key, Int)] -> [(Key, Int)] -> Bool 235pSubmap xs ys = M.isSubmapOf (M.fromList xs) (M.fromList ys) == 236 HM.isSubmapOf (HM.fromList xs) (HM.fromList ys) 237 238pSubmapReflexive :: HashMap Key Int -> Bool 239pSubmapReflexive m = HM.isSubmapOf m m 240 241pSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Bool 242pSubmapUnion m1 m2 = HM.isSubmapOf m1 (HM.union m1 m2) 243 244pNotSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Property 245pNotSubmapUnion m1 m2 = not (HM.isSubmapOf m1 m2) ==> HM.isSubmapOf m1 (HM.union m1 m2) 246 247pSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Bool 248pSubmapDifference m1 m2 = HM.isSubmapOf (HM.difference m1 m2) m1 249 250pNotSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Property 251pNotSubmapDifference m1 m2 = 252 not (HM.null (HM.intersection m1 m2)) ==> 253 not (HM.isSubmapOf m1 (HM.difference m1 m2)) 254 255pSubmapDelete :: HashMap Key Int -> Property 256pSubmapDelete m = not (HM.null m) ==> 257 forAll (elements (HM.keys m)) $ \k -> 258 HM.isSubmapOf (HM.delete k m) m 259 260pNotSubmapDelete :: HashMap Key Int -> Property 261pNotSubmapDelete m = 262 not (HM.null m) ==> 263 forAll (elements (HM.keys m)) $ \k -> 264 not (HM.isSubmapOf m (HM.delete k m)) 265 266pSubmapInsert :: Key -> Int -> HashMap Key Int -> Property 267pSubmapInsert k v m = not (HM.member k m) ==> HM.isSubmapOf m (HM.insert k v m) 268 269pNotSubmapInsert :: Key -> Int -> HashMap Key Int -> Property 270pNotSubmapInsert k v m = not (HM.member k m) ==> not (HM.isSubmapOf (HM.insert k v m) m) 271 272------------------------------------------------------------------------ 273-- ** Combine 274 275pUnion :: [(Key, Int)] -> [(Key, Int)] -> Bool 276pUnion xs ys = M.union (M.fromList xs) `eq_` HM.union (HM.fromList xs) $ ys 277 278pUnionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool 279pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_` 280 HM.unionWith (-) (HM.fromList xs) $ ys 281 282pUnionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool 283pUnionWithKey xs ys = M.unionWithKey go (M.fromList xs) `eq_` 284 HM.unionWithKey go (HM.fromList xs) $ ys 285 where 286 go :: Key -> Int -> Int -> Int 287 go (K k) i1 i2 = k - i1 + i2 288 289pUnions :: [[(Key, Int)]] -> Bool 290pUnions xss = M.toAscList (M.unions (map M.fromList xss)) == 291 toAscList (HM.unions (map HM.fromList xss)) 292 293------------------------------------------------------------------------ 294-- ** Transformations 295 296pMap :: [(Key, Int)] -> Bool 297pMap = M.map (+ 1) `eq_` HM.map (+ 1) 298 299pTraverse :: [(Key, Int)] -> Bool 300pTraverse xs = 301 L.sort (fmap (L.sort . M.toList) (M.traverseWithKey (\_ v -> [v + 1, v + 2]) (M.fromList (take 10 xs)))) 302 == L.sort (fmap (L.sort . HM.toList) (HM.traverseWithKey (\_ v -> [v + 1, v + 2]) (HM.fromList (take 10 xs)))) 303 304pMapKeys :: [(Int, Int)] -> Bool 305pMapKeys = M.mapKeys (+1) `eq_` HM.mapKeys (+1) 306 307------------------------------------------------------------------------ 308-- ** Difference and intersection 309 310pDifference :: [(Key, Int)] -> [(Key, Int)] -> Bool 311pDifference xs ys = M.difference (M.fromList xs) `eq_` 312 HM.difference (HM.fromList xs) $ ys 313 314pDifferenceWith :: [(Key, Int)] -> [(Key, Int)] -> Bool 315pDifferenceWith xs ys = M.differenceWith f (M.fromList xs) `eq_` 316 HM.differenceWith f (HM.fromList xs) $ ys 317 where 318 f x y = if x == 0 then Nothing else Just (x - y) 319 320pIntersection :: [(Key, Int)] -> [(Key, Int)] -> Bool 321pIntersection xs ys = M.intersection (M.fromList xs) `eq_` 322 HM.intersection (HM.fromList xs) $ ys 323 324pIntersectionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool 325pIntersectionWith xs ys = M.intersectionWith (-) (M.fromList xs) `eq_` 326 HM.intersectionWith (-) (HM.fromList xs) $ ys 327 328pIntersectionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool 329pIntersectionWithKey xs ys = M.intersectionWithKey go (M.fromList xs) `eq_` 330 HM.intersectionWithKey go (HM.fromList xs) $ ys 331 where 332 go :: Key -> Int -> Int -> Int 333 go (K k) i1 i2 = k - i1 - i2 334 335------------------------------------------------------------------------ 336-- ** Folds 337 338pFoldr :: [(Int, Int)] -> Bool 339pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) []) 340 341pFoldl :: [(Int, Int)] -> Bool 342pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) []) 343 344#if MIN_VERSION_base(4,10,0) 345pBifoldMap :: [(Int, Int)] -> Bool 346pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m 347 where f (k, v) = [k, v] 348 m = HM.fromList xs 349 350pBifoldr :: [(Int, Int)] -> Bool 351pBifoldr xs = concatMap f (HM.toList m) == bifoldr (:) (:) [] m 352 where f (k, v) = [k, v] 353 m = HM.fromList xs 354 355pBifoldl :: [(Int, Int)] -> Bool 356pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m 357 where f (k, v) = [k, v] 358 m = HM.fromList xs 359#endif 360 361pFoldrWithKey :: [(Int, Int)] -> Bool 362pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq` 363 (sortByKey . HM.foldrWithKey f []) 364 where f k v z = (k, v) : z 365 366pFoldMapWithKey :: [(Int, Int)] -> Bool 367pFoldMapWithKey = (sortByKey . M.foldMapWithKey f) `eq` 368 (sortByKey . HM.foldMapWithKey f) 369 where f k v = [(k, v)] 370 371pFoldrWithKey' :: [(Int, Int)] -> Bool 372pFoldrWithKey' = (sortByKey . M.foldrWithKey' f []) `eq` 373 (sortByKey . HM.foldrWithKey' f []) 374 where f k v z = (k, v) : z 375 376pFoldlWithKey :: [(Int, Int)] -> Bool 377pFoldlWithKey = (sortByKey . M.foldlWithKey f []) `eq` 378 (sortByKey . HM.foldlWithKey f []) 379 where f z k v = (k, v) : z 380 381pFoldlWithKey' :: [(Int, Int)] -> Bool 382pFoldlWithKey' = (sortByKey . M.foldlWithKey' f []) `eq` 383 (sortByKey . HM.foldlWithKey' f []) 384 where f z k v = (k, v) : z 385 386pFoldl' :: [(Int, Int)] -> Bool 387pFoldl' = (L.sort . M.foldl' (flip (:)) []) `eq` (L.sort . HM.foldl' (flip (:)) []) 388 389pFoldr' :: [(Int, Int)] -> Bool 390pFoldr' = (L.sort . M.foldr' (:) []) `eq` (L.sort . HM.foldr' (:) []) 391 392------------------------------------------------------------------------ 393-- ** Filter 394 395pMapMaybeWithKey :: [(Key, Int)] -> Bool 396pMapMaybeWithKey = M.mapMaybeWithKey f `eq_` HM.mapMaybeWithKey f 397 where f k v = guard (odd (unK k + v)) >> Just (v + 1) 398 399pMapMaybe :: [(Key, Int)] -> Bool 400pMapMaybe = M.mapMaybe f `eq_` HM.mapMaybe f 401 where f v = guard (odd v) >> Just (v + 1) 402 403pFilter :: [(Key, Int)] -> Bool 404pFilter = M.filter odd `eq_` HM.filter odd 405 406pFilterWithKey :: [(Key, Int)] -> Bool 407pFilterWithKey = M.filterWithKey p `eq_` HM.filterWithKey p 408 where p k v = odd (unK k + v) 409 410------------------------------------------------------------------------ 411-- ** Conversions 412 413-- The free magma is used to test that operations are applied in the 414-- same order. 415data Magma a 416 = Leaf a 417 | Op (Magma a) (Magma a) 418 deriving (Show, Eq, Ord) 419 420instance Hashable a => Hashable (Magma a) where 421 hashWithSalt s (Leaf a) = hashWithSalt s (hashWithSalt (1::Int) a) 422 hashWithSalt s (Op m n) = hashWithSalt s (hashWithSalt (hashWithSalt (2::Int) m) n) 423 424-- 'eq_' already calls fromList. 425pFromList :: [(Key, Int)] -> Bool 426pFromList = id `eq_` id 427 428pFromListWith :: [(Key, Int)] -> Bool 429pFromListWith kvs = (M.toAscList $ M.fromListWith Op kvsM) == 430 (toAscList $ HM.fromListWith Op kvsM) 431 where kvsM = fmap (fmap Leaf) kvs 432 433pFromListWithKey :: [(Key, Int)] -> Bool 434pFromListWithKey kvs = (M.toAscList $ M.fromListWithKey combine kvsM) == 435 (toAscList $ HM.fromListWithKey combine kvsM) 436 where kvsM = fmap (\(K k,v) -> (Leaf k, Leaf v)) kvs 437 combine k v1 v2 = Op k (Op v1 v2) 438 439pToList :: [(Key, Int)] -> Bool 440pToList = M.toAscList `eq` toAscList 441 442pElems :: [(Key, Int)] -> Bool 443pElems = (L.sort . M.elems) `eq` (L.sort . HM.elems) 444 445pKeys :: [(Key, Int)] -> Bool 446pKeys = (L.sort . M.keys) `eq` (L.sort . HM.keys) 447 448------------------------------------------------------------------------ 449-- * Test list 450 451tests :: [Test] 452tests = 453 [ 454 -- Instances 455 testGroup "instances" 456 [ testProperty "==" pEq 457 , testProperty "/=" pNeq 458 , testProperty "compare reflexive" pOrd1 459 , testProperty "compare transitive" pOrd2 460 , testProperty "compare antisymmetric" pOrd3 461 , testProperty "Ord => Eq" pOrdEq 462 , testProperty "Read/Show" pReadShow 463 , testProperty "Functor" pFunctor 464 , testProperty "Foldable" pFoldable 465 , testProperty "Hashable" pHashable 466 ] 467 -- Basic interface 468 , testGroup "basic interface" 469 [ testProperty "size" pSize 470 , testProperty "member" pMember 471 , testProperty "lookup" pLookup 472 , testProperty "!?" pLookupOperator 473 , testProperty "insert" pInsert 474 , testProperty "delete" pDelete 475 , testProperty "deleteCollision" pDeleteCollision 476 , testProperty "insertWith" pInsertWith 477 , testProperty "adjust" pAdjust 478 , testProperty "updateAdjust" pUpdateAdjust 479 , testProperty "updateDelete" pUpdateDelete 480 , testProperty "alterAdjust" pAlterAdjust 481 , testProperty "alterInsert" pAlterInsert 482 , testProperty "alterDelete" pAlterDelete 483 , testProperty "alterF" pAlterF 484 , testProperty "alterFAdjust" pAlterFAdjust 485 , testProperty "alterFInsert" pAlterFInsert 486 , testProperty "alterFInsertWith" pAlterFInsertWith 487 , testProperty "alterFDelete" pAlterFDelete 488 , testProperty "alterFLookup" pAlterFLookup 489 , testGroup "isSubmapOf" 490 [ testProperty "container compatibility" pSubmap 491 , testProperty "m ⊆ m" pSubmapReflexive 492 , testProperty "m1 ⊆ m1 ∪ m2" pSubmapUnion 493 , testProperty "m1 ⊈ m2 ⇒ m1 ∪ m2 ⊈ m1" pNotSubmapUnion 494 , testProperty "m1\\m2 ⊆ m1" pSubmapDifference 495 , testProperty "m1 ∩ m2 ≠ ∅ ⇒ m1 ⊈ m1\\m2 " pNotSubmapDifference 496 , testProperty "delete k m ⊆ m" pSubmapDelete 497 , testProperty "m ⊈ delete k m " pNotSubmapDelete 498 , testProperty "k ∉ m ⇒ m ⊆ insert k v m" pSubmapInsert 499 , testProperty "k ∉ m ⇒ insert k v m ⊈ m" pNotSubmapInsert 500 ] 501 ] 502 -- Combine 503 , testProperty "union" pUnion 504 , testProperty "unionWith" pUnionWith 505 , testProperty "unionWithKey" pUnionWithKey 506 , testProperty "unions" pUnions 507 -- Transformations 508 , testProperty "map" pMap 509 , testProperty "traverse" pTraverse 510 , testProperty "mapKeys" pMapKeys 511 -- Folds 512 , testGroup "folds" 513 [ testProperty "foldr" pFoldr 514 , testProperty "foldl" pFoldl 515#if MIN_VERSION_base(4,10,0) 516 , testProperty "bifoldMap" pBifoldMap 517 , testProperty "bifoldr" pBifoldr 518 , testProperty "bifoldl" pBifoldl 519#endif 520 , testProperty "foldrWithKey" pFoldrWithKey 521 , testProperty "foldlWithKey" pFoldlWithKey 522 , testProperty "foldrWithKey'" pFoldrWithKey' 523 , testProperty "foldlWithKey'" pFoldlWithKey' 524 , testProperty "foldl'" pFoldl' 525 , testProperty "foldr'" pFoldr' 526 , testProperty "foldMapWithKey" pFoldMapWithKey 527 ] 528 , testGroup "difference and intersection" 529 [ testProperty "difference" pDifference 530 , testProperty "differenceWith" pDifferenceWith 531 , testProperty "intersection" pIntersection 532 , testProperty "intersectionWith" pIntersectionWith 533 , testProperty "intersectionWithKey" pIntersectionWithKey 534 ] 535 -- Filter 536 , testGroup "filter" 537 [ testProperty "filter" pFilter 538 , testProperty "filterWithKey" pFilterWithKey 539 , testProperty "mapMaybe" pMapMaybe 540 , testProperty "mapMaybeWithKey" pMapMaybeWithKey 541 ] 542 -- Conversions 543 , testGroup "conversions" 544 [ testProperty "elems" pElems 545 , testProperty "keys" pKeys 546 , testProperty "fromList" pFromList 547 , testProperty "fromListWith" pFromListWith 548 , testProperty "fromListWithKey" pFromListWithKey 549 , testProperty "toList" pToList 550 ] 551 ] 552 553------------------------------------------------------------------------ 554-- * Model 555 556type Model k v = M.Map k v 557 558-- | Check that a function operating on a 'HashMap' is equivalent to 559-- one operating on a 'Model'. 560eq :: (Eq a, Eq k, Hashable k, Ord k) 561 => (Model k v -> a) -- ^ Function that modifies a 'Model' 562 -> (HM.HashMap k v -> a) -- ^ Function that modified a 'HashMap' in the same 563 -- way 564 -> [(k, v)] -- ^ Initial content of the 'HashMap' and 'Model' 565 -> Bool -- ^ True if the functions are equivalent 566eq f g xs = g (HM.fromList xs) == f (M.fromList xs) 567 568infix 4 `eq` 569 570eq_ :: (Eq k, Eq v, Hashable k, Ord k) 571 => (Model k v -> Model k v) -- ^ Function that modifies a 'Model' 572 -> (HM.HashMap k v -> HM.HashMap k v) -- ^ Function that modified a 573 -- 'HashMap' in the same way 574 -> [(k, v)] -- ^ Initial content of the 'HashMap' 575 -- and 'Model' 576 -> Bool -- ^ True if the functions are 577 -- equivalent 578eq_ f g = (M.toAscList . f) `eq` (toAscList . g) 579 580infix 4 `eq_` 581 582------------------------------------------------------------------------ 583-- * Test harness 584 585main :: IO () 586main = defaultMain tests 587 588------------------------------------------------------------------------ 589-- * Helpers 590 591sortByKey :: Ord k => [(k, v)] -> [(k, v)] 592sortByKey = L.sortBy (compare `on` fst) 593 594toAscList :: Ord k => HM.HashMap k v -> [(k, v)] 595toAscList = L.sortBy (compare `on` fst) . HM.toList 596