1module Tests.Bundle ( tests ) where
2
3import Boilerplater
4import Utilities hiding (limitUnfolds)
5
6import qualified Data.Vector.Fusion.Bundle as S
7
8import Test.QuickCheck
9
10import Test.Tasty
11import Test.Tasty.QuickCheck hiding (testProperties)
12
13import Text.Show.Functions ()
14import Data.List           (foldl', foldl1', unfoldr, find, findIndex)
15
16-- migration from testframework to tasty
17type Test = TestTree
18
19#define COMMON_CONTEXT(a) \
20 VANILLA_CONTEXT(a)
21
22#define VANILLA_CONTEXT(a) \
23  Eq a,     Show a,     Arbitrary a,     CoArbitrary a,     TestData a,     Model a ~ a,        EqTest a ~ Property
24
25testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]
26testSanity _ = [
27        testProperty "fromList.toList == id" prop_fromList_toList,
28        testProperty "toList.fromList == id" prop_toList_fromList
29    ]
30  where
31    prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a)
32        = (S.fromList . S.toList) `eq` id
33    prop_toList_fromList :: P ([a] -> [a])
34        = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id
35
36testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]
37testPolymorphicFunctions _ = $(testProperties [
38        'prop_eq,
39
40        'prop_length, 'prop_null,
41
42        'prop_empty, 'prop_singleton, 'prop_replicate,
43        'prop_cons, 'prop_snoc, 'prop_append,
44
45        'prop_head, 'prop_last, 'prop_index,
46
47        'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
48
49        'prop_map, 'prop_zipWith, 'prop_zipWith3,
50        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,
51
52        'prop_elem, 'prop_notElem,
53        'prop_find, 'prop_findIndex,
54
55        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
56        'prop_foldr, 'prop_foldr1,
57
58        'prop_prescanl, 'prop_prescanl',
59        'prop_postscanl, 'prop_postscanl',
60        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
61
62        'prop_concatMap,
63        'prop_unfoldr
64    ])
65  where
66    -- Prelude
67    prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==)
68
69    prop_length :: P (S.Bundle v a -> Int)     = S.length `eq` length
70    prop_null   :: P (S.Bundle v a -> Bool)    = S.null `eq` null
71    prop_empty  :: P (S.Bundle v a)            = S.empty `eq` []
72    prop_singleton :: P (a -> S.Bundle v a)    = S.singleton `eq` singleton
73    prop_replicate :: P (Int -> a -> S.Bundle v a)
74              = (\n _ -> n < 1000) ===> S.replicate `eq` replicate
75    prop_cons      :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:)
76    prop_snoc      :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc
77    prop_append    :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++)
78
79    prop_head      :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head
80    prop_last      :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last
81    prop_index        = \xs ->
82                        not (S.null xs) ==>
83                        forAll (choose (0, S.length xs-1)) $ \i ->
84                        unP prop xs i
85      where
86        prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!)
87
88    prop_extract      = \xs ->
89                        forAll (choose (0, S.length xs))     $ \i ->
90                        forAll (choose (0, S.length xs - i)) $ \n ->
91                        unP prop i n xs
92      where
93        prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice
94
95    prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail
96    prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init
97    prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take
98    prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop
99
100    prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map
101    prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith
102    prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a)
103             = S.zipWith3 `eq` zipWith3
104
105    prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter
106    prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile
107    prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile
108
109    prop_elem    :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem
110    prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem
111    prop_find    :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find
112    prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int)
113      = S.findIndex `eq` findIndex
114
115    prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl
116    prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>
117                        S.foldl1 `eq` foldl1
118    prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl'
119    prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>
120                        S.foldl1' `eq` foldl1'
121    prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr
122    prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a)     = notNullS2 ===>
123                        S.foldr1 `eq` foldr1
124
125    prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
126                = S.prescanl `eq` prescanl
127    prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
128                = S.prescanl' `eq` prescanl
129    prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
130                = S.postscanl `eq` postscanl
131    prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
132                = S.postscanl' `eq` postscanl
133    prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
134                = S.scanl `eq` scanl
135    prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
136               = S.scanl' `eq` scanl
137    prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>
138                 S.scanl1 `eq` scanl1
139    prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>
140                 S.scanl1' `eq` scanl1
141
142    prop_concatMap    = forAll arbitrary $ \xs ->
143                        forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs
144      where
145        prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap
146
147    limitUnfolds f (theirs, ours) | ours >= 0
148                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
149                                  | otherwise                       = Nothing
150    prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a)
151         = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))
152           `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
153
154testBoolFunctions :: forall v. S.Bundle v Bool -> [Test]
155testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ])
156  where
157    prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and
158    prop_or  :: P (S.Bundle v Bool -> Bool) = S.or `eq` or
159
160testBundleFunctions = testSanity (undefined :: S.Bundle v Int)
161                      ++ testPolymorphicFunctions (undefined :: S.Bundle v Int)
162                      ++ testBoolFunctions (undefined :: S.Bundle v Bool)
163
164tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ]
165
166