D.V.Unboxed tests
[darcs-mirrors/vector.git] / tests / Utilities.hs
1 {-# LANGUAGE FlexibleInstances, GADTs #-}
2 module Utilities where
3
4 import Test.QuickCheck
5
6 import qualified Data.Vector as DV
7 import qualified Data.Vector.Generic as DVG
8 import qualified Data.Vector.Primitive as DVP
9 import qualified Data.Vector.Storable as DVS
10 import qualified Data.Vector.Unboxed as DVU
11 import qualified Data.Vector.Fusion.Stream as S
12
13 import Data.List ( sortBy )
14
15
16 instance Show a => Show (S.Stream a) where
17 show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)
18
19
20 instance Arbitrary a => Arbitrary (DV.Vector a) where
21 arbitrary = fmap DV.fromList arbitrary
22
23 instance CoArbitrary a => CoArbitrary (DV.Vector a) where
24 coarbitrary = coarbitrary . DV.toList
25
26 instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
27 arbitrary = fmap DVP.fromList arbitrary
28
29 instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where
30 coarbitrary = coarbitrary . DVP.toList
31
32 instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where
33 arbitrary = fmap DVS.fromList arbitrary
34
35 instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where
36 coarbitrary = coarbitrary . DVS.toList
37
38 instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where
39 arbitrary = fmap DVU.fromList arbitrary
40
41 instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where
42 coarbitrary = coarbitrary . DVU.toList
43
44 instance Arbitrary a => Arbitrary (S.Stream a) where
45 arbitrary = fmap S.fromList arbitrary
46
47 instance CoArbitrary a => CoArbitrary (S.Stream a) where
48 coarbitrary = coarbitrary . S.toList
49
50 class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where
51 type Model a
52 model :: a -> Model a
53 unmodel :: Model a -> a
54
55 type EqTest a
56 equal :: a -> a -> EqTest a
57
58 instance Eq a => TestData (S.Stream a) where
59 type Model (S.Stream a) = [a]
60 model = S.toList
61 unmodel = S.fromList
62
63 type EqTest (S.Stream a) = Property
64 equal x y = property (x == y)
65
66 instance Eq a => TestData (DV.Vector a) where
67 type Model (DV.Vector a) = [a]
68 model = DV.toList
69 unmodel = DV.fromList
70
71 type EqTest (DV.Vector a) = Property
72 equal x y = property (x == y)
73
74 instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where
75 type Model (DVP.Vector a) = [a]
76 model = DVP.toList
77 unmodel = DVP.fromList
78
79 type EqTest (DVP.Vector a) = Property
80 equal x y = property (x == y)
81
82 instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where
83 type Model (DVS.Vector a) = [a]
84 model = DVS.toList
85 unmodel = DVS.fromList
86
87 type EqTest (DVS.Vector a) = Property
88 equal x y = property (x == y)
89
90 instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where
91 type Model (DVU.Vector a) = [a]
92 model = DVU.toList
93 unmodel = DVU.fromList
94
95 type EqTest (DVU.Vector a) = Property
96 equal x y = property (x == y)
97
98 #define id_TestData(ty) \
99 instance TestData ty where { \
100 type Model ty = ty; \
101 model = id; \
102 unmodel = id; \
103 \
104 type EqTest ty = Property; \
105 equal x y = property (x == y) }
106
107 id_TestData(Bool)
108 id_TestData(Int)
109 id_TestData(Float)
110 id_TestData(Double)
111 id_TestData(Ordering)
112
113 -- Functorish models
114 -- All of these need UndecidableInstances although they are actually well founded. Oh well.
115 instance (Eq a, TestData a) => TestData (Maybe a) where
116 type Model (Maybe a) = Maybe (Model a)
117 model = fmap model
118 unmodel = fmap unmodel
119
120 type EqTest (Maybe a) = Property
121 equal x y = property (x == y)
122
123 instance (Eq a, TestData a) => TestData [a] where
124 type Model [a] = [Model a]
125 model = fmap model
126 unmodel = fmap unmodel
127
128 type EqTest [a] = Property
129 equal x y = property (x == y)
130
131 instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where
132 type Model (a,b) = (Model a, Model b)
133 model (a,b) = (model a, model b)
134 unmodel (a,b) = (unmodel a, unmodel b)
135
136 type EqTest (a,b) = Property
137 equal x y = property (x == y)
138
139 instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where
140 type Model (a,b,c) = (Model a, Model b, Model c)
141 model (a,b,c) = (model a, model b, model c)
142 unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c)
143
144 type EqTest (a,b,c) = Property
145 equal x y = property (x == y)
146
147 instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where
148 type Model (a -> b) = Model a -> Model b
149 model f = model . f . unmodel
150 unmodel f = unmodel . f . model
151
152 type EqTest (a -> b) = a -> EqTest b
153 equal f g x = equal (f x) (g x)
154
155 newtype P a = P { unP :: EqTest a }
156
157 instance TestData a => Testable (P a) where
158 property (P a) = property a
159
160 infix 4 `eq`
161 eq :: TestData a => a -> Model a -> P a
162 eq x y = P (equal x (unmodel y))
163
164 class Conclusion p where
165 type Predicate p
166
167 predicate :: Predicate p -> p -> p
168
169 instance Conclusion Property where
170 type Predicate Property = Bool
171
172 predicate = (==>)
173
174 instance Conclusion p => Conclusion (a -> p) where
175 type Predicate (a -> p) = a -> Predicate p
176
177 predicate f p = \x -> predicate (f x) (p x)
178
179 infixr 0 ===>
180 (===>) :: TestData a => Predicate (EqTest a) -> P a -> P a
181 p ===> P a = P (predicate p a)
182
183 notNull2 _ xs = not $ DVG.null xs
184 notNullS2 _ s = not $ S.null s
185
186 -- Generators
187 index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]
188 index_value_pairs 0 = return []
189 index_value_pairs m = sized $ \n ->
190 do
191 len <- choose (0,n)
192 is <- sequence [choose (0,m-1) | i <- [1..len]]
193 xs <- vector len
194 return $ zip is xs
195
196 indices :: Int -> Gen [Int]
197 indices 0 = return []
198 indices m = sized $ \n ->
199 do
200 len <- choose (0,n)
201 sequence [choose (0,m-1) | i <- [1..len]]
202
203
204 -- Additional list functions
205 singleton x = [x]
206 snoc xs x = xs ++ [x]
207 generate n f = [f i | i <- [0 .. n-1]]
208 slice i n xs = take n (drop i xs)
209 backpermute xs is = map (xs!!) is
210 prescanl f z = init . scanl f z
211 postscanl f z = tail . scanl f z
212 prescanr f z = tail . scanr f z
213 postscanr f z = init . scanr f z
214
215 accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]
216 accum f xs ps = go xs ps' 0
217 where
218 ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
219
220 go (x:xs) ((i,y) : ps) j
221 | i == j = go (f x y : xs) ps j
222 go (x:xs) ps j = x : go xs ps (j+1)
223 go [] _ _ = []
224
225 (//) :: [a] -> [(Int, a)] -> [a]
226 xs // ps = go xs ps' 0
227 where
228 ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
229
230 go (x:xs) ((i,y) : ps) j
231 | i == j = go (y:xs) ps j
232 go (x:xs) ps j = x : go xs ps (j+1)
233 go [] _ _ = []
234
235 imap :: (Int -> a -> a) -> [a] -> [a]
236 imap f = map (uncurry f) . zip [0..]
237
238 izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a]
239 izipWith f = zipWith (uncurry f) . zip [0..]
240
241 izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
242 izipWith3 f = zipWith3 (uncurry f) . zip [0..]
243
244 ifilter :: (Int -> a -> Bool) -> [a] -> [a]
245 ifilter f = map snd . filter (uncurry f) . zip [0..]
246
247 ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a
248 ifoldl f z = foldl (uncurry . f) z . zip [0..]
249
250 ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b
251 ifoldr f z = foldr (uncurry f) z . zip [0..]
252
253 minIndex :: Ord a => [a] -> Int
254 minIndex = fst . foldr1 imin . zip [0..]
255 where
256 imin (i,x) (j,y) | x <= y = (i,x)
257 | otherwise = (j,y)
258
259 maxIndex :: Ord a => [a] -> Int
260 maxIndex = fst . foldr1 imax . zip [0..]
261 where
262 imax (i,x) (j,y) | x >= y = (i,x)
263 | otherwise = (j,y)
264