cec38da453b6a9e85555c2ba098138e035bbe5cc
[darcs-mirrors/vector.git] / tests / Utilities.hs
1 module Utilities where
2
3 import Test.QuickCheck
4
5 import qualified Data.Vector as DV
6 import qualified Data.Vector.Generic as DVG
7 import qualified Data.Vector.Primitive as DVP
8 import qualified Data.Vector.Fusion.Stream as S
9
10
11 instance Show a => Show (S.Stream a) where
12 show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)
13
14
15 instance Arbitrary a => Arbitrary (DV.Vector a) where
16 arbitrary = fmap DV.fromList arbitrary
17 coarbitrary = coarbitrary . DV.toList
18
19 instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
20 arbitrary = fmap DVP.fromList arbitrary
21 coarbitrary = coarbitrary . DVP.toList
22
23 instance Arbitrary a => Arbitrary (S.Stream a) where
24 arbitrary = fmap S.fromList arbitrary
25 coarbitrary = coarbitrary . S.toList
26
27
28 class Model a b | a -> b where
29 -- | Convert a concrete value into an abstract model
30 model :: a -> b
31
32 -- The meat of the models
33 instance Model (DV.Vector a) [a] where model = DV.toList
34 instance DVP.Prim a => Model (DVP.Vector a) [a] where model = DVP.toList
35
36 -- Identity models
37 instance Model Bool Bool where model = id
38 instance Model Int Int where model = id
39 instance Model Float Float where model = id
40 instance Model Double Double where model = id
41 instance Model Ordering Ordering where model = id
42
43 -- Functorish models
44 -- All of these need UndecidableInstances although they are actually well founded. Oh well.
45 instance Model a b => Model (Maybe a) (Maybe b) where model = fmap model
46 instance (Model a a', Model b b') => Model (a, b) (a', b') where model (a, b) = (model a, model b)
47 instance (Model a a', Model b b', Model c c') => Model (a, b, c) (a', b', c') where model (a, b, c) = (model a, model b, model c)
48 instance (Model c a, Model b d) => Model (a -> b) (c -> d) where model f = model . f . model
49
50
51 eq0 f g = model f == g
52 eq1 f g = \a -> model (f a) == g (model a)
53 eq2 f g = \a b -> model (f a b) == g (model a) (model b)
54 eq3 f g = \a b c -> model (f a b c) == g (model a) (model b) (model c)
55 eq4 f g = \a b c d -> model (f a b c d) == g (model a) (model b) (model c) (model d)
56
57 eqNotNull1 f g = \a -> (not (DVG.null a)) ==> eq1 f g a
58 eqNotNull2 f g = \a b -> (not (DVG.null b)) ==> eq2 f g a b
59 eqNotNull3 f g = \a b c -> (not (DVG.null c)) ==> eq3 f g a b c
60 eqNotNull4 f g = \a b c d -> (not (DVG.null d)) ==> eq4 f g a b c d