    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Test.QuickCheck.Poly
    -- Copyright   :  (c) Andy Gill 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This is an attempt to emulate polymorphic types for the
    -- purposes of testing by using abstract monomorphic types.
    --
    -- It is likely that future versions of QuickCheck will
    -- include some polymorphic emulation testing facility,
    -- but this module can be used for now.
    --
    -----------------------------------------------------------------------------

    module Test.QuickCheck.Poly
      ( ALPHA
      , BETA
      , GAMMA
      , OrdALPHA
      , OrdBETA
      , OrdGAMMA
      ) where

    import Prelude

    import Test.QuickCheck
    import Test.QuickCheck.Utils

    {- This is the basic pseudo-polymorphic object.
     - The idea is you can't cheat, and use the integer
     - directly, but need to use the abstraction.
     -
     - We use phantom types (ref: Domain Specific Embedded Compilers,
     - Daan Leijen & Erik Meijer, 2nd Conference of Domain Specific
     - Languages, Austin, TX, 1999)
     -}

    newtype Poly a = Poly Int

    instance Show (Poly a) where
            show (Poly a) = "_" ++ show a

    instance Arbitrary (Poly a) where
        arbitrary            = sized $ \n -> (choose (1,n) >>= return . Poly)
        coarbitrary (Poly n) = variant (if n >= 0 then 2*n else 2*(-n) + 1)

    instance Eq a => Eq (Poly a) where
            (Poly a) == (Poly b) = a == b

    instance Ord a => Ord (Poly a) where
            (Poly a) `compare` (Poly b) = a `compare` b

    {-
     - These are what we export, our pseudo-polymorphic instances.
     -}

    type ALPHA = Poly ALPHA_
    data ALPHA_ = ALPHA_ deriving (Eq)

    type BETA = Poly BETA_
    data BETA_ = BETA_ deriving (Eq)

    type GAMMA = Poly GAMMA_
    data GAMMA_ = GAMMA_ deriving (Eq)

    type OrdALPHA = Poly OrdALPHA_
    data OrdALPHA_ = OrdALPHA_ deriving (Eq,Ord)

    type OrdBETA = Poly OrdBETA_
    data OrdBETA_ = OrdBETA_ deriving (Eq,Ord)

    type OrdGAMMA = Poly OrdGAMMA_
    data OrdGAMMA_ = OrdGAMMA_ deriving (Eq,Ord)

    {-
     - This is a condition on OrdALPHA, OrdBETA, etc, itself.
     - It states that all OrdALPHA objects obey total ordering.
     -}

    prop_OrdPOLY x y = isTotalOrder x y
        where types = (x :: OrdALPHA, y :: OrdALPHA)