Fix Foldable instance for IntMap (fixes #579) (#593)
[packages/containers.git] / tests / intmap-properties.hs
1 {-# LANGUAGE CPP #-}
2
3 #ifdef STRICT
4 import Data.IntMap.Strict as Data.IntMap hiding (showTree)
5 #else
6 import Data.IntMap.Lazy as Data.IntMap hiding (showTree)
7 #endif
8 import Data.IntMap.Internal.Debug (showTree)
9 import IntMapValidity (valid)
10
11 import Data.Monoid
12 import Data.Maybe hiding (mapMaybe)
13 import qualified Data.Maybe as Maybe (mapMaybe)
14 import Data.Ord
15 import Data.Foldable (foldMap)
16 import Data.Function
17 import Data.Traversable (Traversable(traverse), foldMapDefault)
18 import Prelude hiding (lookup, null, map, filter, foldr, foldl)
19 import qualified Prelude (map)
20
21 import Data.List (nub,sort)
22 import qualified Data.List as List
23 import qualified Data.IntSet as IntSet
24 import Test.Framework
25 import Test.Framework.Providers.HUnit
26 import Test.Framework.Providers.QuickCheck2
27 import Test.HUnit hiding (Test, Testable)
28 import Test.QuickCheck
29 import Test.QuickCheck.Function (Fun(..), apply)
30 import Test.QuickCheck.Poly (A, B)
31
32 default (Int)
33
34 main :: IO ()
35 main = defaultMain
36 [
37 testCase "index" test_index
38 , testCase "index_lookup" test_index_lookup
39 , testCase "size" test_size
40 , testCase "size2" test_size2
41 , testCase "member" test_member
42 , testCase "notMember" test_notMember
43 , testCase "lookup" test_lookup
44 , testCase "findWithDefault" test_findWithDefault
45 , testCase "lookupLT" test_lookupLT
46 , testCase "lookupGT" test_lookupGT
47 , testCase "lookupLE" test_lookupLE
48 , testCase "lookupGE" test_lookupGE
49 , testCase "empty" test_empty
50 , testCase "mempty" test_mempty
51 , testCase "singleton" test_singleton
52 , testCase "insert" test_insert
53 , testCase "insertWith" test_insertWith
54 , testCase "insertWithKey" test_insertWithKey
55 , testCase "insertLookupWithKey" test_insertLookupWithKey
56 , testCase "delete" test_delete
57 , testCase "adjust" test_adjust
58 , testCase "adjustWithKey" test_adjustWithKey
59 , testCase "update" test_update
60 , testCase "updateWithKey" test_updateWithKey
61 , testCase "updateLookupWithKey" test_updateLookupWithKey
62 , testCase "alter" test_alter
63 , testCase "union" test_union
64 , testCase "mappend" test_mappend
65 , testCase "unionWith" test_unionWith
66 , testCase "unionWithKey" test_unionWithKey
67 , testCase "unions" test_unions
68 , testCase "mconcat" test_mconcat
69 , testCase "unionsWith" test_unionsWith
70 , testCase "difference" test_difference
71 , testCase "differenceWith" test_differenceWith
72 , testCase "differenceWithKey" test_differenceWithKey
73 , testCase "intersection" test_intersection
74 , testCase "intersectionWith" test_intersectionWith
75 , testCase "intersectionWithKey" test_intersectionWithKey
76 , testCase "map" test_map
77 , testCase "mapWithKey" test_mapWithKey
78 , testCase "mapAccum" test_mapAccum
79 , testCase "mapAccumWithKey" test_mapAccumWithKey
80 , testCase "mapAccumRWithKey" test_mapAccumRWithKey
81 , testCase "mapKeys" test_mapKeys
82 , testCase "mapKeysWith" test_mapKeysWith
83 , testCase "mapKeysMonotonic" test_mapKeysMonotonic
84 , testCase "elems" test_elems
85 , testCase "keys" test_keys
86 , testCase "assocs" test_assocs
87 , testCase "keysSet" test_keysSet
88 , testCase "keysSet" test_fromSet
89 , testCase "toList" test_toList
90 , testCase "fromList" test_fromList
91 , testCase "fromListWith" test_fromListWith
92 , testCase "fromListWithKey" test_fromListWithKey
93 , testCase "toAscList" test_toAscList
94 , testCase "toDescList" test_toDescList
95 , testCase "showTree" test_showTree
96 , testCase "fromAscList" test_fromAscList
97 , testCase "fromAscListWith" test_fromAscListWith
98 , testCase "fromAscListWithKey" test_fromAscListWithKey
99 , testCase "fromDistinctAscList" test_fromDistinctAscList
100 , testCase "filter" test_filter
101 , testCase "filterWithKey" test_filteWithKey
102 , testCase "partition" test_partition
103 , testCase "partitionWithKey" test_partitionWithKey
104 , testCase "mapMaybe" test_mapMaybe
105 , testCase "mapMaybeWithKey" test_mapMaybeWithKey
106 , testCase "mapEither" test_mapEither
107 , testCase "mapEitherWithKey" test_mapEitherWithKey
108 , testCase "split" test_split
109 , testCase "splitLookup" test_splitLookup
110 , testCase "isSubmapOfBy" test_isSubmapOfBy
111 , testCase "isSubmapOf" test_isSubmapOf
112 , testCase "isProperSubmapOfBy" test_isProperSubmapOfBy
113 , testCase "isProperSubmapOf" test_isProperSubmapOf
114 , testCase "lookupMin" test_lookupMin
115 , testCase "lookupMax" test_lookupMax
116 , testCase "findMin" test_findMin
117 , testCase "findMax" test_findMax
118 , testCase "deleteMin" test_deleteMin
119 , testCase "deleteMax" test_deleteMax
120 , testCase "deleteFindMin" test_deleteFindMin
121 , testCase "deleteFindMax" test_deleteFindMax
122 , testCase "updateMin" test_updateMin
123 , testCase "updateMax" test_updateMax
124 , testCase "updateMinWithKey" test_updateMinWithKey
125 , testCase "updateMaxWithKey" test_updateMaxWithKey
126 , testCase "minView" test_minView
127 , testCase "maxView" test_maxView
128 , testCase "minViewWithKey" test_minViewWithKey
129 , testCase "maxViewWithKey" test_maxViewWithKey
130 , testProperty "valid" prop_valid
131 , testProperty "empty valid" prop_emptyValid
132 , testProperty "insert to singleton" prop_singleton
133 , testProperty "insert then lookup" prop_insertLookup
134 , testProperty "insert then delete" prop_insertDelete
135 , testProperty "delete non member" prop_deleteNonMember
136 , testProperty "union model" prop_unionModel
137 , testProperty "union singleton" prop_unionSingleton
138 , testProperty "union associative" prop_unionAssoc
139 , testProperty "union+unionWith" prop_unionWith
140 , testProperty "union sum" prop_unionSum
141 , testProperty "difference model" prop_differenceModel
142 , testProperty "intersection model" prop_intersectionModel
143 , testProperty "intersectionWith model" prop_intersectionWithModel
144 , testProperty "intersectionWithKey model" prop_intersectionWithKeyModel
145 , testProperty "mergeWithKey model" prop_mergeWithKeyModel
146 , testProperty "fromAscList" prop_ordered
147 , testProperty "fromList then toList" prop_list
148 , testProperty "toDescList" prop_descList
149 , testProperty "toAscList+toDescList" prop_ascDescList
150 , testProperty "fromList" prop_fromList
151 , testProperty "alter" prop_alter
152 , testProperty "index" prop_index
153 , testProperty "index_lookup" prop_index_lookup
154 , testProperty "null" prop_null
155 , testProperty "size" prop_size
156 , testProperty "member" prop_member
157 , testProperty "notmember" prop_notmember
158 , testProperty "lookup" prop_lookup
159 , testProperty "find" prop_find
160 , testProperty "findWithDefault" prop_findWithDefault
161 , testProperty "lookupLT" prop_lookupLT
162 , testProperty "lookupGT" prop_lookupGT
163 , testProperty "lookupLE" prop_lookupLE
164 , testProperty "lookupGE" prop_lookupGE
165 , testProperty "lookupMin" prop_lookupMin
166 , testProperty "lookupMax" prop_lookupMax
167 , testProperty "findMin" prop_findMin
168 , testProperty "findMax" prop_findMax
169 , testProperty "deleteMin" prop_deleteMinModel
170 , testProperty "deleteMax" prop_deleteMaxModel
171 , testProperty "filter" prop_filter
172 , testProperty "partition" prop_partition
173 , testProperty "map" prop_map
174 , testProperty "fmap" prop_fmap
175 , testProperty "mapkeys" prop_mapkeys
176 , testProperty "split" prop_splitModel
177 , testProperty "splitRoot" prop_splitRoot
178 , testProperty "foldr" prop_foldr
179 , testProperty "foldr'" prop_foldr'
180 , testProperty "foldl" prop_foldl
181 , testProperty "foldl'" prop_foldl'
182 , testProperty "foldr==foldMap" prop_foldrEqFoldMap
183 , testProperty
184 "foldrWithKey==foldMapWithKey"
185 prop_foldrWithKeyEqFoldMapWithKey
186 , testProperty
187 "prop_FoldableTraversableCompat"
188 prop_FoldableTraversableCompat
189 , testProperty "keysSet" prop_keysSet
190 , testProperty "fromSet" prop_fromSet
191 , testProperty "restrictKeys" prop_restrictKeys
192 , testProperty "withoutKeys" prop_withoutKeys
193 ]
194
195 apply2 :: Fun (a, b) c -> a -> b -> c
196 apply2 f a b = apply f (a, b)
197
198 apply3 :: Fun (a, b, c) d -> a -> b -> c -> d
199 apply3 f a b c = apply f (a, b, c)
200
201
202 {--------------------------------------------------------------------
203 Arbitrary, reasonably balanced trees
204 --------------------------------------------------------------------}
205
206 instance Arbitrary a => Arbitrary (IntMap a) where
207 arbitrary = do{ ks <- arbitrary
208 ; xs <- arbitrary
209 ; return (fromList (zip xs ks))
210 }
211
212 newtype NonEmptyIntMap a = NonEmptyIntMap {getNonEmptyIntMap :: IntMap a} deriving (Eq, Show)
213
214 instance Arbitrary a => Arbitrary (NonEmptyIntMap a) where
215 arbitrary = fmap (NonEmptyIntMap . fromList . getNonEmpty) arbitrary
216
217
218 ------------------------------------------------------------------------
219
220 type UMap = IntMap ()
221 type IMap = IntMap Int
222 type SMap = IntMap String
223
224 ----------------------------------------------------------------
225
226 tests :: [Test]
227 tests = [ testGroup "Test Case" [
228 ]
229 , testGroup "Property Test" [
230 ]
231 ]
232
233
234 ----------------------------------------------------------------
235 -- Unit tests
236 ----------------------------------------------------------------
237
238 ----------------------------------------------------------------
239 -- Operators
240
241 test_index :: Assertion
242 test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a'
243
244 test_index_lookup :: Assertion
245 test_index_lookup = do
246 fromList [(5,'a'), (3,'b')] !? 1 @?= Nothing
247 fromList [(5,'a'), (3,'b')] !? 5 @?= Just 'a'
248
249 ----------------------------------------------------------------
250 -- Query
251
252 test_size :: Assertion
253 test_size = do
254 null (empty) @?= True
255 null (singleton 1 'a') @?= False
256
257 test_size2 :: Assertion
258 test_size2 = do
259 size empty @?= 0
260 size (singleton 1 'a') @?= 1
261 size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3
262
263 test_member :: Assertion
264 test_member = do
265 member 5 (fromList [(5,'a'), (3,'b')]) @?= True
266 member 1 (fromList [(5,'a'), (3,'b')]) @?= False
267
268 test_notMember :: Assertion
269 test_notMember = do
270 notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False
271 notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True
272
273 test_lookup :: Assertion
274 test_lookup = do
275 employeeCurrency 1 @?= Just 1
276 employeeCurrency 2 @?= Nothing
277 where
278 employeeDept = fromList([(1,2), (3,1)])
279 deptCountry = fromList([(1,1), (2,2)])
280 countryCurrency = fromList([(1, 2), (2, 1)])
281 employeeCurrency :: Int -> Maybe Int
282 employeeCurrency name = do
283 dept <- lookup name employeeDept
284 country <- lookup dept deptCountry
285 lookup country countryCurrency
286
287 test_findWithDefault :: Assertion
288 test_findWithDefault = do
289 findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x'
290 findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a'
291
292 test_lookupLT :: Assertion
293 test_lookupLT = do
294 lookupLT 3 (fromList [(3,'a'), (5,'b')]) @?= Nothing
295 lookupLT 4 (fromList [(3,'a'), (5,'b')]) @?= Just (3, 'a')
296
297 test_lookupGT :: Assertion
298 test_lookupGT = do
299 lookupGT 4 (fromList [(3,'a'), (5,'b')]) @?= Just (5, 'b')
300 lookupGT 5 (fromList [(3,'a'), (5,'b')]) @?= Nothing
301
302 test_lookupLE :: Assertion
303 test_lookupLE = do
304 lookupLE 2 (fromList [(3,'a'), (5,'b')]) @?= Nothing
305 lookupLE 4 (fromList [(3,'a'), (5,'b')]) @?= Just (3, 'a')
306 lookupLE 5 (fromList [(3,'a'), (5,'b')]) @?= Just (5, 'b')
307
308 test_lookupGE :: Assertion
309 test_lookupGE = do
310 lookupGE 3 (fromList [(3,'a'), (5,'b')]) @?= Just (3, 'a')
311 lookupGE 4 (fromList [(3,'a'), (5,'b')]) @?= Just (5, 'b')
312 lookupGE 6 (fromList [(3,'a'), (5,'b')]) @?= Nothing
313
314 ----------------------------------------------------------------
315 -- Construction
316
317 test_empty :: Assertion
318 test_empty = do
319 (empty :: UMap) @?= fromList []
320 size empty @?= 0
321
322 test_mempty :: Assertion
323 test_mempty = do
324 (mempty :: UMap) @?= fromList []
325 size (mempty :: UMap) @?= 0
326
327 test_singleton :: Assertion
328 test_singleton = do
329 singleton 1 'a' @?= fromList [(1, 'a')]
330 size (singleton 1 'a') @?= 1
331
332 test_insert :: Assertion
333 test_insert = do
334 insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')]
335 insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')]
336 insert 5 'x' empty @?= singleton 5 'x'
337
338 test_insertWith :: Assertion
339 test_insertWith = do
340 insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
341 insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
342 insertWith (++) 5 "xxx" empty @?= singleton 5 "xxx"
343
344 test_insertWithKey :: Assertion
345 test_insertWithKey = do
346 insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
347 insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
348 insertWithKey f 5 "xxx" empty @?= singleton 5 "xxx"
349 where
350 f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
351
352 test_insertLookupWithKey :: Assertion
353 test_insertLookupWithKey = do
354 insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
355 insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
356 insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
357 insertLookupWithKey f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
358 where
359 f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
360
361 ----------------------------------------------------------------
362 -- Delete/Update
363
364 test_delete :: Assertion
365 test_delete = do
366 delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
367 delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
368 delete 5 empty @?= (empty :: IMap)
369
370 test_adjust :: Assertion
371 test_adjust = do
372 adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
373 adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
374 adjust ("new " ++) 7 empty @?= empty
375
376 test_adjustWithKey :: Assertion
377 test_adjustWithKey = do
378 adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
379 adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
380 adjustWithKey f 7 empty @?= empty
381 where
382 f key x = (show key) ++ ":new " ++ x
383
384 test_update :: Assertion
385 test_update = do
386 update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
387 update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
388 update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
389 where
390 f x = if x == "a" then Just "new a" else Nothing
391
392 test_updateWithKey :: Assertion
393 test_updateWithKey = do
394 updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
395 updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
396 updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
397 where
398 f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
399
400 test_updateLookupWithKey :: Assertion
401 test_updateLookupWithKey = do
402 updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:new a")])
403 updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a")])
404 updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a")
405 where
406 f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
407
408 test_alter :: Assertion
409 test_alter = do
410 alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
411 alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
412 alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")]
413 alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")]
414 where
415 f _ = Nothing
416 g _ = Just "c"
417
418 ----------------------------------------------------------------
419 -- Combine
420
421 test_union :: Assertion
422 test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
423
424 test_mappend :: Assertion
425 test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
426
427 test_unionWith :: Assertion
428 test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")]
429
430 test_unionWithKey :: Assertion
431 test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
432 where
433 f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
434
435 test_unions :: Assertion
436 test_unions = do
437 unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
438 @?= fromList [(3, "b"), (5, "a"), (7, "C")]
439 unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
440 @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
441
442 test_mconcat :: Assertion
443 test_mconcat = do
444 mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
445 @?= fromList [(3, "b"), (5, "a"), (7, "C")]
446 mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
447 @?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
448
449 test_unionsWith :: Assertion
450 test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
451 @?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
452
453 test_difference :: Assertion
454 test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b"
455
456 test_differenceWith :: Assertion
457 test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
458 @?= singleton 3 "b:B"
459 where
460 f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
461
462 test_differenceWithKey :: Assertion
463 test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
464 @?= singleton 3 "3:b|B"
465 where
466 f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
467
468 test_intersection :: Assertion
469 test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a"
470
471
472 test_intersectionWith :: Assertion
473 test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA"
474
475 test_intersectionWithKey :: Assertion
476 test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A"
477 where
478 f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
479
480 ----------------------------------------------------------------
481 -- Traversal
482
483 test_map :: Assertion
484 test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")]
485
486 test_mapWithKey :: Assertion
487 test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")]
488 where
489 f key x = (show key) ++ ":" ++ x
490
491 test_mapAccum :: Assertion
492 test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
493 where
494 f a b = (a ++ b, b ++ "X")
495
496 test_mapAccumWithKey :: Assertion
497 test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
498 where
499 f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
500
501 test_mapAccumRWithKey :: Assertion
502 test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")])
503 where
504 f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
505
506 test_mapKeys :: Assertion
507 test_mapKeys = do
508 mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
509 mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
510 mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
511
512 test_mapKeysWith :: Assertion
513 test_mapKeysWith = do
514 mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
515 mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
516
517 test_mapKeysMonotonic :: Assertion
518 test_mapKeysMonotonic = do
519 mapKeysMonotonic (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
520 mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
521
522 ----------------------------------------------------------------
523 -- Conversion
524
525 test_elems :: Assertion
526 test_elems = do
527 elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"]
528 elems (empty :: UMap) @?= []
529
530 test_keys :: Assertion
531 test_keys = do
532 keys (fromList [(5,"a"), (3,"b")]) @?= [3,5]
533 keys (empty :: UMap) @?= []
534
535 test_assocs :: Assertion
536 test_assocs = do
537 assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
538 assocs (empty :: UMap) @?= []
539
540 test_keysSet :: Assertion
541 test_keysSet = do
542 keysSet (fromList [(5,"a"), (3,"b")]) @?= IntSet.fromList [3,5]
543 keysSet (empty :: UMap) @?= IntSet.empty
544
545 test_fromSet :: Assertion
546 test_fromSet = do
547 fromSet (\k -> replicate k 'a') (IntSet.fromList [3, 5]) @?= fromList [(5,"aaaaa"), (3,"aaa")]
548 fromSet undefined IntSet.empty @?= (empty :: IMap)
549
550 ----------------------------------------------------------------
551 -- Lists
552
553 test_toList :: Assertion
554 test_toList = do
555 toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
556 toList (empty :: SMap) @?= []
557
558 test_fromList :: Assertion
559 test_fromList = do
560 fromList [] @?= (empty :: SMap)
561 fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")]
562 fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")]
563
564 test_fromListWith :: Assertion
565 test_fromListWith = do
566 fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")]
567 fromListWith (++) [] @?= (empty :: SMap)
568
569 test_fromListWithKey :: Assertion
570 test_fromListWithKey = do
571 fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")]
572 fromListWithKey f [] @?= (empty :: SMap)
573 where
574 f k a1 a2 = (show k) ++ a1 ++ a2
575
576 ----------------------------------------------------------------
577 -- Ordered lists
578
579 test_toAscList :: Assertion
580 test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
581
582 test_toDescList :: Assertion
583 test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
584
585 test_showTree :: Assertion
586 test_showTree =
587 (let t = fromDistinctAscList [(x,()) | x <- [1..5]]
588 in showTree t) @?= "*\n+--*\n| +-- 1:=()\n| +--*\n| +-- 2:=()\n| +-- 3:=()\n+--*\n +-- 4:=()\n +-- 5:=()\n"
589
590 test_fromAscList :: Assertion
591 test_fromAscList = do
592 fromAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
593 fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")]
594
595
596 test_fromAscListWith :: Assertion
597 test_fromAscListWith = do
598 fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")]
599
600 test_fromAscListWithKey :: Assertion
601 test_fromAscListWithKey = do
602 fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")]
603 where
604 f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
605
606 test_fromDistinctAscList :: Assertion
607 test_fromDistinctAscList = do
608 fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
609
610 ----------------------------------------------------------------
611 -- Filter
612
613 test_filter :: Assertion
614 test_filter = do
615 filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
616 filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty
617 filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty
618
619 test_filteWithKey :: Assertion
620 test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
621
622 test_partition :: Assertion
623 test_partition = do
624 partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
625 partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
626 partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
627
628 test_partitionWithKey :: Assertion
629 test_partitionWithKey = do
630 partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b")
631 partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
632 partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
633
634 test_mapMaybe :: Assertion
635 test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a"
636 where
637 f x = if x == "a" then Just "new a" else Nothing
638
639 test_mapMaybeWithKey :: Assertion
640 test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3"
641 where
642 f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
643
644 test_mapEither :: Assertion
645 test_mapEither = do
646 mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
647 @?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
648 mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
649 @?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
650 where
651 f a = if a < "c" then Left a else Right a
652
653 test_mapEitherWithKey :: Assertion
654 test_mapEitherWithKey = do
655 mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
656 @?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
657 mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
658 @?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
659 where
660 f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
661
662 test_split :: Assertion
663 test_split = do
664 split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")])
665 split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a")
666 split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
667 split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty)
668 split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty)
669
670 test_splitLookup :: Assertion
671 test_splitLookup = do
672 splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")])
673 splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a")
674 splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a")
675 splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty)
676 splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty)
677
678 ----------------------------------------------------------------
679 -- Submap
680
681 test_isSubmapOfBy :: Assertion
682 test_isSubmapOfBy = do
683 isSubmapOfBy (==) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
684 isSubmapOfBy (<=) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
685 isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
686 isSubmapOfBy (==) (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
687 isSubmapOfBy (<) (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
688 isSubmapOfBy (==) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False
689
690 test_isSubmapOf :: Assertion
691 test_isSubmapOf = do
692 isSubmapOf (fromList [(fromEnum 'a',1)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
693 isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= True
694 isSubmapOf (fromList [(fromEnum 'a',2)]) (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) @?= False
695 isSubmapOf (fromList [(fromEnum 'a',1),(fromEnum 'b',2)]) (fromList [(fromEnum 'a',1)]) @?= False
696
697 test_isProperSubmapOfBy :: Assertion
698 test_isProperSubmapOfBy = do
699 isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
700 isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
701 isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
702 isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
703 isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= False
704
705 test_isProperSubmapOf :: Assertion
706 test_isProperSubmapOf = do
707 isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
708 isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
709 isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
710
711 ----------------------------------------------------------------
712 -- Min/Max
713
714 test_lookupMin :: Assertion
715 test_lookupMin = do
716 lookupMin (fromList [(5,"a"), (3,"b")]) @?= Just (3,"b")
717 lookupMin (empty :: SMap) @?= Nothing
718
719 test_lookupMax :: Assertion
720 test_lookupMax = do
721 lookupMax (fromList [(5,"a"), (3,"b")]) @?= Just (5,"a")
722 lookupMax (empty :: SMap) @?= Nothing
723
724 test_findMin :: Assertion
725 test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
726
727 test_findMax :: Assertion
728 test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
729
730 test_deleteMin :: Assertion
731 test_deleteMin = do
732 deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
733 deleteMin (empty :: SMap) @?= empty
734
735 test_deleteMax :: Assertion
736 test_deleteMax = do
737 deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
738 deleteMax (empty :: SMap) @?= empty
739
740 test_deleteFindMin :: Assertion
741 test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
742
743 test_deleteFindMax :: Assertion
744 test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
745
746 test_updateMin :: Assertion
747 test_updateMin = do
748 updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
749 updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
750
751 test_updateMax :: Assertion
752 test_updateMax = do
753 updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
754 updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
755
756 test_updateMinWithKey :: Assertion
757 test_updateMinWithKey = do
758 updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
759 updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
760
761 test_updateMaxWithKey :: Assertion
762 test_updateMaxWithKey = do
763 updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
764 updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
765
766 test_minView :: Assertion
767 test_minView = do
768 minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a")
769 minView (empty :: SMap) @?= Nothing
770
771 test_maxView :: Assertion
772 test_maxView = do
773 maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b")
774 maxView (empty :: SMap) @?= Nothing
775
776 test_minViewWithKey :: Assertion
777 test_minViewWithKey = do
778 minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a")
779 minViewWithKey (empty :: SMap) @?= Nothing
780
781 test_maxViewWithKey :: Assertion
782 test_maxViewWithKey = do
783 maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b")
784 maxViewWithKey (empty :: SMap) @?= Nothing
785
786 ----------------------------------------------------------------
787 -- Valid IntMaps
788 ----------------------------------------------------------------
789
790 forValid :: Testable b => (SMap -> b) -> Property
791 forValid f = forAll arbitrary $ \t ->
792 classify (size t == 0) "empty" $
793 classify (size t > 0 && size t <= 10) "small" $
794 classify (size t > 10 && size t <= 64) "medium" $
795 classify (size t > 64) "large" $ f t
796
797 forValidUnitTree :: Testable b => (SMap -> b) -> Property
798 forValidUnitTree f = forValid f
799
800 prop_valid :: Property
801 prop_valid = forValidUnitTree $ \t -> valid t
802
803 ----------------------------------------------------------------
804 -- QuickCheck
805 ----------------------------------------------------------------
806
807 prop_emptyValid :: Property
808 prop_emptyValid = valid empty
809
810 prop_singleton :: Int -> Int -> Property
811 prop_singleton k x =
812 case singleton k x of
813 s ->
814 valid s .&&.
815 s === insert k x empty
816
817 prop_insertLookup :: Int -> UMap -> Bool
818 prop_insertLookup k t = lookup k (insert k () t) /= Nothing
819
820 prop_insertDelete :: Int -> UMap -> Property
821 prop_insertDelete k t =
822 lookup k t == Nothing ==>
823 case delete k (insert k () t) of
824 t' -> valid t' .&&. t' === t
825
826 prop_deleteNonMember :: Int -> UMap -> Property
827 prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t)
828
829 ----------------------------------------------------------------
830
831 prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Property
832 prop_unionModel xs ys =
833 case union (fromList xs) (fromList ys) of
834 t ->
835 valid t .&&.
836 sort (keys t) === sort (nub (Prelude.map fst xs ++ Prelude.map fst ys))
837
838 prop_unionSingleton :: IMap -> Int -> Int -> Bool
839 prop_unionSingleton t k x = union (singleton k x) t == insert k x t
840
841 prop_unionAssoc :: IMap -> IMap -> IMap -> Bool
842 prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
843
844 prop_unionWith :: IMap -> IMap -> Bool
845 prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1)
846
847 prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool
848 prop_unionSum xs ys
849 = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
850 == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
851
852 prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Property
853 prop_differenceModel xs ys =
854 case difference (fromListWith (+) xs) (fromListWith (+) ys) of
855 t ->
856 valid t .&&.
857 sort (keys t) === sort ((List.\\)
858 (nub (Prelude.map fst xs))
859 (nub (Prelude.map fst ys)))
860
861 prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Property
862 prop_intersectionModel xs ys =
863 case intersection (fromListWith (+) xs) (fromListWith (+) ys) of
864 t ->
865 valid t .&&.
866 sort (keys t) === sort (nub ((List.intersect)
867 (Prelude.map fst xs)
868 (Prelude.map fst ys)))
869
870 prop_intersectionWithModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
871 prop_intersectionWithModel xs ys
872 = toList (intersectionWith f (fromList xs') (fromList ys'))
873 == [(kx, f vx vy ) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
874 where xs' = List.nubBy ((==) `on` fst) xs
875 ys' = List.nubBy ((==) `on` fst) ys
876 f l r = l + 2 * r
877
878 prop_intersectionWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
879 prop_intersectionWithKeyModel xs ys
880 = toList (intersectionWithKey f (fromList xs') (fromList ys'))
881 == [(kx, f kx vx vy) | (kx, vx) <- List.sort xs', (ky, vy) <- ys', kx == ky]
882 where xs' = List.nubBy ((==) `on` fst) xs
883 ys' = List.nubBy ((==) `on` fst) ys
884 f k l r = k + 2 * l + 3 * r
885
886 -- TODO: the second argument should be simply an 'IntSet', but that
887 -- runs afoul of our orphan instance.
888 prop_restrictKeys :: IMap -> IMap -> Property
889 prop_restrictKeys m s0 =
890 m `restrictKeys` s === filterWithKey (\k _ -> k `IntSet.member` s) m
891 where
892 s = keysSet s0
893
894 -- TODO: the second argument should be simply an 'IntSet', but that
895 -- runs afoul of our orphan instance.
896 prop_withoutKeys :: IMap -> IMap -> Property
897 prop_withoutKeys m s0 =
898 m `withoutKeys` s === filterWithKey (\k _ -> k `IntSet.notMember` s) m
899 where
900 s = keysSet s0
901
902 prop_mergeWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
903 prop_mergeWithKeyModel xs ys
904 = and [ testMergeWithKey f keep_x keep_y
905 | f <- [ \_k x1 _x2 -> Just x1
906 , \_k _x1 x2 -> Just x2
907 , \_k _x1 _x2 -> Nothing
908 , \k x1 x2 -> if k `mod` 2 == 0 then Nothing else Just (2 * x1 + 3 * x2)
909 ]
910 , keep_x <- [ True, False ]
911 , keep_y <- [ True, False ]
912 ]
913
914 where xs' = List.nubBy ((==) `on` fst) xs
915 ys' = List.nubBy ((==) `on` fst) ys
916
917 xm = fromList xs'
918 ym = fromList ys'
919
920 testMergeWithKey f keep_x keep_y
921 = toList (mergeWithKey f (keep keep_x) (keep keep_y) xm ym) == emulateMergeWithKey f keep_x keep_y
922 where keep False _ = empty
923 keep True m = m
924
925 emulateMergeWithKey f keep_x keep_y
926 = Maybe.mapMaybe combine (sort $ List.union (List.map fst xs') (List.map fst ys'))
927 where combine k = case (List.lookup k xs', List.lookup k ys') of
928 (Nothing, Just y) -> if keep_y then Just (k, y) else Nothing
929 (Just x, Nothing) -> if keep_x then Just (k, x) else Nothing
930 (Just x, Just y) -> (\v -> (k, v)) `fmap` f k x y
931
932 -- We prevent inlining testMergeWithKey to disable the SpecConstr
933 -- optimalization. There are too many call patterns here so several
934 -- warnings are issued if testMergeWithKey gets inlined.
935 {-# NOINLINE testMergeWithKey #-}
936
937 ----------------------------------------------------------------
938
939 prop_ordered :: Property
940 prop_ordered
941 = forAll (choose (5,100)) $ \n ->
942 let xs = [(x,()) | x <- [0..n::Int]]
943 in fromAscList xs == fromList xs
944
945 prop_list :: [Int] -> Bool
946 prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
947
948 prop_descList :: [Int] -> Bool
949 prop_descList xs = (reverse (sort (nub xs)) == [x | (x,()) <- toDescList (fromList [(x,()) | x <- xs])])
950
951 prop_ascDescList :: [Int] -> Bool
952 prop_ascDescList xs = toAscList m == reverse (toDescList m)
953 where m = fromList $ zip xs $ repeat ()
954
955 prop_fromList :: [Int] -> Property
956 prop_fromList xs
957 = case fromList (zip xs xs) of
958 t -> valid t .&&.
959 t === fromAscList (zip sort_xs sort_xs) .&&.
960 t === fromDistinctAscList (zip nub_sort_xs nub_sort_xs) .&&.
961 t === List.foldr (uncurry insert) empty (zip xs xs)
962 where sort_xs = sort xs
963 nub_sort_xs = List.map List.head $ List.group sort_xs
964
965 ----------------------------------------------------------------
966
967 prop_alter :: UMap -> Int -> Property
968 prop_alter t k = valid t' .&&. case lookup k t of
969 Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
970 Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
971 where
972 t' = alter f k t
973 f Nothing = Just ()
974 f (Just ()) = Nothing
975
976 ------------------------------------------------------------------------
977 -- Compare against the list model (after nub on keys)
978
979 prop_index :: [Int] -> Property
980 prop_index xs = length xs > 0 ==>
981 let m = fromList (zip xs xs)
982 in xs == [ m ! i | i <- xs ]
983
984 prop_index_lookup :: [Int] -> Property
985 prop_index_lookup xs = length xs > 0 ==>
986 let m = fromList (zip xs xs)
987 in (Prelude.map Just xs) == [ m !? i | i <- xs ]
988
989 prop_null :: IMap -> Bool
990 prop_null m = null m == (size m == 0)
991
992 prop_size :: UMap -> Property
993 prop_size im = sz === foldl' (\i _ -> i + 1) (0 :: Int) im .&&.
994 sz === List.length (toList im)
995 where sz = size im
996
997 prop_member :: [Int] -> Int -> Bool
998 prop_member xs n =
999 let m = fromList (zip xs xs)
1000 in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
1001
1002 prop_notmember :: [Int] -> Int -> Bool
1003 prop_notmember xs n =
1004 let m = fromList (zip xs xs)
1005 in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
1006
1007 prop_lookup :: [(Int, Int)] -> Int -> Bool
1008 prop_lookup xs n =
1009 let xs' = List.nubBy ((==) `on` fst) xs
1010 m = fromList xs'
1011 in all (\k -> lookup k m == List.lookup k xs') (n : List.map fst xs')
1012
1013 prop_find :: [(Int, Int)] -> Bool
1014 prop_find xs =
1015 let xs' = List.nubBy ((==) `on` fst) xs
1016 m = fromList xs'
1017 in all (\(k, v) -> m ! k == v) xs'
1018
1019 prop_findWithDefault :: [(Int, Int)] -> Int -> Int -> Bool
1020 prop_findWithDefault xs n x =
1021 let xs' = List.nubBy ((==) `on` fst) xs
1022 m = fromList xs'
1023 in all (\k -> findWithDefault x k m == maybe x id (List.lookup k xs')) (n : List.map fst xs')
1024
1025 test_lookupSomething :: (Int -> IntMap Int -> Maybe (Int, Int)) -> (Int -> Int -> Bool) -> [(Int, Int)] -> Bool
1026 test_lookupSomething lookup' cmp xs =
1027 let odd_sorted_xs = filter_odd $ sort $ List.nubBy ((==) `on` fst) xs
1028 t = fromList odd_sorted_xs
1029 test k = case List.filter ((`cmp` k) . fst) odd_sorted_xs of
1030 [] -> lookup' k t == Nothing
1031 cs | 0 `cmp` 1 -> lookup' k t == Just (last cs) -- we want largest such element
1032 | otherwise -> lookup' k t == Just (head cs) -- we want smallest such element
1033 in all test (List.map fst xs)
1034
1035 where filter_odd [] = []
1036 filter_odd [_] = []
1037 filter_odd (_ : o : xs) = o : filter_odd xs
1038
1039 prop_lookupLT :: [(Int, Int)] -> Bool
1040 prop_lookupLT = test_lookupSomething lookupLT (<)
1041
1042 prop_lookupGT :: [(Int, Int)] -> Bool
1043 prop_lookupGT = test_lookupSomething lookupGT (>)
1044
1045 prop_lookupLE :: [(Int, Int)] -> Bool
1046 prop_lookupLE = test_lookupSomething lookupLE (<=)
1047
1048 prop_lookupGE :: [(Int, Int)] -> Bool
1049 prop_lookupGE = test_lookupSomething lookupGE (>=)
1050
1051 prop_lookupMin :: IntMap Int -> Property
1052 prop_lookupMin im = lookupMin im === listToMaybe (toAscList im)
1053
1054 prop_lookupMax :: IntMap Int -> Property
1055 prop_lookupMax im = lookupMax im === listToMaybe (toDescList im)
1056
1057 prop_findMin :: NonEmptyIntMap Int -> Property
1058 prop_findMin (NonEmptyIntMap im) = findMin im === head (toAscList im)
1059
1060 prop_findMax :: NonEmptyIntMap Int -> Property
1061 prop_findMax (NonEmptyIntMap im) = findMax im === head (toDescList im)
1062
1063 prop_deleteMinModel :: [(Int, Int)] -> Property
1064 prop_deleteMinModel ys = length ys > 0 ==>
1065 let xs = List.nubBy ((==) `on` fst) ys
1066 m = fromList xs
1067 in toAscList (deleteMin m) == tail (sort xs)
1068
1069 prop_deleteMaxModel :: [(Int, Int)] -> Property
1070 prop_deleteMaxModel ys = length ys > 0 ==>
1071 let xs = List.nubBy ((==) `on` fst) ys
1072 m = fromList xs
1073 in toAscList (deleteMax m) == init (sort xs)
1074
1075 prop_filter :: Fun Int Bool -> [(Int, Int)] -> Property
1076 prop_filter p ys = length ys > 0 ==>
1077 let xs = List.nubBy ((==) `on` fst) ys
1078 m = filter (apply p) (fromList xs)
1079 in valid m .&&.
1080 m === fromList (List.filter (apply p . snd) xs)
1081
1082 prop_partition :: Fun Int Bool -> [(Int, Int)] -> Property
1083 prop_partition p ys = length ys > 0 ==>
1084 let xs = List.nubBy ((==) `on` fst) ys
1085 m@(l, r) = partition (apply p) (fromList xs)
1086 in valid l .&&.
1087 valid r .&&.
1088 m === let (a,b) = (List.partition (apply p . snd) xs)
1089 in (fromList a, fromList b)
1090
1091 prop_map :: Fun Int Int -> [(Int, Int)] -> Property
1092 prop_map f ys = length ys > 0 ==>
1093 let xs = List.nubBy ((==) `on` fst) ys
1094 m = fromList xs
1095 in map (apply f) m == fromList [ (a, apply f b) | (a,b) <- xs ]
1096
1097 prop_fmap :: Fun Int Int -> [(Int, Int)] -> Property
1098 prop_fmap f ys = length ys > 0 ==>
1099 let xs = List.nubBy ((==) `on` fst) ys
1100 m = fromList xs
1101 in fmap (apply f) m == fromList [ (a, apply f b) | (a,b) <- xs ]
1102
1103 prop_mapkeys :: Fun Int Int -> [(Int, Int)] -> Property
1104 prop_mapkeys f ys = length ys > 0 ==>
1105 let xs = List.nubBy ((==) `on` fst) ys
1106 m = fromList xs
1107 in mapKeys (apply f) m == (fromList $ List.nubBy ((==) `on` fst) $ reverse [ (apply f a, b) | (a,b) <- sort xs])
1108
1109 prop_splitModel :: Int -> [(Int, Int)] -> Property
1110 prop_splitModel n ys = length ys > 0 ==>
1111 let xs = List.nubBy ((==) `on` fst) ys
1112 (l, r) = split n $ fromList xs
1113 in valid l .&&.
1114 valid r .&&.
1115 toAscList l === sort [(k, v) | (k,v) <- xs, k < n] .&&.
1116 toAscList r === sort [(k, v) | (k,v) <- xs, k > n]
1117
1118 prop_splitRoot :: IMap -> Bool
1119 prop_splitRoot s = loop ls && (s == unions ls)
1120 where
1121 ls = splitRoot s
1122 loop [] = True
1123 loop (s1:rst) = List.null
1124 [ (x,y) | x <- toList s1
1125 , y <- toList (unions rst)
1126 , x > y ]
1127
1128 prop_foldr :: Int -> [(Int, Int)] -> Property
1129 prop_foldr n ys = length ys > 0 ==>
1130 let xs = List.nubBy ((==) `on` fst) ys
1131 m = fromList xs
1132 in foldr (+) n m == List.foldr (+) n (List.map snd xs) &&
1133 foldr (:) [] m == List.map snd (List.sort xs) &&
1134 foldrWithKey (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1135 foldrWithKey (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1136 foldrWithKey (\k x xs -> (k,x):xs) [] m == List.sort xs
1137
1138
1139 prop_foldr' :: Int -> [(Int, Int)] -> Property
1140 prop_foldr' n ys = length ys > 0 ==>
1141 let xs = List.nubBy ((==) `on` fst) ys
1142 m = fromList xs
1143 in foldr' (+) n m == List.foldr (+) n (List.map snd xs) &&
1144 foldr' (:) [] m == List.map snd (List.sort xs) &&
1145 foldrWithKey' (\_ a b -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1146 foldrWithKey' (\k _ b -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1147 foldrWithKey' (\k x xs -> (k,x):xs) [] m == List.sort xs
1148
1149 prop_foldl :: Int -> [(Int, Int)] -> Property
1150 prop_foldl n ys = length ys > 0 ==>
1151 let xs = List.nubBy ((==) `on` fst) ys
1152 m = fromList xs
1153 in foldl (+) n m == List.foldr (+) n (List.map snd xs) &&
1154 foldl (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
1155 foldlWithKey (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1156 foldlWithKey (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1157 foldlWithKey (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
1158
1159 prop_foldl' :: Int -> [(Int, Int)] -> Property
1160 prop_foldl' n ys = length ys > 0 ==>
1161 let xs = List.nubBy ((==) `on` fst) ys
1162 m = fromList xs
1163 in foldl' (+) n m == List.foldr (+) n (List.map snd xs) &&
1164 foldl' (flip (:)) [] m == reverse (List.map snd (List.sort xs)) &&
1165 foldlWithKey' (\b _ a -> a + b) n m == List.foldr (+) n (List.map snd xs) &&
1166 foldlWithKey' (\b k _ -> k + b) n m == List.foldr (+) n (List.map fst xs) &&
1167 foldlWithKey' (\xs k x -> (k,x):xs) [] m == reverse (List.sort xs)
1168
1169 prop_foldrEqFoldMap :: IntMap Int -> Property
1170 prop_foldrEqFoldMap m =
1171 foldr (:) [] m === Data.Foldable.foldMap (:[]) m
1172
1173 prop_foldrWithKeyEqFoldMapWithKey :: IntMap Int -> Property
1174 prop_foldrWithKeyEqFoldMapWithKey m =
1175 foldrWithKey (\k v -> ((k,v):)) [] m === foldMapWithKey (\k v -> ([(k,v)])) m
1176
1177 prop_FoldableTraversableCompat :: Fun A [B] -> IntMap A -> Property
1178 prop_FoldableTraversableCompat fun m = foldMap f m === foldMapDefault f m
1179 where f = apply fun
1180
1181 prop_keysSet :: [(Int, Int)] -> Bool
1182 prop_keysSet xs =
1183 keysSet (fromList xs) == IntSet.fromList (List.map fst xs)
1184
1185 prop_fromSet :: [(Int, Int)] -> Bool
1186 prop_fromSet ys =
1187 let xs = List.nubBy ((==) `on` fst) ys
1188 in fromSet (\k -> fromJust $ List.lookup k xs) (IntSet.fromList $ List.map fst xs) == fromList xs