1
{-# LANGUAGE ScopedTypeVariables #-}
4
-- QuickCheck properties for Data.Map
5
-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. map-properties.hs
11
import Data.Maybe hiding (mapMaybe)
14
import Test.QuickCheck
15
import Text.Show.Functions
16
import Prelude hiding (lookup, null, map ,filter)
17
import qualified Prelude (map, filter)
18
import qualified Data.List as List
20
import Control.Applicative ((<$>),(<*>))
21
import Data.List (nub,sort)
22
import qualified Data.List as L ((\\),intersect)
23
import qualified Data.Set
24
-- import Data.SMap.Types
25
-- import Data.SMap.Balance
26
-- import Data.SMap.Internal
27
import Data.Maybe (isJust,fromJust)
28
import Prelude hiding (lookup,map,filter,null)
29
import qualified Prelude as P (map)
30
import Test.Framework (defaultMain, testGroup, Test)
31
import Test.Framework.Providers.HUnit
32
import Test.Framework.Providers.QuickCheck2
33
import Test.HUnit hiding (Test, Testable)
34
import Test.QuickCheck
37
q $ label "prop_Valid" prop_Valid
38
q $ label "prop_Single" prop_Single
39
q $ label "prop_InsertValid" prop_InsertValid
40
q $ label "prop_InsertDelete" prop_InsertDelete
41
q $ label "prop_DeleteValid" prop_DeleteValid
42
q $ label "prop_Join" prop_Join
43
q $ label "prop_Merge" prop_Merge
44
q $ label "prop_UnionValid" prop_UnionValid
45
q $ label "prop_UnionInsert" prop_UnionInsert
46
q $ label "prop_UnionAssoc" prop_UnionAssoc
47
q $ label "prop_UnionComm" prop_UnionComm
48
q $ label "prop_UnionWithValid" prop_UnionWithValid
49
q $ label "prop_UnionWith" prop_UnionWith
50
q $ label "prop_DiffValid" prop_DiffValid
51
q $ label "prop_Diff" prop_Diff
52
q $ label "prop_Diff2" prop_Diff2
53
q $ label "prop_IntValid" prop_IntValid
54
q $ label "prop_Int" prop_Int
55
q $ label "prop_Ordered" prop_Ordered
56
q $ label "prop_List" prop_List
59
q $ label "prop_index" prop_index
60
q $ label "prop_null" prop_null
61
q $ label "prop_member" prop_member
62
q $ label "prop_notmember" prop_notmember
63
q $ label "prop_findWithDefault" prop_findWithDefault
64
q $ label "prop_findIndex" prop_findIndex
65
q $ label "prop_findMin" prop_findMin
66
q $ label "prop_findMax" prop_findMax
67
q $ label "prop_filter" prop_filter
68
q $ label "prop_partition" prop_partition
69
q $ label "prop_map" prop_map
70
q $ label "prop_fmap" prop_fmap
71
-- q $ label "prop_mapkeys" prop_mapkeys
72
q $ label "prop_foldr" prop_foldr
73
q $ label "prop_foldl" prop_foldl
74
q $ label "prop_foldl'" prop_foldl'
75
q $ label "prop_fold" prop_fold
76
q $ label "prop_folWithKeyd" prop_foldWithKey
81
q :: Testable prop => prop -> IO ()
82
q = quickCheckWith args
85
{--------------------------------------------------------------------
87
--------------------------------------------------------------------}
88
testTree xs = fromList [(x,"*") | x <- xs]
89
test1 = testTree [1..20]
90
test2 = testTree [30,29..10]
91
test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
94
{--------------------------------------------------------------------
96
--------------------------------------------------------------------}
108
{ configMaxTest = 500
109
, configMaxFail = 5000
110
, configSize = \n -> (div n 2 + 3)
111
, configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
116
{--------------------------------------------------------------------
117
Arbitrary, reasonably balanced trees
118
--------------------------------------------------------------------}
119
instance (Enum k,Arbitrary a) => Arbitrary (Map k a) where
120
arbitrary = sized (arbtree 0 maxkey)
124
-- requires access to internals
126
arbtree :: (Enum k,Arbitrary a) => Int -> Int -> Int -> Gen (Map k a)
128
| n <= 0 = return Tip
129
| lo >= hi = return Tip
130
| otherwise = do{ x <- arbitrary
131
; i <- choose (lo,hi)
133
; let (ml,mr) | m==(1::Int)= (1,2)
137
; l <- arbtree lo (i-1) (n `div` ml)
138
; r <- arbtree (i+1) hi (n `div` mr)
139
; return (bin (toEnum i) x l r)
143
{--------------------------------------------------------------------
145
--------------------------------------------------------------------}
146
forValid :: (Show k,Enum k,Show a,Arbitrary a,Testable b) => (Map k a -> b) -> Property
148
= forAll arbitrary $ \t ->
149
-- classify (balanced t) "balanced" $
150
classify (size t == 0) "empty" $
151
classify (size t > 0 && size t <= 10) "small" $
152
classify (size t > 10 && size t <= 64) "medium" $
153
classify (size t > 64) "large" $
156
forValidIntTree :: Testable a => (Map Int Int -> a) -> Property
160
forValidUnitTree :: Testable a => (Map Int () -> a) -> Property
166
= forValidUnitTree $ \t -> valid t
168
{--------------------------------------------------------------------
169
Single, Insert, Delete
170
--------------------------------------------------------------------}
171
prop_Single :: Int -> Int -> Bool
173
= (insert k x empty == singleton k x)
175
prop_InsertValid :: Int -> Property
177
= forValidUnitTree $ \t -> valid (insert k () t)
179
prop_InsertDelete :: Int -> Map Int () -> Property
180
prop_InsertDelete k t
181
= (lookup k t == Nothing) ==> delete k (insert k () t) == t
183
prop_DeleteValid :: Int -> Property
185
= forValidUnitTree $ \t ->
186
valid (delete k (insert k () t))
188
{--------------------------------------------------------------------
190
--------------------------------------------------------------------}
191
prop_Join :: Int -> Property
193
= forValidUnitTree $ \t ->
194
let (l,r) = split k t
195
in valid (join k () l r)
197
prop_Merge :: Int -> Property
199
= forValidUnitTree $ \t ->
200
let (l,r) = split k t
204
{--------------------------------------------------------------------
206
--------------------------------------------------------------------}
207
prop_UnionValid :: Property
209
= forValidUnitTree $ \t1 ->
210
forValidUnitTree $ \t2 ->
213
prop_UnionInsert :: Int -> Int -> Map Int Int -> Bool
214
prop_UnionInsert k x t
215
= union (singleton k x) t == insert k x t
217
prop_UnionAssoc :: Map Int Int -> Map Int Int -> Map Int Int -> Bool
218
prop_UnionAssoc t1 t2 t3
219
= union t1 (union t2 t3) == union (union t1 t2) t3
221
prop_UnionComm :: Map Int Int -> Map Int Int -> Bool
223
= (union t1 t2 == unionWith (\x y -> y) t2 t1)
226
= forValidIntTree $ \t1 ->
227
forValidIntTree $ \t2 ->
228
valid (unionWithKey (\k x y -> x+y) t1 t2)
230
prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool
232
= sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
233
== (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
236
= forValidUnitTree $ \t1 ->
237
forValidUnitTree $ \t2 ->
238
valid (difference t1 t2)
240
prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool
242
= List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
243
== List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
245
prop_Diff2 :: [(Int,Int)] -> [(Int,Int)] -> Bool
247
= List.sort (keys ((\\) (fromListWith (+) xs) (fromListWith (+) ys)))
248
== List.sort ((List.\\) (List.nub (Prelude.map fst xs)) (List.nub (Prelude.map fst ys)))
251
= forValidUnitTree $ \t1 ->
252
forValidUnitTree $ \t2 ->
253
valid (intersection t1 t2)
255
prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool
257
= List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
258
== List.sort (List.nub ((List.intersect) (Prelude.map fst xs) (Prelude.map fst ys)))
260
{--------------------------------------------------------------------
262
--------------------------------------------------------------------}
264
= forAll (choose (5,100)) $ \n ->
265
let xs = [(x,()) | x <- [0..n::Int]]
266
in fromAscList xs == fromList xs
268
prop_List :: [Int] -> Bool
270
= (List.sort (List.nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
272
------------------------------------------------------------------------
273
-- New tests: compare against the list model (after nub on keys)
275
prop_index = \(xs :: [Int]) -> length xs > 0 ==>
276
let m = fromList (zip xs xs)
277
in xs == [ m ! i | i <- xs ]
279
prop_null (m :: Data.Map.Map Int Int) = Data.Map.null m == (size m == 0)
281
prop_member (xs :: [Int]) n =
282
let m = fromList (zip xs xs)
283
in (n `elem` xs) == (n `member` m)
285
prop_notmember (xs :: [Int]) n =
286
let m = fromList (zip xs xs)
287
in (n `notElem` xs) == (n `notMember` m)
289
prop_findWithDefault = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
291
xs = List.nubBy ((==) `on` fst) ys
293
and [ findWithDefault 0 i m == j | (i,j) <- xs ]
295
prop_findIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
297
in findIndex (fst (head ys)) m `seq` True
299
prop_lookupIndex = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
301
in isJust (lookupIndex (fst (head ys)) m)
303
prop_findMin = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
305
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
306
in findMin m == List.minimumBy (comparing fst) xs
308
prop_findMax = \(ys :: [(Int, Int)]) -> length ys > 0 ==>
310
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
311
in findMax m == List.maximumBy (comparing fst) xs
313
prop_filter = \p (ys :: [(Int, Int)]) -> length ys > 0 ==>
315
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
317
Data.Map.filter p m == fromList (List.filter (p . snd) xs)
319
prop_partition = \p (ys :: [(Int, Int)]) -> length ys > 0 ==>
321
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
323
Data.Map.partition p m == let (a,b) = (List.partition (p . snd) xs) in (fromList a, fromList b)
325
prop_map (f :: Int -> Int) (ys :: [(Int, Int)]) =
327
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
329
Data.Map.map f m == fromList [ (a, f b) | (a,b) <- xs ]
331
prop_fmap (f :: Int -> Int) (ys :: [(Int, Int)]) =
333
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
335
fmap f m == fromList [ (a, f b) | (a,b) <- xs ]
339
-- mapkeys is hard, as we have to consider collisions of the index space.
341
prop_mapkeys (f :: Int -> Int) (ys :: [(Int, Int)]) =
343
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
345
Data.Map.mapKeys f m ==
347
{-List.nubBy ((==) `on` fst) $ reverse-} [ (f a, b) | (a,b) <- xs ])
351
prop_foldr (n :: Int) (ys :: [(Int, Int)]) =
353
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
355
fold (+) n m == List.foldr (+) n (List.map snd xs)
357
fold k = Data.Map.foldrWithKey (\_ x' z' -> k x' z')
360
prop_foldl (n :: Int) (ys :: [(Int, Int)]) =
362
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
364
Data.Map.foldlWithKey (\a _ b -> a + b) n m == List.foldl (+) n (List.map snd xs)
367
prop_foldl' (n :: Int) (ys :: [(Int, Int)]) =
369
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
371
Data.Map.foldlWithKey' (\a _ b -> a + b) n m == List.foldl' (+) n (List.map snd xs)
374
prop_fold (n :: Int) (ys :: [(Int, Int)]) =
376
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
378
Data.Map.fold (+) n m == List.foldr (+) n (List.map snd xs)
380
prop_foldWithKey (n :: Int) (ys :: [(Int, Int)]) =
382
xs = List.nubBy ((==) `on` fst) (reverse ys) -- note.
384
Data.Map.foldWithKey (const (+)) n m == List.foldr (+) n (List.map snd xs)
386
------------------------------------------------------------------------
388
type UMap = Map Int ()
389
type IMap = Map Int Int
390
type SMap = Map Int String
392
----------------------------------------------------------------
395
tests = [ testGroup "Test Case" [
396
testCase "ticket4242" test_ticket4242
397
, testCase "index" test_index
398
, testCase "size" test_size
399
, testCase "size2" test_size2
400
, testCase "member" test_member
401
, testCase "notMember" test_notMember
402
, testCase "lookup" test_lookup
403
, testCase "findWithDefault" test_findWithDefault
404
, testCase "empty" test_empty
405
, testCase "mempty" test_mempty
406
, testCase "singleton" test_singleton
407
, testCase "insert" test_insert
408
, testCase "insertWith" test_insertWith
409
, testCase "insertWith'" test_insertWith'
410
, testCase "insertWithKey" test_insertWithKey
411
, testCase "insertWithKey'" test_insertWithKey'
412
, testCase "insertLookupWithKey" test_insertLookupWithKey
413
, testCase "insertLookupWithKey'" test_insertLookupWithKey'
414
, testCase "delete" test_delete
415
, testCase "adjust" test_adjust
416
, testCase "adjustWithKey" test_adjustWithKey
417
, testCase "update" test_update
418
, testCase "updateWithKey" test_updateWithKey
419
, testCase "updateLookupWithKey" test_updateLookupWithKey
420
, testCase "alter" test_alter
421
, testCase "union" test_union
422
, testCase "mappend" test_mappend
423
, testCase "unionWith" test_unionWith
424
, testCase "unionWithKey" test_unionWithKey
425
, testCase "unions" test_unions
426
, testCase "mconcat" test_mconcat
427
, testCase "unionsWith" test_unionsWith
428
, testCase "difference" test_difference
429
, testCase "differenceWith" test_differenceWith
430
, testCase "differenceWithKey" test_differenceWithKey
431
, testCase "intersection" test_intersection
432
, testCase "intersectionWith" test_intersectionWith
433
, testCase "intersectionWithKey" test_intersectionWithKey
434
, testCase "map" test_map
435
, testCase "mapWithKey" test_mapWithKey
436
, testCase "mapAccum" test_mapAccum
437
, testCase "mapAccumWithKey" test_mapAccumWithKey
438
, testCase "mapAccumRWithKey" test_mapAccumRWithKey
439
, testCase "mapKeys" test_mapKeys
440
, testCase "mapKeysWith" test_mapKeysWith
441
, testCase "mapKeysMonotonic" test_mapKeysMonotonic
442
, testCase "fold" test_fold
443
, testCase "foldWithKey" test_foldWithKey
444
, testCase "elems" test_elems
445
, testCase "keys" test_keys
446
, testCase "keysSet" test_keysSet
447
, testCase "associative" test_assocs
448
, testCase "toList" test_toList
449
, testCase "fromList" test_fromList
450
, testCase "fromListWith" test_fromListWith
451
, testCase "fromListWithKey" test_fromListWithKey
452
, testCase "toAscList" test_toAscList
453
, testCase "toDescList" test_toDescList
454
, testCase "showTree" test_showTree
455
, testCase "showTree'" test_showTree'
456
, testCase "fromAscList" test_fromAscList
457
, testCase "fromAscListWith" test_fromAscListWith
458
, testCase "fromAscListWithKey" test_fromAscListWithKey
459
, testCase "fromDistinctAscList" test_fromDistinctAscList
460
, testCase "filter" test_filter
461
, testCase "filterWithKey" test_filteWithKey
462
, testCase "partition" test_partition
463
, testCase "partitionWithKey" test_partitionWithKey
464
, testCase "mapMaybe" test_mapMaybe
465
, testCase "mapMaybeWithKey" test_mapMaybeWithKey
466
, testCase "mapEither" test_mapEither
467
, testCase "mapEitherWithKey" test_mapEitherWithKey
468
, testCase "split" test_split
469
, testCase "splitLookup" test_splitLookup
470
, testCase "isSubmapOfBy" test_isSubmapOfBy
471
, testCase "isSubmapOf" test_isSubmapOf
472
, testCase "isProperSubmapOfBy" test_isProperSubmapOfBy
473
, testCase "isProperSubmapOf" test_isProperSubmapOf
474
, testCase "lookupIndex" test_lookupIndex
475
, testCase "findIndex" test_findIndex
476
, testCase "elemAt" test_elemAt
477
, testCase "updateAt" test_updateAt
478
, testCase "deleteAt" test_deleteAt
479
, testCase "findMin" test_findMin
480
, testCase "findMax" test_findMax
481
, testCase "deleteMin" test_deleteMin
482
, testCase "deleteMax" test_deleteMax
483
, testCase "deleteFindMin" test_deleteFindMin
484
, testCase "deleteFindMax" test_deleteFindMax
485
, testCase "updateMin" test_updateMin
486
, testCase "updateMax" test_updateMax
487
, testCase "updateMinWithKey" test_updateMinWithKey
488
, testCase "updateMaxWithKey" test_updateMaxWithKey
489
, testCase "minView" test_minView
490
, testCase "maxView" test_maxView
491
, testCase "minViewWithKey" test_minViewWithKey
492
, testCase "maxViewWithKey" test_maxViewWithKey
493
, testCase "valid" test_valid
495
, testGroup "Property Test" [
496
-- testProperty "fromList" prop_fromList
497
testProperty "insert to singleton" prop_singleton
498
-- , testProperty "insert" prop_insert
499
, testProperty "insert then lookup" prop_lookup
500
-- , testProperty "insert then delete" prop_insertDelete
501
-- , testProperty "insert then delete2" prop_insertDelete2
502
, testProperty "delete non member" prop_deleteNonMember
503
-- , testProperty "deleteMin" prop_deleteMin
504
-- , testProperty "deleteMax" prop_deleteMax
505
, testProperty "split" prop_split
506
-- , testProperty "split then join" prop_join
507
-- , testProperty "split then merge" prop_merge
508
-- , testProperty "union" prop_union
509
, testProperty "union model" prop_unionModel
510
, testProperty "union singleton" prop_unionSingleton
511
, testProperty "union associative" prop_unionAssoc
512
, testProperty "fromAscList" prop_ordered
513
, testProperty "fromList then toList" prop_list
514
, testProperty "unionWith" prop_unionWith
515
-- , testProperty "unionWith2" prop_unionWith2
516
, testProperty "union sum" prop_unionSum
517
-- , testProperty "difference" prop_difference
518
, testProperty "difference model" prop_differenceModel
519
, testProperty "intersection" prop_intersection
520
, testProperty "intersection model" prop_intersectionModel
521
-- , testProperty "alter" prop_alter
526
----------------------------------------------------------------
528
----------------------------------------------------------------
530
test_ticket4242 :: Assertion
531
test_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [ (i, ()) | i <- [0,2,5,1,6,4,8,9,7,11,10,3] :: [Int] ]) @?= True
533
----------------------------------------------------------------
536
test_index :: Assertion
537
test_index = fromList [(5,'a'), (3,'b')] ! 5 @?= 'a'
539
----------------------------------------------------------------
542
test_size :: Assertion
544
null (empty) @?= True
545
null (singleton 1 'a') @?= False
547
test_size2 :: Assertion
550
size (singleton 1 'a') @?= 1
551
size (fromList([(1,'a'), (2,'c'), (3,'b')])) @?= 3
553
test_member :: Assertion
555
member 5 (fromList [(5,'a'), (3,'b')]) @?= True
556
member 1 (fromList [(5,'a'), (3,'b')]) @?= False
558
test_notMember :: Assertion
560
notMember 5 (fromList [(5,'a'), (3,'b')]) @?= False
561
notMember 1 (fromList [(5,'a'), (3,'b')]) @?= True
563
test_lookup :: Assertion
565
employeeCurrency "John" @?= Just "Euro"
566
employeeCurrency "Pete" @?= Nothing
568
employeeDept = fromList([("John","Sales"), ("Bob","IT")])
569
deptCountry = fromList([("IT","USA"), ("Sales","France")])
570
countryCurrency = fromList([("USA", "Dollar"), ("France", "Euro")])
571
employeeCurrency :: String -> Maybe String
572
employeeCurrency name = do
573
dept <- lookup name employeeDept
574
country <- lookup dept deptCountry
575
lookup country countryCurrency
577
test_findWithDefault :: Assertion
578
test_findWithDefault = do
579
findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) @?= 'x'
580
findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) @?= 'a'
582
----------------------------------------------------------------
585
test_empty :: Assertion
587
(empty :: UMap) @?= fromList []
590
test_mempty :: Assertion
592
(mempty :: UMap) @?= fromList []
593
size (mempty :: UMap) @?= 0
595
test_singleton :: Assertion
597
singleton 1 'a' @?= fromList [(1, 'a')]
598
size (singleton 1 'a') @?= 1
600
test_insert :: Assertion
602
insert 5 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'x')]
603
insert 7 'x' (fromList [(5,'a'), (3,'b')]) @?= fromList [(3, 'b'), (5, 'a'), (7, 'x')]
604
insert 5 'x' empty @?= singleton 5 'x'
606
test_insertWith :: Assertion
608
insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
609
insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
610
insertWith (++) 5 "xxx" empty @?= singleton 5 "xxx"
612
test_insertWith' :: Assertion
613
test_insertWith' = do
614
insertWith' (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "xxxa")]
615
insertWith' (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
616
insertWith' (++) 5 "xxx" empty @?= singleton 5 "xxx"
618
test_insertWithKey :: Assertion
619
test_insertWithKey = do
620
insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
621
insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
622
insertWithKey f 5 "xxx" empty @?= singleton 5 "xxx"
624
f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
626
test_insertWithKey' :: Assertion
627
test_insertWithKey' = do
628
insertWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:xxx|a")]
629
insertWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "xxx")]
630
insertWithKey' f 5 "xxx" empty @?= singleton 5 "xxx"
632
f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
634
test_insertLookupWithKey :: Assertion
635
test_insertLookupWithKey = do
636
insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
637
insertLookupWithKey f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
638
insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
639
insertLookupWithKey f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
641
f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
643
test_insertLookupWithKey' :: Assertion
644
test_insertLookupWithKey' = do
645
insertLookupWithKey' f 5 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])
646
insertLookupWithKey' f 2 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing,fromList [(2,"xxx"),(3,"b"),(5,"a")])
647
insertLookupWithKey' f 7 "xxx" (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a"), (7, "xxx")])
648
insertLookupWithKey' f 5 "xxx" empty @?= (Nothing, singleton 5 "xxx")
650
f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
652
----------------------------------------------------------------
655
test_delete :: Assertion
657
delete 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
658
delete 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
659
delete 5 empty @?= (empty :: IMap)
661
test_adjust :: Assertion
663
adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
664
adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
665
adjust ("new " ++) 7 empty @?= empty
667
test_adjustWithKey :: Assertion
668
test_adjustWithKey = do
669
adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
670
adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
671
adjustWithKey f 7 empty @?= empty
673
f key x = (show key) ++ ":new " ++ x
675
test_update :: Assertion
677
update f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "new a")]
678
update f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
679
update f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
681
f x = if x == "a" then Just "new a" else Nothing
683
test_updateWithKey :: Assertion
684
test_updateWithKey = do
685
updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "5:new a")]
686
updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
687
updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
689
f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
691
test_updateLookupWithKey :: Assertion
692
test_updateLookupWithKey = do
693
updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) @?= (Just "5:new a", fromList [(3, "b"), (5, "5:new a")])
694
updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) @?= (Nothing, fromList [(3, "b"), (5, "a")])
695
updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) @?= (Just "b", singleton 5 "a")
697
f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
699
test_alter :: Assertion
701
alter f 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a")]
702
alter f 5 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
703
alter g 7 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "a"), (7, "c")]
704
alter g 5 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "c")]
709
----------------------------------------------------------------
712
test_union :: Assertion
713
test_union = union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
715
test_mappend :: Assertion
716
test_mappend = mappend (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "a"), (7, "C")]
718
test_unionWith :: Assertion
719
test_unionWith = unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "aA"), (7, "C")]
721
test_unionWithKey :: Assertion
722
test_unionWithKey = unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
724
f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
726
test_unions :: Assertion
728
unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
729
@?= fromList [(3, "b"), (5, "a"), (7, "C")]
730
unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
731
@?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
733
test_mconcat :: Assertion
735
mconcat [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
736
@?= fromList [(3, "b"), (5, "a"), (7, "C")]
737
mconcat [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
738
@?= fromList [(3, "B3"), (5, "A3"), (7, "C")]
740
test_unionsWith :: Assertion
741
test_unionsWith = unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
742
@?= fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
744
test_difference :: Assertion
745
test_difference = difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 3 "b"
747
test_differenceWith :: Assertion
748
test_differenceWith = differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
749
@?= singleton 3 "b:B"
751
f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
753
test_differenceWithKey :: Assertion
754
test_differenceWithKey = differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
755
@?= singleton 3 "3:b|B"
757
f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
759
test_intersection :: Assertion
760
test_intersection = intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "a"
763
test_intersectionWith :: Assertion
764
test_intersectionWith = intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "aA"
766
test_intersectionWithKey :: Assertion
767
test_intersectionWithKey = intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) @?= singleton 5 "5:a|A"
769
f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
771
----------------------------------------------------------------
774
test_map :: Assertion
775
test_map = map (++ "x") (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "bx"), (5, "ax")]
777
test_mapWithKey :: Assertion
778
test_mapWithKey = mapWithKey f (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "3:b"), (5, "5:a")]
780
f key x = (show key) ++ ":" ++ x
782
test_mapAccum :: Assertion
783
test_mapAccum = mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) @?= ("Everything: ba", fromList [(3, "bX"), (5, "aX")])
785
f a b = (a ++ b, b ++ "X")
787
test_mapAccumWithKey :: Assertion
788
test_mapAccumWithKey = mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])
790
f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
792
test_mapAccumRWithKey :: Assertion
793
test_mapAccumRWithKey = mapAccumRWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) @?= ("Everything: 5-a 3-b", fromList [(3, "bX"), (5, "aX")])
795
f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")
797
test_mapKeys :: Assertion
799
mapKeys (+ 1) (fromList [(5,"a"), (3,"b")]) @?= fromList [(4, "b"), (6, "a")]
800
mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "c"
801
mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "c"
803
test_mapKeysWith :: Assertion
804
test_mapKeysWith = do
805
mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 1 "cdab"
806
mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) @?= singleton 3 "cdab"
808
test_mapKeysMonotonic :: Assertion
809
test_mapKeysMonotonic = do
810
mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) @?= fromList [(6, "b"), (10, "a")]
811
valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) @?= True
812
valid (mapKeysMonotonic (\ _ -> 1) (fromList [(5,"a"), (3,"b")])) @?= False
814
test_fold :: Assertion
815
test_fold = fold f 0 (fromList [(5,"a"), (3,"bbb")]) @?= 4
817
f a len = len + (length a)
819
test_foldWithKey :: Assertion
820
test_foldWithKey = foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) @?= "Map: (5:a)(3:b)"
822
f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
824
----------------------------------------------------------------
827
test_elems :: Assertion
829
elems (fromList [(5,"a"), (3,"b")]) @?= ["b","a"]
830
elems (empty :: UMap) @?= []
832
test_keys :: Assertion
834
keys (fromList [(5,"a"), (3,"b")]) @?= [3,5]
835
keys (empty :: UMap) @?= []
837
test_keysSet :: Assertion
839
keysSet (fromList [(5,"a"), (3,"b")]) @?= Data.Set.fromList [3,5]
840
keysSet (empty :: UMap) @?= Data.Set.empty
842
test_assocs :: Assertion
844
assocs (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
845
assocs (empty :: UMap) @?= []
847
----------------------------------------------------------------
850
test_toList :: Assertion
852
toList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
853
toList (empty :: SMap) @?= []
855
test_fromList :: Assertion
857
fromList [] @?= (empty :: SMap)
858
fromList [(5,"a"), (3,"b"), (5, "c")] @?= fromList [(5,"c"), (3,"b")]
859
fromList [(5,"c"), (3,"b"), (5, "a")] @?= fromList [(5,"a"), (3,"b")]
861
test_fromListWith :: Assertion
862
test_fromListWith = do
863
fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "ab"), (5, "aba")]
864
fromListWith (++) [] @?= (empty :: SMap)
866
test_fromListWithKey :: Assertion
867
test_fromListWithKey = do
868
fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] @?= fromList [(3, "3ab"), (5, "5a5ba")]
869
fromListWithKey f [] @?= (empty :: SMap)
871
f k a1 a2 = (show k) ++ a1 ++ a2
873
----------------------------------------------------------------
876
test_toAscList :: Assertion
877
test_toAscList = toAscList (fromList [(5,"a"), (3,"b")]) @?= [(3,"b"), (5,"a")]
879
test_toDescList :: Assertion
880
test_toDescList = toDescList (fromList [(5,"a"), (3,"b")]) @?= [(5,"a"), (3,"b")]
882
test_showTree :: Assertion
884
(let t = fromDistinctAscList [(x,()) | x <- [1..5]]
885
in showTree t) @?= "4:=()\n+--2:=()\n| +--1:=()\n| +--3:=()\n+--5:=()\n"
887
test_showTree' :: Assertion
889
(let t = fromDistinctAscList [(x,()) | x <- [1..5]]
890
in s t ) @?= "+--5:=()\n|\n4:=()\n|\n| +--3:=()\n| |\n+--2:=()\n |\n +--1:=()\n"
892
showElem k x = show k ++ ":=" ++ show x
894
s = showTreeWith showElem False True
897
test_fromAscList :: Assertion
898
test_fromAscList = do
899
fromAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
900
fromAscList [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "b")]
901
valid (fromAscList [(3,"b"), (5,"a"), (5,"b")]) @?= True
902
valid (fromAscList [(5,"a"), (3,"b"), (5,"b")]) @?= False
904
test_fromAscListWith :: Assertion
905
test_fromAscListWith = do
906
fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] @?= fromList [(3, "b"), (5, "ba")]
907
valid (fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")]) @?= True
908
valid (fromAscListWith (++) [(5,"a"), (3,"b"), (5,"b")]) @?= False
910
test_fromAscListWithKey :: Assertion
911
test_fromAscListWithKey = do
912
fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] @?= fromList [(3, "b"), (5, "5:b5:ba")]
913
valid (fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")]) @?= True
914
valid (fromAscListWithKey f [(5,"a"), (3,"b"), (5,"b"), (5,"b")]) @?= False
916
f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
918
test_fromDistinctAscList :: Assertion
919
test_fromDistinctAscList = do
920
fromDistinctAscList [(3,"b"), (5,"a")] @?= fromList [(3, "b"), (5, "a")]
921
valid (fromDistinctAscList [(3,"b"), (5,"a")]) @?= True
922
valid (fromDistinctAscList [(3,"b"), (5,"a"), (5,"b")]) @?= False
924
----------------------------------------------------------------
927
test_filter :: Assertion
929
filter (> "a") (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
930
filter (> "x") (fromList [(5,"a"), (3,"b")]) @?= empty
931
filter (< "a") (fromList [(5,"a"), (3,"b")]) @?= empty
933
test_filteWithKey :: Assertion
934
test_filteWithKey = filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
936
test_partition :: Assertion
938
partition (> "a") (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
939
partition (< "x") (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
940
partition (> "x") (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
942
test_partitionWithKey :: Assertion
943
test_partitionWithKey = do
944
partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) @?= (singleton 5 "a", singleton 3 "b")
945
partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3, "b"), (5, "a")], empty)
946
partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3, "b"), (5, "a")])
948
test_mapMaybe :: Assertion
949
test_mapMaybe = mapMaybe f (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "new a"
951
f x = if x == "a" then Just "new a" else Nothing
953
test_mapMaybeWithKey :: Assertion
954
test_mapMaybeWithKey = mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "key : 3"
956
f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
958
test_mapEither :: Assertion
960
mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
961
@?= (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
962
mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
963
@?= ((empty :: SMap), fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
965
f a = if a < "c" then Left a else Right a
967
test_mapEitherWithKey :: Assertion
968
test_mapEitherWithKey = do
969
mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
970
@?= (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
971
mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
972
@?= ((empty :: SMap), fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
974
f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
976
test_split :: Assertion
978
split 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, fromList [(3,"b"), (5,"a")])
979
split 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, singleton 5 "a")
980
split 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", singleton 5 "a")
981
split 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", empty)
982
split 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], empty)
984
test_splitLookup :: Assertion
985
test_splitLookup = do
986
splitLookup 2 (fromList [(5,"a"), (3,"b")]) @?= (empty, Nothing, fromList [(3,"b"), (5,"a")])
987
splitLookup 3 (fromList [(5,"a"), (3,"b")]) @?= (empty, Just "b", singleton 5 "a")
988
splitLookup 4 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Nothing, singleton 5 "a")
989
splitLookup 5 (fromList [(5,"a"), (3,"b")]) @?= (singleton 3 "b", Just "a", empty)
990
splitLookup 6 (fromList [(5,"a"), (3,"b")]) @?= (fromList [(3,"b"), (5,"a")], Nothing, empty)
992
----------------------------------------------------------------
995
test_isSubmapOfBy :: Assertion
996
test_isSubmapOfBy = do
997
isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
998
isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
999
isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) @?= True
1000
isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)]) @?= False
1001
isSubmapOfBy (<) (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= False
1002
isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)]) @?= False
1004
test_isSubmapOf :: Assertion
1005
test_isSubmapOf = do
1006
isSubmapOf (fromList [('a',1)]) (fromList [('a',1),('b',2)]) @?= True
1007
isSubmapOf (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)]) @?= True
1008
isSubmapOf (fromList [('a',2)]) (fromList [('a',1),('b',2)]) @?= False
1009
isSubmapOf (fromList [('a',1),('b',2)]) (fromList [('a',1)]) @?= False
1011
test_isProperSubmapOfBy :: Assertion
1012
test_isProperSubmapOfBy = do
1013
isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
1014
isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
1015
isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
1016
isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
1017
isProperSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= False
1019
test_isProperSubmapOf :: Assertion
1020
test_isProperSubmapOf = do
1021
isProperSubmapOf (fromList [(1,1)]) (fromList [(1,1),(2,2)]) @?= True
1022
isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)]) @?= False
1023
isProperSubmapOf (fromList [(1,1),(2,2)]) (fromList [(1,1)]) @?= False
1025
----------------------------------------------------------------
1028
test_lookupIndex :: Assertion
1029
test_lookupIndex = do
1030
isJust (lookupIndex 2 (fromList [(5,"a"), (3,"b")])) @?= False
1031
fromJust (lookupIndex 3 (fromList [(5,"a"), (3,"b")])) @?= 0
1032
fromJust (lookupIndex 5 (fromList [(5,"a"), (3,"b")])) @?= 1
1033
isJust (lookupIndex 6 (fromList [(5,"a"), (3,"b")])) @?= False
1035
test_findIndex :: Assertion
1037
findIndex 3 (fromList [(5,"a"), (3,"b")]) @?= 0
1038
findIndex 5 (fromList [(5,"a"), (3,"b")]) @?= 1
1040
test_elemAt :: Assertion
1042
elemAt 0 (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
1043
elemAt 1 (fromList [(5,"a"), (3,"b")]) @?= (5, "a")
1045
test_updateAt :: Assertion
1047
updateAt (\ _ _ -> Just "x") 0 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "x"), (5, "a")]
1048
updateAt (\ _ _ -> Just "x") 1 (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "x")]
1049
updateAt (\_ _ -> Nothing) 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1050
updateAt (\_ _ -> Nothing) 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1051
-- updateAt (\_ _ -> Nothing) 7 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1053
test_deleteAt :: Assertion
1055
deleteAt 0 (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1056
deleteAt 1 (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1058
----------------------------------------------------------------
1061
test_findMin :: Assertion
1062
test_findMin = findMin (fromList [(5,"a"), (3,"b")]) @?= (3,"b")
1064
test_findMax :: Assertion
1065
test_findMax = findMax (fromList [(5,"a"), (3,"b")]) @?= (5,"a")
1067
test_deleteMin :: Assertion
1069
deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(5,"a"), (7,"c")]
1070
deleteMin (empty :: SMap) @?= empty
1072
test_deleteMax :: Assertion
1074
deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) @?= fromList [(3,"b"), (5,"a")]
1075
deleteMax (empty :: SMap) @?= empty
1077
test_deleteFindMin :: Assertion
1078
test_deleteFindMin = deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((3,"b"), fromList[(5,"a"), (10,"c")])
1080
test_deleteFindMax :: Assertion
1081
test_deleteFindMax = deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) @?= ((10,"c"), fromList [(3,"b"), (5,"a")])
1083
test_updateMin :: Assertion
1085
updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "Xb"), (5, "a")]
1086
updateMin (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1088
test_updateMax :: Assertion
1090
updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3, "b"), (5, "Xa")]
1091
updateMax (\ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1093
test_updateMinWithKey :: Assertion
1094
test_updateMinWithKey = do
1095
updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"3:b"), (5,"a")]
1096
updateMinWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 5 "a"
1098
test_updateMaxWithKey :: Assertion
1099
test_updateMaxWithKey = do
1100
updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) @?= fromList [(3,"b"), (5,"5:a")]
1101
updateMaxWithKey (\ _ _ -> Nothing) (fromList [(5,"a"), (3,"b")]) @?= singleton 3 "b"
1103
test_minView :: Assertion
1105
minView (fromList [(5,"a"), (3,"b")]) @?= Just ("b", singleton 5 "a")
1106
minView (empty :: SMap) @?= Nothing
1108
test_maxView :: Assertion
1110
maxView (fromList [(5,"a"), (3,"b")]) @?= Just ("a", singleton 3 "b")
1111
maxView (empty :: SMap) @?= Nothing
1113
test_minViewWithKey :: Assertion
1114
test_minViewWithKey = do
1115
minViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((3,"b"), singleton 5 "a")
1116
minViewWithKey (empty :: SMap) @?= Nothing
1118
test_maxViewWithKey :: Assertion
1119
test_maxViewWithKey = do
1120
maxViewWithKey (fromList [(5,"a"), (3,"b")]) @?= Just ((5,"a"), singleton 3 "b")
1121
maxViewWithKey (empty :: SMap) @?= Nothing
1123
----------------------------------------------------------------
1126
test_valid :: Assertion
1128
valid (fromAscList [(3,"b"), (5,"a")]) @?= True
1129
valid (fromAscList [(5,"a"), (3,"b")]) @?= False
1131
----------------------------------------------------------------
1133
----------------------------------------------------------------
1135
prop_fromList :: UMap -> Bool
1136
prop_fromList t = valid t
1138
prop_singleton :: Int -> Int -> Bool
1139
prop_singleton k x = insert k x empty == singleton k x
1141
prop_insert :: Int -> UMap -> Bool
1142
prop_insert k t = valid $ insert k () t
1144
prop_lookup :: Int -> UMap -> Bool
1145
prop_lookup k t = lookup k (insert k () t) /= Nothing
1147
prop_insertDelete :: Int -> UMap -> Bool
1148
prop_insertDelete k t = valid $ delete k (insert k () t)
1150
prop_insertDelete2 :: Int -> UMap -> Property
1151
prop_insertDelete2 k t = (lookup k t == Nothing) ==> (delete k (insert k () t) == t)
1153
prop_deleteNonMember :: Int -> UMap -> Property
1154
prop_deleteNonMember k t = (lookup k t == Nothing) ==> (delete k t == t)
1156
prop_deleteMin :: UMap -> Bool
1157
prop_deleteMin t = valid $ deleteMin $ deleteMin t
1159
prop_deleteMax :: UMap -> Bool
1160
prop_deleteMax t = valid $ deleteMax $ deleteMax t
1162
----------------------------------------------------------------
1164
prop_split :: Int -> UMap -> Property
1165
prop_split k t = (lookup k t /= Nothing) ==> let (r,l) = split k t
1166
in (valid r, valid l) == (True, True)
1168
prop_join :: Int -> UMap -> Bool
1169
prop_join k t = let (l,r) = split k t
1170
in valid (join k () l r)
1172
prop_merge :: Int -> UMap -> Bool
1173
prop_merge k t = let (l,r) = split k t
1174
in valid (merge l r)
1176
----------------------------------------------------------------
1178
prop_union :: UMap -> UMap -> Bool
1179
prop_union t1 t2 = valid (union t1 t2)
1181
prop_unionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
1182
prop_unionModel xs ys
1183
= sort (keys (union (fromList xs) (fromList ys)))
1184
== sort (nub (P.map fst xs ++ P.map fst ys))
1186
prop_unionSingleton :: IMap -> Int -> Int -> Bool
1187
prop_unionSingleton t k x = union (singleton k x) t == insert k x t
1189
prop_unionAssoc :: IMap -> IMap -> IMap -> Bool
1190
prop_unionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3
1192
prop_unionWith :: IMap -> IMap -> Bool
1193
prop_unionWith t1 t2 = (union t1 t2 == unionWith (\_ y -> y) t2 t1)
1195
prop_unionWith2 :: IMap -> IMap -> Bool
1196
prop_unionWith2 t1 t2 = valid (unionWithKey (\_ x y -> x+y) t1 t2)
1198
prop_unionSum :: [(Int,Int)] -> [(Int,Int)] -> Bool
1200
= sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys)))
1201
== (sum (P.map snd xs) + sum (P.map snd ys))
1203
prop_difference :: IMap -> IMap -> Bool
1204
prop_difference t1 t2 = valid (difference t1 t2)
1206
prop_differenceModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
1207
prop_differenceModel xs ys
1208
= sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys)))
1209
== sort ((L.\\) (nub (P.map fst xs)) (nub (P.map fst ys)))
1211
prop_intersection :: IMap -> IMap -> Bool
1212
prop_intersection t1 t2 = valid (intersection t1 t2)
1214
prop_intersectionModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
1215
prop_intersectionModel xs ys
1216
= sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys)))
1217
== sort (nub ((L.intersect) (P.map fst xs) (P.map fst ys)))
1219
----------------------------------------------------------------
1221
prop_ordered :: Property
1223
= forAll (choose (5,100)) $ \n ->
1224
let xs = [(x,()) | x <- [0..n::Int]]
1225
in fromAscList xs == fromList xs
1227
prop_list :: [Int] -> Bool
1228
prop_list xs = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
1230
----------------------------------------------------------------
1232
prop_alter :: UMap -> Int -> Bool
1233
prop_alter t k = balanced t' && case lookup k t of
1234
Just _ -> (size t - 1) == size t' && lookup k t' == Nothing
1235
Nothing -> (size t + 1) == size t' && lookup k t' /= Nothing
1239
f (Just ()) = Nothing
added
removed
libraries/containers/tests/map-properties.hs
