Test properties for all types of unboxed vector
[darcs-mirrors/vector.git] / tests / Utilities.hs
1 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, UndecidableInstances #-}
2
3 module Utilities where
4
5 import Test.QuickCheck
6
7 import qualified Data.Vector as DV
8 import qualified Data.Vector.IVector as DVI
9 import qualified Data.Vector.Unboxed as DVU
10 import qualified Data.Vector.Unboxed.Unbox as DVUU
11 import qualified Data.Vector.Fusion.Stream as S
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 coarbitrary = coarbitrary . DV.toList
21
22 instance (Arbitrary a, DVUU.Unbox a) => Arbitrary (DVU.Vector a) where
23 arbitrary = fmap DVU.fromList arbitrary
24 coarbitrary = coarbitrary . DVU.toList
25
26 instance Arbitrary a => Arbitrary (S.Stream a) where
27 arbitrary = fmap S.fromList arbitrary
28 coarbitrary = coarbitrary . S.toList
29
30
31 class Model a b | a -> b where
32 -- | Convert a concrete value into an abstract model
33 model :: a -> b
34
35 -- The meat of the models
36 instance Model (DV.Vector a) [a] where model = DV.toList
37 instance DVUU.Unbox a => Model (DVU.Vector a) [a] where model = DVU.toList
38
39 -- Identity models
40 instance Model Bool Bool where model = id
41 instance Model Int Int where model = id
42 instance Model Float Float where model = id
43 instance Model Double Double where model = id
44 instance Model Ordering Ordering where model = id
45
46 -- Functorish models
47 -- All of these need UndecidableInstances although they are actually well founded. Oh well.
48 instance Model a b => Model (Maybe a) (Maybe b) where model = fmap model
49 instance (Model a c, Model b d) => Model (a, b) (c, d) where model (a, b) = (model a, model b)
50 instance (Model c a, Model b d) => Model (a -> b) (c -> d) where model f = model . f . model
51
52
53 eq0 f g = model f == g
54 eq1 f g = \a -> model (f a) == g (model a)
55 eq2 f g = \a b -> model (f a b) == g (model a) (model b)
56 eq3 f g = \a b c -> model (f a b c) == g (model a) (model b) (model c)
57
58 eqNotNull1 f g = \x -> (not (DVI.null x)) ==> eq1 f g x
59 eqNotNull2 f g = \x y -> (not (DVI.null y)) ==> eq2 f g x y
60 eqNotNull3 f g = \x y z -> (not (DVI.null z)) ==> eq3 f g x y z