Adapt tests to new names and modules
[darcs-mirrors/vector.git] / tests / Utilities.hs
index a84dbeb..e0129f2 100644 (file)
@@ -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 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 )
 
 
 
 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
 
 
 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 (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
 
     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
 
     coarbitrary = coarbitrary . S.toList
 
-class Modelled a where
+class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where
   type Model a
   type Model a
-  -- | Convert a concrete value into an abstract model
   model :: a -> Model a
   unmodel :: Model a -> a
 
   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
 
   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
 
   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.
 
 -- 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
 
   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
 
   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)
 
   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)
 
   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
 
   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
 
   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`
 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))
 
 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 = (==>)
 
 
   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 ===>
 
   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
 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)]
 
 -- 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]
 -- 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
 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
 
 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 [] _ _      = []
 
     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)
+