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