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