e76cbc6e0ef9dc3b6dc8baed30888d35bd638e64
[packages/containers.git] / tests / seq-properties.hs
1 import Data.Sequence -- needs to be compiled with -DTESTING for use here
2
3 import Control.Applicative (Applicative(..))
4 import Control.Arrow ((***))
5 import Control.Monad.Trans.State.Strict
6 import Data.Array (listArray)
7 import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, fold), toList, all, sum)
8 import Data.Functor ((<$>), (<$))
9 import Data.Maybe
10 import Data.Monoid (Monoid(..), All(..), Endo(..), Dual(..))
11 import Data.Traversable (Traversable(traverse), sequenceA)
12 import Prelude hiding (
13 lookup, null, length, take, drop, splitAt,
14 foldl, foldl1, foldr, foldr1, scanl, scanl1, scanr, scanr1,
15 filter, reverse, replicate, zip, zipWith, zip3, zipWith3,
16 all, sum)
17 import qualified Prelude
18 import qualified Data.List
19 import Test.QuickCheck hiding ((><))
20 import Test.QuickCheck.Poly
21 import Test.QuickCheck.Function
22 import Test.Framework
23 import Test.Framework.Providers.QuickCheck2
24
25
26 main :: IO ()
27 main = defaultMain
28 [ testProperty "fmap" prop_fmap
29 , testProperty "(<$)" prop_constmap
30 , testProperty "foldr" prop_foldr
31 , testProperty "foldr1" prop_foldr1
32 , testProperty "foldl" prop_foldl
33 , testProperty "foldl1" prop_foldl1
34 , testProperty "(==)" prop_equals
35 , testProperty "compare" prop_compare
36 , testProperty "mappend" prop_mappend
37 , testProperty "singleton" prop_singleton
38 , testProperty "(<|)" prop_cons
39 , testProperty "(|>)" prop_snoc
40 , testProperty "(><)" prop_append
41 , testProperty "fromList" prop_fromList
42 , testProperty "fromFunction" prop_fromFunction
43 , testProperty "fromArray" prop_fromArray
44 , testProperty "replicate" prop_replicate
45 , testProperty "replicateA" prop_replicateA
46 , testProperty "replicateM" prop_replicateM
47 , testProperty "iterateN" prop_iterateN
48 , testProperty "unfoldr" prop_unfoldr
49 , testProperty "unfoldl" prop_unfoldl
50 , testProperty "null" prop_null
51 , testProperty "length" prop_length
52 , testProperty "viewl" prop_viewl
53 , testProperty "viewr" prop_viewr
54 , testProperty "scanl" prop_scanl
55 , testProperty "scanl1" prop_scanl1
56 , testProperty "scanr" prop_scanr
57 , testProperty "scanr1" prop_scanr1
58 , testProperty "tails" prop_tails
59 , testProperty "inits" prop_inits
60 , testProperty "takeWhileL" prop_takeWhileL
61 , testProperty "takeWhileR" prop_takeWhileR
62 , testProperty "dropWhileL" prop_dropWhileL
63 , testProperty "dropWhileR" prop_dropWhileR
64 , testProperty "spanl" prop_spanl
65 , testProperty "spanr" prop_spanr
66 , testProperty "breakl" prop_breakl
67 , testProperty "breakr" prop_breakr
68 , testProperty "partition" prop_partition
69 , testProperty "filter" prop_filter
70 , testProperty "sort" prop_sort
71 , testProperty "sortBy" prop_sortBy
72 , testProperty "unstableSort" prop_unstableSort
73 , testProperty "unstableSortBy" prop_unstableSortBy
74 , testProperty "index" prop_index
75 , testProperty "(!?)" prop_safeIndex
76 , testProperty "adjust" prop_adjust
77 , testProperty "insertAt" prop_insertAt
78 , testProperty "deleteAt" prop_deleteAt
79 , testProperty "update" prop_update
80 , testProperty "take" prop_take
81 , testProperty "drop" prop_drop
82 , testProperty "splitAt" prop_splitAt
83 , testProperty "chunksOf" prop_chunksOf
84 , testProperty "elemIndexL" prop_elemIndexL
85 , testProperty "elemIndicesL" prop_elemIndicesL
86 , testProperty "elemIndexR" prop_elemIndexR
87 , testProperty "elemIndicesR" prop_elemIndicesR
88 , testProperty "findIndexL" prop_findIndexL
89 , testProperty "findIndicesL" prop_findIndicesL
90 , testProperty "findIndexR" prop_findIndexR
91 , testProperty "findIndicesR" prop_findIndicesR
92 , testProperty "foldlWithIndex" prop_foldlWithIndex
93 , testProperty "foldrWithIndex" prop_foldrWithIndex
94 , testProperty "mapWithIndex" prop_mapWithIndex
95 , testProperty "foldMapWithIndex/foldlWithIndex" prop_foldMapWithIndexL
96 , testProperty "foldMapWithIndex/foldrWithIndex" prop_foldMapWithIndexR
97 , testProperty "traverseWithIndex" prop_traverseWithIndex
98 , testProperty "reverse" prop_reverse
99 , testProperty "zip" prop_zip
100 , testProperty "zipWith" prop_zipWith
101 , testProperty "zip3" prop_zip3
102 , testProperty "zipWith3" prop_zipWith3
103 , testProperty "zip4" prop_zip4
104 , testProperty "zipWith4" prop_zipWith4
105 , testProperty "<*>" prop_ap
106 , testProperty "*>" prop_then
107 , testProperty "cycleTaking" prop_cycleTaking
108 , testProperty "intersperse" prop_intersperse
109 , testProperty ">>=" prop_bind
110 ]
111
112 ------------------------------------------------------------------------
113 -- Arbitrary
114 ------------------------------------------------------------------------
115
116 instance Arbitrary a => Arbitrary (Seq a) where
117 arbitrary = Seq <$> arbitrary
118 shrink (Seq x) = map Seq (shrink x)
119
120 instance Arbitrary a => Arbitrary (Elem a) where
121 arbitrary = Elem <$> arbitrary
122
123 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
124 arbitrary = sized arb
125 where
126 arb :: (Arbitrary b, Sized b) => Int -> Gen (FingerTree b)
127 arb 0 = return EmptyT
128 arb 1 = Single <$> arbitrary
129 arb n = do
130 pr <- arbitrary
131 sf <- arbitrary
132 let n_pr = Prelude.length (toList pr)
133 let n_sf = Prelude.length (toList sf)
134 -- adding n `div` 7 ensures that n_m >= 0, and makes more Singles
135 let n_m = max (n `div` 7) ((n - n_pr - n_sf) `div` 3)
136 m <- arb n_m
137 return $ deep pr m sf
138
139 shrink (Deep _ (One a) EmptyT (One b)) = [Single a, Single b]
140 shrink (Deep _ pr m sf) =
141 [deep pr' m sf | pr' <- shrink pr] ++
142 [deep pr m' sf | m' <- shrink m] ++
143 [deep pr m sf' | sf' <- shrink sf]
144 shrink (Single x) = map Single (shrink x)
145 shrink EmptyT = []
146
147 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
148 arbitrary = oneof [
149 node2 <$> arbitrary <*> arbitrary,
150 node3 <$> arbitrary <*> arbitrary <*> arbitrary]
151
152 shrink (Node2 _ a b) =
153 [node2 a' b | a' <- shrink a] ++
154 [node2 a b' | b' <- shrink b]
155 shrink (Node3 _ a b c) =
156 [node2 a b, node2 a c, node2 b c] ++
157 [node3 a' b c | a' <- shrink a] ++
158 [node3 a b' c | b' <- shrink b] ++
159 [node3 a b c' | c' <- shrink c]
160
161 instance Arbitrary a => Arbitrary (Digit a) where
162 arbitrary = oneof [
163 One <$> arbitrary,
164 Two <$> arbitrary <*> arbitrary,
165 Three <$> arbitrary <*> arbitrary <*> arbitrary,
166 Four <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary]
167
168 shrink (One a) = map One (shrink a)
169 shrink (Two a b) = [One a, One b]
170 shrink (Three a b c) = [Two a b, Two a c, Two b c]
171 shrink (Four a b c d) = [Three a b c, Three a b d, Three a c d, Three b c d]
172
173 ------------------------------------------------------------------------
174 -- Valid trees
175 ------------------------------------------------------------------------
176
177 class Valid a where
178 valid :: a -> Bool
179
180 instance Valid (Elem a) where
181 valid _ = True
182
183 instance Valid (Seq a) where
184 valid (Seq xs) = valid xs
185
186 instance (Sized a, Valid a) => Valid (FingerTree a) where
187 valid EmptyT = True
188 valid (Single x) = valid x
189 valid (Deep s pr m sf) =
190 s == size pr + size m + size sf && valid pr && valid m && valid sf
191
192 instance (Sized a, Valid a) => Valid (Node a) where
193 valid node = size node == sum (fmap size node) && all valid node
194
195 instance Valid a => Valid (Digit a) where
196 valid = all valid
197
198 {--------------------------------------------------------------------
199 The general plan is to compare each function with a list equivalent.
200 Each operation should produce a valid tree representing the same
201 sequence as produced by its list counterpart on corresponding inputs.
202 (The list versions are often lazier, but these properties ignore
203 strictness.)
204 --------------------------------------------------------------------}
205
206 -- utilities for partial conversions
207
208 infix 4 ~=
209
210 (~=) :: Eq a => Maybe a -> a -> Bool
211 (~=) = maybe (const False) (==)
212
213 -- Partial conversion of an output sequence to a list.
214 toList' :: Seq a -> Maybe [a]
215 toList' xs
216 | valid xs = Just (toList xs)
217 | otherwise = Nothing
218
219 toListList' :: Seq (Seq a) -> Maybe [[a]]
220 toListList' xss = toList' xss >>= mapM toList'
221
222 toListPair' :: (Seq a, Seq b) -> Maybe ([a], [b])
223 toListPair' (xs, ys) = (,) <$> toList' xs <*> toList' ys
224
225 -- instances
226
227 prop_fmap :: Seq Int -> Bool
228 prop_fmap xs =
229 toList' (fmap f xs) ~= map f (toList xs)
230 where f = (+100)
231
232 prop_constmap :: A -> Seq A -> Bool
233 prop_constmap x xs =
234 toList' (x <$ xs) ~= map (const x) (toList xs)
235
236 prop_foldr :: Seq A -> Bool
237 prop_foldr xs =
238 foldr f z xs == Prelude.foldr f z (toList xs)
239 where
240 f = (:)
241 z = []
242
243 prop_foldr1 :: Seq Int -> Property
244 prop_foldr1 xs =
245 not (null xs) ==> foldr1 f xs == Data.List.foldr1 f (toList xs)
246 where f = (-)
247
248 prop_foldl :: Seq A -> Bool
249 prop_foldl xs =
250 foldl f z xs == Prelude.foldl f z (toList xs)
251 where
252 f = flip (:)
253 z = []
254
255 prop_foldl1 :: Seq Int -> Property
256 prop_foldl1 xs =
257 not (null xs) ==> foldl1 f xs == Data.List.foldl1 f (toList xs)
258 where f = (-)
259
260 prop_equals :: Seq OrdA -> Seq OrdA -> Bool
261 prop_equals xs ys =
262 (xs == ys) == (toList xs == toList ys)
263
264 prop_compare :: Seq OrdA -> Seq OrdA -> Bool
265 prop_compare xs ys =
266 compare xs ys == compare (toList xs) (toList ys)
267
268 prop_mappend :: Seq A -> Seq A -> Bool
269 prop_mappend xs ys =
270 toList' (mappend xs ys) ~= toList xs ++ toList ys
271
272 -- * Construction
273
274 {-
275 toList' empty ~= []
276 -}
277
278 prop_singleton :: A -> Bool
279 prop_singleton x =
280 toList' (singleton x) ~= [x]
281
282 prop_cons :: A -> Seq A -> Bool
283 prop_cons x xs =
284 toList' (x <| xs) ~= x : toList xs
285
286 prop_snoc :: Seq A -> A -> Bool
287 prop_snoc xs x =
288 toList' (xs |> x) ~= toList xs ++ [x]
289
290 prop_append :: Seq A -> Seq A -> Bool
291 prop_append xs ys =
292 toList' (xs >< ys) ~= toList xs ++ toList ys
293
294 prop_fromList :: [A] -> Bool
295 prop_fromList xs =
296 toList' (fromList xs) ~= xs
297
298 prop_fromFunction :: [A] -> Bool
299 prop_fromFunction xs =
300 toList' (fromFunction (Prelude.length xs) (xs!!)) ~= xs
301
302 prop_fromArray :: [A] -> Bool
303 prop_fromArray xs =
304 toList' (fromArray (listArray (42, 42+Prelude.length xs-1) xs)) ~= xs
305
306 -- ** Repetition
307
308 prop_replicate :: NonNegative Int -> A -> Bool
309 prop_replicate (NonNegative m) x =
310 toList' (replicate n x) ~= Prelude.replicate n x
311 where n = m `mod` 10000
312
313 prop_replicateA :: NonNegative Int -> Bool
314 prop_replicateA (NonNegative m) =
315 traverse toList' (replicateA n a) ~= sequenceA (Prelude.replicate n a)
316 where
317 n = m `mod` 10000
318 a = Action 1 0 :: M Int
319
320 prop_replicateM :: NonNegative Int -> Bool
321 prop_replicateM (NonNegative m) =
322 traverse toList' (replicateM n a) ~= sequence (Prelude.replicate n a)
323 where
324 n = m `mod` 10000
325 a = Action 1 0 :: M Int
326
327 -- ** Iterative construction
328
329 prop_iterateN :: NonNegative Int -> Int -> Bool
330 prop_iterateN (NonNegative m) x =
331 toList' (iterateN n f x) ~= Prelude.take n (Prelude.iterate f x)
332 where
333 n = m `mod` 10000
334 f = (+1)
335
336 prop_unfoldr :: [A] -> Bool
337 prop_unfoldr z =
338 toList' (unfoldr f z) ~= Data.List.unfoldr f z
339 where
340 f [] = Nothing
341 f (x:xs) = Just (x, xs)
342
343 prop_unfoldl :: [A] -> Bool
344 prop_unfoldl z =
345 toList' (unfoldl f z) ~= Data.List.reverse (Data.List.unfoldr (fmap swap . f) z)
346 where
347 f [] = Nothing
348 f (x:xs) = Just (xs, x)
349 swap (x,y) = (y,x)
350
351 -- * Deconstruction
352
353 -- ** Queries
354
355 prop_null :: Seq A -> Bool
356 prop_null xs =
357 null xs == Prelude.null (toList xs)
358
359 prop_length :: Seq A -> Bool
360 prop_length xs =
361 length xs == Prelude.length (toList xs)
362
363 -- ** Views
364
365 prop_viewl :: Seq A -> Bool
366 prop_viewl xs =
367 case viewl xs of
368 EmptyL -> Prelude.null (toList xs)
369 x :< xs' -> valid xs' && toList xs == x : toList xs'
370
371 prop_viewr :: Seq A -> Bool
372 prop_viewr xs =
373 case viewr xs of
374 EmptyR -> Prelude.null (toList xs)
375 xs' :> x -> valid xs' && toList xs == toList xs' ++ [x]
376
377 -- * Scans
378
379 prop_scanl :: [A] -> Seq A -> Bool
380 prop_scanl z xs =
381 toList' (scanl f z xs) ~= Data.List.scanl f z (toList xs)
382 where f = flip (:)
383
384 prop_scanl1 :: Seq Int -> Property
385 prop_scanl1 xs =
386 not (null xs) ==> toList' (scanl1 f xs) ~= Data.List.scanl1 f (toList xs)
387 where f = (-)
388
389 prop_scanr :: [A] -> Seq A -> Bool
390 prop_scanr z xs =
391 toList' (scanr f z xs) ~= Data.List.scanr f z (toList xs)
392 where f = (:)
393
394 prop_scanr1 :: Seq Int -> Property
395 prop_scanr1 xs =
396 not (null xs) ==> toList' (scanr1 f xs) ~= Data.List.scanr1 f (toList xs)
397 where f = (-)
398
399 -- * Sublists
400
401 prop_tails :: Seq A -> Bool
402 prop_tails xs =
403 toListList' (tails xs) ~= Data.List.tails (toList xs)
404
405 prop_inits :: Seq A -> Bool
406 prop_inits xs =
407 toListList' (inits xs) ~= Data.List.inits (toList xs)
408
409 -- ** Sequential searches
410 -- We use predicates with varying density.
411
412 prop_takeWhileL :: Positive Int -> Seq Int -> Bool
413 prop_takeWhileL (Positive n) xs =
414 toList' (takeWhileL p xs) ~= Prelude.takeWhile p (toList xs)
415 where p x = x `mod` n == 0
416
417 prop_takeWhileR :: Positive Int -> Seq Int -> Bool
418 prop_takeWhileR (Positive n) xs =
419 toList' (takeWhileR p xs) ~= Prelude.reverse (Prelude.takeWhile p (Prelude.reverse (toList xs)))
420 where p x = x `mod` n == 0
421
422 prop_dropWhileL :: Positive Int -> Seq Int -> Bool
423 prop_dropWhileL (Positive n) xs =
424 toList' (dropWhileL p xs) ~= Prelude.dropWhile p (toList xs)
425 where p x = x `mod` n == 0
426
427 prop_dropWhileR :: Positive Int -> Seq Int -> Bool
428 prop_dropWhileR (Positive n) xs =
429 toList' (dropWhileR p xs) ~= Prelude.reverse (Prelude.dropWhile p (Prelude.reverse (toList xs)))
430 where p x = x `mod` n == 0
431
432 prop_spanl :: Positive Int -> Seq Int -> Bool
433 prop_spanl (Positive n) xs =
434 toListPair' (spanl p xs) ~= Data.List.span p (toList xs)
435 where p x = x `mod` n == 0
436
437 prop_spanr :: Positive Int -> Seq Int -> Bool
438 prop_spanr (Positive n) xs =
439 toListPair' (spanr p xs) ~= (Prelude.reverse *** Prelude.reverse) (Data.List.span p (Prelude.reverse (toList xs)))
440 where p x = x `mod` n == 0
441
442 prop_breakl :: Positive Int -> Seq Int -> Bool
443 prop_breakl (Positive n) xs =
444 toListPair' (breakl p xs) ~= Data.List.break p (toList xs)
445 where p x = x `mod` n == 0
446
447 prop_breakr :: Positive Int -> Seq Int -> Bool
448 prop_breakr (Positive n) xs =
449 toListPair' (breakr p xs) ~= (Prelude.reverse *** Prelude.reverse) (Data.List.break p (Prelude.reverse (toList xs)))
450 where p x = x `mod` n == 0
451
452 prop_partition :: Positive Int -> Seq Int -> Bool
453 prop_partition (Positive n) xs =
454 toListPair' (partition p xs) ~= Data.List.partition p (toList xs)
455 where p x = x `mod` n == 0
456
457 prop_filter :: Positive Int -> Seq Int -> Bool
458 prop_filter (Positive n) xs =
459 toList' (filter p xs) ~= Prelude.filter p (toList xs)
460 where p x = x `mod` n == 0
461
462 -- * Sorting
463
464 prop_sort :: Seq OrdA -> Bool
465 prop_sort xs =
466 toList' (sort xs) ~= Data.List.sort (toList xs)
467
468 prop_sortBy :: Seq (OrdA, B) -> Bool
469 prop_sortBy xs =
470 toList' (sortBy f xs) ~= Data.List.sortBy f (toList xs)
471 where f (x1, _) (x2, _) = compare x1 x2
472
473 prop_unstableSort :: Seq OrdA -> Bool
474 prop_unstableSort xs =
475 toList' (unstableSort xs) ~= Data.List.sort (toList xs)
476
477 prop_unstableSortBy :: Seq OrdA -> Bool
478 prop_unstableSortBy xs =
479 toList' (unstableSortBy compare xs) ~= Data.List.sort (toList xs)
480
481 -- * Indexing
482
483 prop_index :: Seq A -> Property
484 prop_index xs =
485 not (null xs) ==> forAll (choose (0, length xs-1)) $ \ i ->
486 index xs i == toList xs !! i
487
488 prop_safeIndex :: Seq A -> Property
489 prop_safeIndex xs =
490 forAll (choose (-3, length xs + 3)) $ \i ->
491 ((i < 0 || i >= length xs) .&&. lookup i xs === Nothing) .||.
492 lookup i xs === Just (toList xs !! i)
493
494 prop_insertAt :: A -> Seq A -> Property
495 prop_insertAt x xs =
496 forAll (choose (-3, length xs + 3)) $ \i ->
497 let res = insertAt i x xs
498 in valid res .&&. res === case splitAt i xs of (front, back) -> front >< x <| back
499
500 prop_deleteAt :: Seq A -> Property
501 prop_deleteAt xs =
502 forAll (choose (-3, length xs + 3)) $ \i ->
503 let res = deleteAt i xs
504 in valid res .&&.
505 (((0 <= i && i < length xs) .&&. res === case splitAt i xs of (front, back) -> front >< drop 1 back)
506 .||. ((i < 0 || i >= length xs) .&&. res === xs))
507
508 prop_adjust :: Int -> Int -> Seq Int -> Bool
509 prop_adjust n i xs =
510 toList' (adjust f i xs) ~= adjustList f i (toList xs)
511 where f = (+n)
512
513 prop_update :: Int -> A -> Seq A -> Bool
514 prop_update i x xs =
515 toList' (update i x xs) ~= adjustList (const x) i (toList xs)
516
517 prop_take :: Int -> Seq A -> Bool
518 prop_take n xs =
519 toList' (take n xs) ~= Prelude.take n (toList xs)
520
521 prop_drop :: Int -> Seq A -> Bool
522 prop_drop n xs =
523 toList' (drop n xs) ~= Prelude.drop n (toList xs)
524
525 prop_splitAt :: Int -> Seq A -> Bool
526 prop_splitAt n xs =
527 toListPair' (splitAt n xs) ~= Prelude.splitAt n (toList xs)
528
529 prop_chunksOf :: Seq A -> Property
530 prop_chunksOf xs =
531 forAll (choose (1, length xs + 3)) $ \n ->
532 let chunks = chunksOf n xs
533 in valid chunks .&&.
534 conjoin [valid c .&&. 1 <= length c && length c <= n | c <- toList chunks] .&&.
535 fold chunks === xs
536
537 adjustList :: (a -> a) -> Int -> [a] -> [a]
538 adjustList f i xs =
539 [if j == i then f x else x | (j, x) <- Prelude.zip [0..] xs]
540
541 -- ** Indexing with predicates
542 -- The elem* tests have poor coverage, but for find* we use predicates
543 -- of varying density.
544
545 prop_elemIndexL :: A -> Seq A -> Bool
546 prop_elemIndexL x xs =
547 elemIndexL x xs == Data.List.elemIndex x (toList xs)
548
549 prop_elemIndicesL :: A -> Seq A -> Bool
550 prop_elemIndicesL x xs =
551 elemIndicesL x xs == Data.List.elemIndices x (toList xs)
552
553 prop_elemIndexR :: A -> Seq A -> Bool
554 prop_elemIndexR x xs =
555 elemIndexR x xs == listToMaybe (Prelude.reverse (Data.List.elemIndices x (toList xs)))
556
557 prop_elemIndicesR :: A -> Seq A -> Bool
558 prop_elemIndicesR x xs =
559 elemIndicesR x xs == Prelude.reverse (Data.List.elemIndices x (toList xs))
560
561 prop_findIndexL :: Positive Int -> Seq Int -> Bool
562 prop_findIndexL (Positive n) xs =
563 findIndexL p xs == Data.List.findIndex p (toList xs)
564 where p x = x `mod` n == 0
565
566 prop_findIndicesL :: Positive Int -> Seq Int -> Bool
567 prop_findIndicesL (Positive n) xs =
568 findIndicesL p xs == Data.List.findIndices p (toList xs)
569 where p x = x `mod` n == 0
570
571 prop_findIndexR :: Positive Int -> Seq Int -> Bool
572 prop_findIndexR (Positive n) xs =
573 findIndexR p xs == listToMaybe (Prelude.reverse (Data.List.findIndices p (toList xs)))
574 where p x = x `mod` n == 0
575
576 prop_findIndicesR :: Positive Int -> Seq Int -> Bool
577 prop_findIndicesR (Positive n) xs =
578 findIndicesR p xs == Prelude.reverse (Data.List.findIndices p (toList xs))
579 where p x = x `mod` n == 0
580
581 -- * Folds
582
583 prop_foldlWithIndex :: [(Int, A)] -> Seq A -> Bool
584 prop_foldlWithIndex z xs =
585 foldlWithIndex f z xs == Data.List.foldl (uncurry . f) z (Data.List.zip [0..] (toList xs))
586 where f ys n y = (n,y):ys
587
588 prop_foldrWithIndex :: [(Int, A)] -> Seq A -> Bool
589 prop_foldrWithIndex z xs =
590 foldrWithIndex f z xs == Data.List.foldr (uncurry f) z (Data.List.zip [0..] (toList xs))
591 where f n y ys = (n,y):ys
592
593 prop_foldMapWithIndexL :: (Fun (B, Int, A) B) -> B -> Seq A -> Bool
594 prop_foldMapWithIndexL (Fun _ f) z t = foldlWithIndex f' z t ==
595 appEndo (getDual (foldMapWithIndex (\i -> Dual . Endo . flip (flip f' i)) t)) z
596 where f' b i a = f (b, i, a)
597
598 prop_foldMapWithIndexR :: (Fun (Int, A, B) B) -> B -> Seq A -> Bool
599 prop_foldMapWithIndexR (Fun _ f) z t = foldrWithIndex f' z t ==
600 appEndo (foldMapWithIndex (\i -> Endo . f' i) t) z
601 where f' i a b = f (i, a, b)
602
603 -- * Transformations
604
605 prop_mapWithIndex :: Seq A -> Bool
606 prop_mapWithIndex xs =
607 toList' (mapWithIndex f xs) ~= map (uncurry f) (Data.List.zip [0..] (toList xs))
608 where f = (,)
609
610 prop_traverseWithIndex :: Seq Int -> Bool
611 prop_traverseWithIndex xs =
612 runState (traverseWithIndex (\i x -> modify ((i,x) :)) xs) [] ==
613 runState (sequenceA . mapWithIndex (\i x -> modify ((i,x) :)) $ xs) []
614
615 prop_reverse :: Seq A -> Bool
616 prop_reverse xs =
617 toList' (reverse xs) ~= Prelude.reverse (toList xs)
618
619 -- ** Zips
620
621 prop_zip :: Seq A -> Seq B -> Bool
622 prop_zip xs ys =
623 toList' (zip xs ys) ~= Prelude.zip (toList xs) (toList ys)
624
625 prop_zipWith :: Seq A -> Seq B -> Bool
626 prop_zipWith xs ys =
627 toList' (zipWith f xs ys) ~= Prelude.zipWith f (toList xs) (toList ys)
628 where f = (,)
629
630 prop_zip3 :: Seq A -> Seq B -> Seq C -> Bool
631 prop_zip3 xs ys zs =
632 toList' (zip3 xs ys zs) ~= Prelude.zip3 (toList xs) (toList ys) (toList zs)
633
634 prop_zipWith3 :: Seq A -> Seq B -> Seq C -> Bool
635 prop_zipWith3 xs ys zs =
636 toList' (zipWith3 f xs ys zs) ~= Prelude.zipWith3 f (toList xs) (toList ys) (toList zs)
637 where f = (,,)
638
639 prop_zip4 :: Seq A -> Seq B -> Seq C -> Seq Int -> Bool
640 prop_zip4 xs ys zs ts =
641 toList' (zip4 xs ys zs ts) ~= Data.List.zip4 (toList xs) (toList ys) (toList zs) (toList ts)
642
643 prop_zipWith4 :: Seq A -> Seq B -> Seq C -> Seq Int -> Bool
644 prop_zipWith4 xs ys zs ts =
645 toList' (zipWith4 f xs ys zs ts) ~= Data.List.zipWith4 f (toList xs) (toList ys) (toList zs) (toList ts)
646 where f = (,,,)
647
648 -- Applicative operations
649
650 prop_ap :: Seq A -> Seq B -> Bool
651 prop_ap xs ys =
652 toList' ((,) <$> xs <*> ys) ~= ( (,) <$> toList xs <*> toList ys )
653
654 prop_then :: Seq A -> Seq B -> Bool
655 prop_then xs ys =
656 toList' (xs *> ys) ~= (toList xs *> toList ys)
657
658 prop_intersperse :: A -> Seq A -> Bool
659 prop_intersperse x xs =
660 toList' (intersperse x xs) ~= Data.List.intersperse x (toList xs)
661
662 prop_cycleTaking :: Int -> Seq A -> Property
663 prop_cycleTaking n xs =
664 (n <= 0 || not (null xs)) ==> toList' (cycleTaking n xs) ~= Data.List.take n (Data.List.cycle (toList xs))
665
666 -- Monad operations
667
668 prop_bind :: Seq A -> Fun A (Seq B) -> Bool
669 prop_bind xs (Fun _ f) =
670 toList' (xs >>= f) ~= (toList xs >>= toList . f)
671
672 -- Simple test monad
673
674 data M a = Action Int a
675 deriving (Eq, Show)
676
677 instance Functor M where
678 fmap f (Action n x) = Action n (f x)
679
680 instance Applicative M where
681 pure x = Action 0 x
682 Action m f <*> Action n x = Action (m+n) (f x)
683
684 instance Monad M where
685 return x = Action 0 x
686 Action m x >>= f = let Action n y = f x in Action (m+n) y
687
688 instance Foldable M where
689 foldMap f (Action _ x) = f x
690
691 instance Traversable M where
692 traverse f (Action n x) = Action n <$> f x