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