Adapt tests to new names and modules
[darcs-mirrors/vector.git] / tests / Utilities.hs
index 255cc75..e0129f2 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, GADTs #-}
 module Utilities where
 
 import Test.QuickCheck
@@ -6,146 +6,183 @@ 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
     arbitrary = fmap DV.fromList arbitrary
+
+instance CoArbitrary a => CoArbitrary (DV.Vector a) where
     coarbitrary = coarbitrary . DV.toList
 
 instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
     arbitrary = fmap DVP.fromList arbitrary
+
+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
-    coarbitrary = coarbitrary . S.toList
 
+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 (Predicate (EqTest a), Testable (EqTest a)) => EqTestable a where
-  type EqTest a
-
-  equal :: a -> a -> EqTest a
-
-#define EqTestable0(ty) \
-instance EqTestable (ty) where { type EqTest (ty) = Bool; equal = (==) }
-
-EqTestable0(Bool)
-EqTestable0(Int)
-EqTestable0(Float)
-EqTestable0(Double)
-EqTestable0(Ordering)
-
-#define EqTestable1(ty) \
-instance Eq a => EqTestable (ty a) where { type EqTest (ty a) = Bool; equal = (==) }
-
-EqTestable1(Maybe)
-EqTestable1([])
-EqTestable1(DV.Vector)
-EqTestable1(S.Stream)
-
-instance (Eq a, DVP.Prim a) => EqTestable (DVP.Vector a) where
-  type EqTest (DVP.Vector a) = Bool
-  equal = (==)
-
-instance (Eq a, Eq b) => EqTestable (a,b) where
-  type EqTest (a,b) = Bool
-  equal = (==)
-
-instance (Eq a, Eq b, Eq c) => EqTestable (a,b,c) where
-  type EqTest (a,b,c) = Bool
-  equal = (==)
-
-instance (Arbitrary a, Show a, EqTestable b) => EqTestable (a -> b) where
   type EqTest (a -> b) = a -> EqTest b
+  equal f g x = equal (f x) (g x)
 
-  equal f g x = f x `equal` g x
+newtype P a = P { unP :: EqTest a }
+
+instance TestData a => Testable (P a) where
+  property (P a) = property a
 
 infix 4 `eq`
-eq :: (Modelled a, EqTestable a) => a -> Model a -> EqTest a
-x `eq` y = x `equal` unmodel y
+eq :: TestData a => a -> Model a -> P a
+eq x y = P (equal x (unmodel y))
+
+class Conclusion p where
+  type Predicate p
 
-class Testable (Prop f) => Predicate f where
-  type Pred f
-  type Prop f
+  predicate :: Predicate p -> p -> p
 
-  infixr 0 ===>
-  (===>) :: Pred f -> f -> Prop f
+instance Conclusion Property where
+  type Predicate Property = Bool
 
-instance Predicate Bool where
-  type Pred Bool = Bool
-  type Prop Bool = Property
+  predicate = (==>)
 
-  (===>) = (==>)
+instance Conclusion p => Conclusion (a -> p) where
+  type Predicate (a -> p) = a -> Predicate p
 
-instance (Arbitrary a, Show a, Predicate f) => Predicate (a -> f) where
-  type Pred (a -> f) = a -> Pred f
-  type Prop (a -> f) = a -> Prop f
+  predicate f p = \x -> predicate (f x) (p x)
 
-  p ===> f = \x -> p x ===> f x
+infixr 0 ===>
+(===>) :: 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)]
@@ -168,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 .. n-1]]
+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
@@ -193,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)
+