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