```{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
#endif
-- | Types to help with testing polymorphic properties.
--
-- Types 'A', 'B' and 'C' are @newtype@ wrappers around 'Integer' that
-- implement 'Eq', 'Show', 'Arbitrary' and 'CoArbitrary'. Types
-- 'OrdA', 'OrdB' and 'OrdC' also implement 'Ord' and 'Num'.
--
-- polymorphic properties.
module Test.QuickCheck.Poly
( A(..), B(..), C(..)
, OrdA(..), OrdB(..), OrdC(..)
)
where

--------------------------------------------------------------------------
-- imports

import Test.QuickCheck.Arbitrary

--------------------------------------------------------------------------
-- polymorphic A, B, C (in Eq)

-- A

newtype A = A{ unA :: Integer }
deriving ( Eq )

instance Show A where
showsPrec n (A x) = showsPrec n x

instance Arbitrary A where
arbitrary    = (A . (+1) . abs) `fmap` arbitrary
shrink (A x) = [ A x' | x' <- shrink x, x' > 0 ]

instance CoArbitrary A where
coarbitrary = coarbitrary . unA

-- B

newtype B = B{ unB :: Integer }
deriving ( Eq )

instance Show B where
showsPrec n (B x) = showsPrec n x

instance Arbitrary B where
arbitrary    = (B . (+1) . abs) `fmap` arbitrary
shrink (B x) = [ B x' | x' <- shrink x, x' > 0 ]

instance CoArbitrary B where
coarbitrary = coarbitrary . unB

-- C

newtype C = C{ unC :: Integer }
deriving ( Eq )

instance Show C where
showsPrec n (C x) = showsPrec n x

instance Arbitrary C where
arbitrary    = (C . (+1) . abs) `fmap` arbitrary
shrink (C x) = [ C x' | x' <- shrink x, x' > 0 ]

instance CoArbitrary C where
coarbitrary = coarbitrary . unC

--------------------------------------------------------------------------
-- polymorphic OrdA, OrdB, OrdC (in Eq, Ord)

-- OrdA

newtype OrdA = OrdA{ unOrdA :: Integer }
deriving ( Eq, Ord )

liftOrdA
:: (Integer -> Integer)
-> OrdA -> OrdA
liftOrdA f (OrdA x) = OrdA (f x)

liftOrdA2
:: (Integer -> Integer -> Integer)
-> OrdA -> OrdA -> OrdA
liftOrdA2 f (OrdA x) (OrdA y) = OrdA (f x y)

instance Num OrdA where
(+)         = liftOrdA2 (+)
(*)         = liftOrdA2 (*)
(-)         = liftOrdA2 (-)
negate      = liftOrdA negate
abs         = liftOrdA abs
signum      = liftOrdA signum
fromInteger = OrdA . fromInteger

instance Show OrdA where
showsPrec n (OrdA x) = showsPrec n x

instance Arbitrary OrdA where
arbitrary       = (OrdA . (+1) . abs) `fmap` arbitrary
shrink (OrdA x) = [ OrdA x' | x' <- shrink x, x' > 0 ]

instance CoArbitrary OrdA where
coarbitrary = coarbitrary . unOrdA

-- OrdB

newtype OrdB = OrdB{ unOrdB :: Integer }
deriving ( Eq, Ord )

liftOrdB
:: (Integer -> Integer)
-> OrdB -> OrdB
liftOrdB f (OrdB x) = OrdB (f x)

liftOrdB2
:: (Integer -> Integer -> Integer)
-> OrdB -> OrdB -> OrdB
liftOrdB2 f (OrdB x) (OrdB y) = OrdB (f x y)

instance Num OrdB where
(+)         = liftOrdB2 (+)
(*)         = liftOrdB2 (*)
(-)         = liftOrdB2 (-)
negate      = liftOrdB negate
abs         = liftOrdB abs
signum      = liftOrdB signum
fromInteger = OrdB . fromInteger

instance Show OrdB where
showsPrec n (OrdB x) = showsPrec n x

instance Arbitrary OrdB where
arbitrary       = (OrdB . (+1) . abs) `fmap` arbitrary
shrink (OrdB x) = [ OrdB x' | x' <- shrink x, x' > 0 ]

instance CoArbitrary OrdB where
coarbitrary = coarbitrary . unOrdB

-- OrdC

newtype OrdC = OrdC{ unOrdC :: Integer }
deriving ( Eq, Ord )

liftOrdC
:: (Integer -> Integer)
-> OrdC -> OrdC
liftOrdC f (OrdC x) = OrdC (f x)

liftOrdC2
:: (Integer -> Integer -> Integer)
-> OrdC -> OrdC -> OrdC
liftOrdC2 f (OrdC x) (OrdC y) = OrdC (f x y)

instance Num OrdC where
(+)         = liftOrdC2 (+)
(*)         = liftOrdC2 (*)
(-)         = liftOrdC2 (-)
negate      = liftOrdC negate
abs         = liftOrdC abs
signum      = liftOrdC signum
fromInteger = OrdC . fromInteger

instance Show OrdC where
showsPrec n (OrdC x) = showsPrec n x

instance Arbitrary OrdC where
arbitrary       = (OrdC . (+1) . abs) `fmap` arbitrary
shrink (OrdC x) = [ OrdC x' | x' <- shrink x, x' > 0 ]

instance CoArbitrary OrdC where
coarbitrary = coarbitrary . unOrdC

--------------------------------------------------------------------------
-- the end.
```