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