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