XGitUrl: http://git.haskell.org/darcsmirrors/vector.git/blobdiff_plain/ba0ba56e8da95ace7099099f949e620b57e16426..0518a4a2f7c01d066acf603de42779eb56033506:/tests/Utilities.hs
diff git a/tests/Utilities.hs b/tests/Utilities.hs
index a84dbeb..e0129f2 100644
 a/tests/Utilities.hs
+++ b/tests/Utilities.hs
@@ 6,13 +6,15 @@ import Test.QuickCheck
import qualified Data.Vector as DV
import qualified Data.Vector.Generic as DVG
import qualified Data.Vector.Primitive as DVP
import qualified Data.Vector.Fusion.Stream as S
+import qualified Data.Vector.Storable as DVS
+import qualified Data.Vector.Unboxed as DVU
+import qualified Data.Vector.Fusion.Bundle as S
import Data.List ( sortBy )
instance Show a => Show (S.Stream a) where
 show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)
+instance Show a => Show (S.Bundle v a) where
+ show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s)
instance Arbitrary a => Arbitrary (DV.Vector a) where
@@ 27,132 +29,160 @@ instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where
coarbitrary = coarbitrary . DVP.toList
instance Arbitrary a => Arbitrary (S.Stream a) where
+instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where
+ arbitrary = fmap DVS.fromList arbitrary
+
+instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where
+ coarbitrary = coarbitrary . DVS.toList
+
+instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where
+ arbitrary = fmap DVU.fromList arbitrary
+
+instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where
+ coarbitrary = coarbitrary . DVU.toList
+
+instance Arbitrary a => Arbitrary (S.Bundle v a) where
arbitrary = fmap S.fromList arbitrary
instance CoArbitrary a => CoArbitrary (S.Stream a) where
+instance CoArbitrary a => CoArbitrary (S.Bundle v a) where
coarbitrary = coarbitrary . S.toList
class Modelled a where
+class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where
type Model a
   Convert a concrete value into an abstract model
model :: a > Model a
unmodel :: Model a > a
 The meat of the models
instance Modelled (DV.Vector a) where
+ type EqTest a
+ equal :: a > a > EqTest a
+
+instance Eq a => TestData (S.Bundle v a) where
+ type Model (S.Bundle v a) = [a]
+ model = S.toList
+ unmodel = S.fromList
+
+ type EqTest (S.Bundle v a) = Property
+ equal x y = property (x == y)
+
+instance Eq a => TestData (DV.Vector a) where
type Model (DV.Vector a) = [a]
model = DV.toList
unmodel = DV.fromList
instance DVP.Prim a => Modelled (DVP.Vector a) where
+ type EqTest (DV.Vector a) = Property
+ equal x y = property (x == y)
+
+instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where
type Model (DVP.Vector a) = [a]
model = DVP.toList
unmodel = DVP.fromList
 Identity models

#define id_Modelled(ty) \
instance Modelled ty where { type Model ty = ty; model = id; unmodel = id }

id_Modelled(Bool)
id_Modelled(Int)
id_Modelled(Float)
id_Modelled(Double)
id_Modelled(Ordering)
+ type EqTest (DVP.Vector a) = Property
+ equal x y = property (x == y)
+
+instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where
+ type Model (DVS.Vector a) = [a]
+ model = DVS.toList
+ unmodel = DVS.fromList
+
+ type EqTest (DVS.Vector a) = Property
+ equal x y = property (x == y)
+
+instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where
+ type Model (DVU.Vector a) = [a]
+ model = DVU.toList
+ unmodel = DVU.fromList
+
+ type EqTest (DVU.Vector a) = Property
+ equal x y = property (x == y)
+
+#define id_TestData(ty) \
+instance TestData ty where { \
+ type Model ty = ty; \
+ model = id; \
+ unmodel = id; \
+ \
+ type EqTest ty = Property; \
+ equal x y = property (x == y) }
+
+id_TestData(())
+id_TestData(Bool)
+id_TestData(Int)
+id_TestData(Float)
+id_TestData(Double)
+id_TestData(Ordering)
 Functorish models
 All of these need UndecidableInstances although they are actually well founded. Oh well.
instance Modelled a => Modelled (Maybe a) where
+instance (Eq a, TestData a) => TestData (Maybe a) where
type Model (Maybe a) = Maybe (Model a)
model = fmap model
unmodel = fmap unmodel
instance Modelled a => Modelled [a] where
+ type EqTest (Maybe a) = Property
+ equal x y = property (x == y)
+
+instance (Eq a, TestData a) => TestData [a] where
type Model [a] = [Model a]
model = fmap model
unmodel = fmap unmodel
instance (Modelled a, Modelled b) => Modelled (a,b) where
+ type EqTest [a] = Property
+ equal x y = property (x == y)
+
+instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where
type Model (a,b) = (Model a, Model b)
model (a,b) = (model a, model b)
unmodel (a,b) = (unmodel a, unmodel b)
instance (Modelled a, Modelled b, Modelled c) => Modelled (a,b,c) where
+ type EqTest (a,b) = Property
+ equal x y = property (x == y)
+
+instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where
type Model (a,b,c) = (Model a, Model b, Model c)
model (a,b,c) = (model a, model b, model c)
unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c)
instance (Modelled a, Modelled b) => Modelled (a > b) where
+ type EqTest (a,b,c) = Property
+ equal x y = property (x == y)
+
+instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a > b) where
type Model (a > b) = Model a > Model b
model f = model . f . unmodel
unmodel f = unmodel . f . model
class (Testable (Pty a), Predicate (Pty a)) => PropLike a where
 type Pty a

