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