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