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