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