Stream Utilities
[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.Fusion.Stream as S
10
11 import Data.List ( sortBy )
12
13
14 instance Show a => Show (S.Stream a) where
15 show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)
16
17
18 instance Arbitrary a => Arbitrary (DV.Vector a) where
19 arbitrary = fmap DV.fromList arbitrary
20
21 instance CoArbitrary a => CoArbitrary (DV.Vector a) where
22 coarbitrary = coarbitrary . DV.toList
23
24 instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
25 arbitrary = fmap DVP.fromList arbitrary
26
27 instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where
28 coarbitrary = coarbitrary . DVP.toList
29
30 instance Arbitrary a => Arbitrary (S.Stream a) where
31 arbitrary = fmap S.fromList arbitrary
32
33 instance CoArbitrary a => CoArbitrary (S.Stream a) where
34 coarbitrary = coarbitrary . S.toList
35
36 class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where
37 type Model a
38 model :: a -> Model a
39 unmodel :: Model a -> a
40
41 type EqTest a
42 equal :: a -> a -> EqTest a
43
44 instance Eq a => TestData (S.Stream a) where
45 type Model (S.Stream a) = [a]
46 model = S.toList
47 unmodel = S.fromList
48
49 type EqTest (S.Stream a) = Property
50 equal x y = property (x == y)
51
52 instance Eq a => TestData (DV.Vector a) where
53 type Model (DV.Vector a) = [a]
54 model = DV.toList
55 unmodel = DV.fromList
56
57 type EqTest (DV.Vector a) = Property
58 equal x y = property (x == y)
59
60 instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where
61 type Model (DVP.Vector a) = [a]
62 model = DVP.toList
63 unmodel = DVP.fromList
64
65 type EqTest (DVP.Vector a) = Property
66 equal x y = property (x == y)
67
68 #define id_TestData(ty) \
69 instance TestData ty where { \
70 type Model ty = ty; \
71 model = id; \
72 unmodel = id; \
73 \
74 type EqTest ty = Property; \
75 equal x y = property (x == y) }
76
77 id_TestData(Bool)
78 id_TestData(Int)
79 id_TestData(Float)
80 id_TestData(Double)
81 id_TestData(Ordering)
82
83 -- Functorish models
84 -- All of these need UndecidableInstances although they are actually well founded. Oh well.
85 instance (Eq a, TestData a) => TestData (Maybe a) where
86 type Model (Maybe a) = Maybe (Model a)
87 model = fmap model
88 unmodel = fmap unmodel
89
90 type EqTest (Maybe a) = Property
91 equal x y = property (x == y)
92
93 instance (Eq a, TestData a) => TestData [a] where
94 type Model [a] = [Model a]
95 model = fmap model
96 unmodel = fmap unmodel
97
98 type EqTest [a] = Property
99 equal x y = property (x == y)
100
101 instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where
102 type Model (a,b) = (Model a, Model b)
103 model (a,b) = (model a, model b)
104 unmodel (a,b) = (unmodel a, unmodel b)
105
106 type EqTest (a,b) = Property
107 equal x y = property (x == y)
108
109 instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where
110 type Model (a,b,c) = (Model a, Model b, Model c)
111 model (a,b,c) = (model a, model b, model c)
112 unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c)
113
114 type EqTest (a,b,c) = Property
115 equal x y = property (x == y)
116
117 instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where
118 type Model (a -> b) = Model a -> Model b
119 model f = model . f . unmodel
120 unmodel f = unmodel . f . model
121
122 type EqTest (a -> b) = a -> EqTest b
123 equal f g x = equal (f x) (g x)
124
125 newtype P a = P { unP :: EqTest a }
126
127 instance TestData a => Testable (P a) where
128 property (P a) = property a
129
130 infix 4 `eq`
131 eq :: TestData a => a -> Model a -> P a
132 eq x y = P (equal x (unmodel y))
133
134 class Conclusion p where
135 type Predicate p
136
137 predicate :: Predicate p -> p -> p
138
139 instance Conclusion Property where
140 type Predicate Property = Bool
141
142 predicate = (==>)
143
144 instance Conclusion p => Conclusion (a -> p) where
145 type Predicate (a -> p) = a -> Predicate p
146
147 predicate f p = \x -> predicate (f x) (p x)
148
149 infixr 0 ===>
150 (===>) :: TestData a => Predicate (EqTest a) -> P a -> P a
151 p ===> P a = P (predicate p a)
152
153 notNull2 _ xs = not $ DVG.null xs
154 notNullS2 _ s = not $ S.null s
155
156 -- Generators
157 index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]
158 index_value_pairs 0 = return []
159 index_value_pairs m = sized $ \n ->
160 do
161 len <- choose (0,n)
162 is <- sequence [choose (0,m-1) | i <- [1..len]]
163 xs <- vector len
164 return $ zip is xs
165
166 indices :: Int -> Gen [Int]
167 indices 0 = return []
168 indices m = sized $ \n ->
169 do
170 len <- choose (0,n)
171 sequence [choose (0,m-1) | i <- [1..len]]
172
173
174 -- Additional list functions
175 singleton x = [x]
176 snoc xs x = xs ++ [x]
177 slice xs i n = take n (drop i xs)
178 backpermute xs is = map (xs!!) is
179 prescanl f z = init . scanl f z
180 postscanl f z = tail . scanl f z
181
182 accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]
183 accum f xs ps = go xs ps' 0
184 where
185 ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
186
187 go (x:xs) ((i,y) : ps) j
188 | i == j = go (f x y : xs) ps j
189 go (x:xs) ps j = x : go xs ps (j+1)
190 go [] _ _ = []
191
192 (//) :: [a] -> [(Int, a)] -> [a]
193 xs // ps = go xs ps' 0
194 where
195 ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
196
197 go (x:xs) ((i,y) : ps) j
198 | i == j = go (y:xs) ps j
199 go (x:xs) ps j = x : go xs ps (j+1)
200 go [] _ _ = []
201