instance (Arbitrary a, Show a, PropLike b) => PropLike (a > b) where
 type Pty (a > b) = a > Pty b

#define PropLike0(ty) \
instance PropLike (ty) where { type Pty (ty) = Property }
+ type EqTest (a > b) = a > EqTest b
+ equal f g x = equal (f x) (g x)
PropLike0(Int)
PropLike0(Bool)
PropLike0(Float)
PropLike0(Double)
PropLike0(Ordering)
PropLike0([a])
PropLike0(Maybe a)
PropLike0((a,b))
PropLike0((a,b,c))
PropLike0(DV.Vector a)
PropLike0(DVP.Vector a)
PropLike0(S.Stream a)
+newtype P a = P { unP :: EqTest a }
data P a where
 P :: PropLike a => Pty a > P a

unP :: P a > Pty a
unP (P p) = p


instance Testable (P a) where
+instance TestData a => Testable (P a) where
property (P a) = property a
class PropLike a => EqTestable a p where
 equal :: a > a > p

instance (Eq a, PropLike a) => EqTestable a Property where
 equal x y = property (x==y)

instance (Arbitrary a, Show a, EqTestable b p) => EqTestable (a > b) (a > p) where
 equal f g = \x > equal (f x) (g x)

infix 4 `eq`
eq :: (Modelled a, EqTestable a (Pty a)) => a > Model a > P a
+eq :: TestData a => a > Model a > P a
eq x y = P (equal x (unmodel y))
class Predicate p where
 type Pred p
+class Conclusion p where
+ type Predicate p
 predicate :: Pred p > p > p
+ predicate :: Predicate p > p > p
instance Predicate Property where
 type Pred Property = Bool
+instance Conclusion Property where
+ type Predicate Property = Bool
predicate = (==>)
instance Predicate p => Predicate (a > p) where
 type Pred (a > p) = a > Pred p
+instance Conclusion p => Conclusion (a > p) where
+ type Predicate (a > p) = a > Predicate p
predicate f p = \x > predicate (f x) (p x)
infixr 0 ===>
(===>) :: Pred (Pty a) > P a > P a
+(===>) :: TestData a => Predicate (EqTest a) > P a > P a
p ===> P a = P (predicate p a)
notNull2 _ xs = not $ DVG.null xs
+notNullS2 _ s = not $ S.null s
 Generators
index_value_pairs :: Arbitrary a => Int > Gen [(Int,a)]
@@ 175,10 +205,13 @@ indices m = sized $ \n >
 Additional list functions
singleton x = [x]
snoc xs x = xs ++ [x]
slice xs i n = take n (drop i xs)
+generate n f = [f i  i < [0 .. n1]]
+slice i n xs = take n (drop i xs)
backpermute xs is = map (xs!!) is
prescanl f z = init . scanl f z
postscanl f z = tail . scanl f z
+prescanr f z = tail . scanr f z
+postscanr f z = init . scanr f z
accum :: (a > b > a) > [a] > [(Int,b)] > [a]
accum f xs ps = go xs ps' 0
@@ 200,3 +233,33 @@ xs // ps = go xs ps' 0
go (x:xs) ps j = x : go xs ps (j+1)
go [] _ _ = []
+imap :: (Int > a > a) > [a] > [a]
+imap f = map (uncurry f) . zip [0..]
+
+izipWith :: (Int > a > a > a) > [a] > [a] > [a]
+izipWith f = zipWith (uncurry f) . zip [0..]
+
+izipWith3 :: (Int > a > a > a > a) > [a] > [a] > [a] > [a]
+izipWith3 f = zipWith3 (uncurry f) . zip [0..]
+
+ifilter :: (Int > a > Bool) > [a] > [a]
+ifilter f = map snd . filter (uncurry f) . zip [0..]
+
+ifoldl :: (a > Int > a > a) > a > [a] > a
+ifoldl f z = foldl (uncurry . f) z . zip [0..]
+
+ifoldr :: (Int > a > b > b) > b > [a] > b
+ifoldr f z = foldr (uncurry f) z . zip [0..]
+
+minIndex :: Ord a => [a] > Int
+minIndex = fst . foldr1 imin . zip [0..]
+ where
+ imin (i,x) (j,y)  x <= y = (i,x)
+  otherwise = (j,y)
+
+maxIndex :: Ord a => [a] > Int
+maxIndex = fst . foldr1 imax . zip [0..]
+ where
+ imax (i,x) (j,y)  x >= y = (i,x)
+  otherwise = (j,y)
+