[project @ 2002-04-24 16:31:37 by simonmar]
[packages/base.git] / Debug / QuickCheck / Poly.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Debug.QuickCheck.Poly
4 -- Copyright : (c) Andy Gill 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (uses Control.Exception, Control.Concurrent)
10 --
11 -- $Id: Poly.hs,v 1.2 2002/04/24 16:31:43 simonmar Exp $
12 --
13 -- This is an attempt to emulate polymorphic types for the
14 -- purposes of testing by using abstract monomorphic types.
15 --
16 -- It is likely that future versions of QuickCheck will
17 -- include some polymorphic emulation testing facility,
18 -- but this module can be used for now.
19 --
20 -----------------------------------------------------------------------------
21
22 module Debug.QuickCheck.Poly
23 ( ALPHA
24 , BETA
25 , GAMMA
26 , OrdALPHA
27 , OrdBETA
28 , OrdGAMMA
29 ) where
30
31 import Debug.QuickCheck
32 import Debug.QuickCheck.Utils
33
34 {- This is the basic pseudo-polymorphic object.
35 - The idea is you can't cheat, and use the integer
36 - directly, but need to use the abstraction.
37 -
38 - We use phantom types (ref: Domain Specific Embedded Compilers,
39 - Daan Leijen & Erik Meijer, 2nd Conference of Domain Specific
40 - Languages, Austin, TX, 1999)
41 -}
42
43 newtype Poly a = Poly Int
44
45 instance Show (Poly a) where
46 show (Poly a) = "_" ++ show a
47
48 instance Arbitrary (Poly a) where
49 arbitrary = sized $ \n -> (choose (1,n) >>= return . Poly)
50 coarbitrary (Poly n) = variant (if n >= 0 then 2*n else 2*(-n) + 1)
51
52 instance Eq a => Eq (Poly a) where
53 (Poly a) == (Poly b) = a == b
54
55 instance Ord a => Ord (Poly a) where
56 (Poly a) `compare` (Poly b) = a `compare` b
57
58 {-
59 - These are what we export, our pseudo-polymorphic instances.
60 -}
61
62 type ALPHA = Poly ALPHA_
63 data ALPHA_ = ALPHA_ deriving (Eq)
64
65 type BETA = Poly BETA_
66 data BETA_ = BETA_ deriving (Eq)
67
68 type GAMMA = Poly GAMMA_
69 data GAMMA_ = GAMMA_ deriving (Eq)
70
71 type OrdALPHA = Poly OrdALPHA_
72 data OrdALPHA_ = OrdALPHA_ deriving (Eq,Ord)
73
74 type OrdBETA = Poly OrdBETA_
75 data OrdBETA_ = OrdBETA_ deriving (Eq,Ord)
76
77 type OrdGAMMA = Poly OrdGAMMA_
78 data OrdGAMMA_ = OrdGAMMA_ deriving (Eq,Ord)
79
80 {-
81 - This is a condition on OrdALPHA, OrdBETA, etc, itself.
82 - It states that all OrdALPHA objects obey total ordering.
83 -}
84
85 prop_OrdPOLY x y = isTotalOrder x y
86 where types = (x :: OrdALPHA, y :: OrdALPHA)