-- 
-- (c) Susumu Katayama
--
{-
rewrite of QuickCheck.Arbitrary in the form specialized for each type
@inproceedings{QuickCheck,
        AUTHOR = "Koen Claessen and John Hughes",
        TITLE  = "{QuickCheck}: a lightweight tool for random testing of {Haskell} programs",
        BOOKTITLE = "ICFP'00: Proceedings of the 5th ACM SIGPLAN International Conference on Functional Programming",
        PAGES  = "268-279",
        ORGANIZATION = "ACM",
        YEAR = 2000 }
The original source is released under BSD-style license.
I (Susumu) reimplemented this because QuickCheck-1 had (and has?) some bugs and QuickCheck-2 was not released, but 
maybe I could import and reuse definitions of Arbitrary of QuickCheck-2.
(But still I am interested in using different generator than StdGen.)
-}
{-# LANGUAGE CPP #-}
module MagicHaskeller.MyCheck where
#ifdef TFRANDOM
import System.Random.TF.Gen
import System.Random.TF.Instances
#else
import System.Random
#endif
import Control.Monad(liftM, liftM2, liftM3, ap)
import Control.Applicative -- necessary for backward compatibility
import Data.Char(ord,chr)
-- import Data.Ratio
import MagicHaskeller.FastRatio
import Prelude hiding (Rational)

-- for bit hacks. Should such stuff be in a different module?
import qualified Data.ByteString as BS
import Data.Word
import Data.Bits

#ifdef TFRANDOM
newtype Gen a = Gen {unGen :: Int -> TFGen -> a}
#else
newtype Gen a = Gen {Gen a -> Int -> StdGen -> a
unGen :: Int -> StdGen -> a}
#endif
type Coarb a b = a -> Gen b -> Gen b

sized :: (Int -> Gen a) -> Gen a
sized :: (Int -> Gen a) -> Gen a
sized Int -> Gen a
fgen = (Int -> StdGen -> a) -> Gen a
forall a. (Int -> StdGen -> a) -> Gen a
Gen ((Int -> StdGen -> a) -> Gen a) -> (Int -> StdGen -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \Int
n StdGen
g -> Gen a -> Int -> StdGen -> a
forall a. Gen a -> Int -> StdGen -> a
unGen (Int -> Gen a
fgen Int
n) Int
n StdGen
g

instance Functor Gen where
    fmap :: (a -> b) -> Gen a -> Gen b
fmap = (a -> b) -> Gen a -> Gen b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Gen where
    pure :: a -> Gen a
pure a
a = (Int -> StdGen -> a) -> Gen a
forall a. (Int -> StdGen -> a) -> Gen a
Gen ((Int -> StdGen -> a) -> Gen a) -> (Int -> StdGen -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \Int
_ StdGen
_ -> a
a
    <*> :: Gen (a -> b) -> Gen a -> Gen b
(<*>)  = Gen (a -> b) -> Gen a -> Gen b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Gen where
    return :: a -> Gen a
return      = a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Gen Int -> StdGen -> a
m >>= :: Gen a -> (a -> Gen b) -> Gen b
>>= a -> Gen b
k = (Int -> StdGen -> b) -> Gen b
forall a. (Int -> StdGen -> a) -> Gen a
Gen ((Int -> StdGen -> b) -> Gen b) -> (Int -> StdGen -> b) -> Gen b
forall a b. (a -> b) -> a -> b
$ \Int
n StdGen
g -> case StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
g of (StdGen
g1,StdGen
g2) -> Gen b -> Int -> StdGen -> b
forall a. Gen a -> Int -> StdGen -> a
unGen (a -> Gen b
k (Int -> StdGen -> a
m Int
n StdGen
g1)) Int
n StdGen
g2

arbitraryR :: Random a => (a, a) -> Gen a
arbitraryR :: (a, a) -> Gen a
arbitraryR (a, a)
bnds = (Int -> StdGen -> a) -> Gen a
forall a. (Int -> StdGen -> a) -> Gen a
Gen ((Int -> StdGen -> a) -> Gen a) -> (Int -> StdGen -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \ Int
_ StdGen
gen -> (a, StdGen) -> a
forall a b. (a, b) -> a
fst ((a, StdGen) -> a) -> (a, StdGen) -> a
forall a b. (a -> b) -> a -> b
$ (a, a) -> StdGen -> (a, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a, a)
bnds StdGen
gen
-- arbitrary :: (Random a, Bounded a) => Gen a
-- arbitrary = arbitraryR (minBound, maxBound)

arbitraryUnit :: Gen ()
arbitraryUnit :: Gen ()
arbitraryUnit = () -> Gen ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
coarbitraryUnit :: Coarb () b
coarbitraryUnit :: Coarb () b
coarbitraryUnit ()
_ = Gen b -> Gen b
forall a. a -> a
id

arbitraryBool :: Gen Bool
arbitraryBool :: Gen Bool
arbitraryBool = (Bool, Bool) -> Gen Bool
forall a. Random a => (a, a) -> Gen a
arbitraryR (Bool
False,Bool
True)
coarbitraryBool :: Coarb Bool b
-- coarbitraryBool b = if b then variant 0 else variant 1
coarbitraryBool :: Coarb Bool b
coarbitraryBool Bool
b (Gen Int -> StdGen -> b
f) = (Int -> StdGen -> b) -> Gen b
forall a. (Int -> StdGen -> a) -> Gen a
Gen ((Int -> StdGen -> b) -> Gen b) -> (Int -> StdGen -> b) -> Gen b
forall a b. (a -> b) -> a -> b
$ \Int
size StdGen
stdgen -> Int -> StdGen -> b
f Int
size (StdGen -> b) -> StdGen -> b
forall a b. (a -> b) -> a -> b
$ case StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
stdgen of (StdGen
g0,StdGen
g1) -> if Bool
b then StdGen
g0 else StdGen
g1

arbitraryInt :: Gen Int
arbitraryInt :: Gen Int
arbitraryInt = Gen Int
forall i. (Random i, Integral i) => Gen i
arbitraryIntegral
coarbitraryInt :: Coarb Int b
coarbitraryInt :: Coarb Int b
coarbitraryInt Int
n = Coarb Int b
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
newvariant Int
n

arbitraryInteger :: Gen Integer
arbitraryInteger :: Gen Integer
arbitraryInteger = Gen Integer
forall i. (Random i, Integral i) => Gen i
arbitraryIntegral
coarbitraryInteger :: Coarb Integer b
coarbitraryInteger :: Coarb Integer b
coarbitraryInteger Integer
n = Coarb Integer b
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
newvariant Integer
n

arbitraryIntegral :: (Random i, Integral i) => Gen i
arbitraryIntegral :: Gen i
arbitraryIntegral = (Int -> Gen i) -> Gen i
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen i) -> Gen i) -> (Int -> Gen i) -> Gen i
forall a b. (a -> b) -> a -> b
$ \Int
n -> (i, i) -> Gen i
forall a. Random a => (a, a) -> Gen a
arbitraryR ( - Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n,  Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n )

-- variant of Test.QuickCheck.variant using divide-and-conquer
logvariant, newvariant :: (Bits i, Integral i) => i -> Gen a -> Gen a
logvariant :: i -> Gen a -> Gen a
logvariant i
0 = Coarb Bool a
forall b. Coarb Bool b
coarbitraryBool Bool
True
#ifdef TFRANDOM
logvariant n | n > 0 = coarbitraryBool False . logvariant (n `shiftR` 32) . coarbitraryBits 32 (n .&. 0xFFFFFFFF)
#else
logvariant i
n | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
0 = Coarb Bool a
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen a -> Gen a) -> (Gen a -> Gen a) -> Gen a -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Gen a -> Gen a
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
logvariant (i
n i -> i -> i
forall a. Integral a => a -> a -> a
`div` i
2) (Gen a -> Gen a) -> (Gen a -> Gen a) -> Gen a -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb Bool a
forall b. Coarb Bool b
coarbitraryBool (i
n i -> i -> i
forall a. Integral a => a -> a -> a
`mod` i
2 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0)
#endif
             | Bool
otherwise = [Char] -> Gen a -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"logvariant: negative argument"
newvariant :: i -> Gen a -> Gen a
newvariant i
n | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
0    = Coarb Bool a
forall b. Coarb Bool b
coarbitraryBool Bool
True  (Gen a -> Gen a) -> (Gen a -> Gen a) -> Gen a -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Gen a -> Gen a
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
logvariant i
n
             | Bool
otherwise = Coarb Bool a
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen a -> Gen a) -> (Gen a -> Gen a) -> Gen a -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Gen a -> Gen a
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
logvariant (-i
1i -> i -> i
forall a. Num a => a -> a -> a
-i
n)

#ifdef TFRANDOM
coarbitraryBits b n (Gen f) = Gen $ \size gen -> f size $ splitn gen b $ fromIntegral n
#endif

arbitraryFloat :: Gen Float
arbitraryFloat :: Gen Float
arbitraryFloat = Gen Float
forall a. RealFloat a => Gen a
arbitraryRealFloat
arbitraryDouble :: Gen Double
arbitraryDouble :: Gen Double
arbitraryDouble = Gen Double
forall a. RealFloat a => Gen a
arbitraryRealFloat

coarbitraryFloat :: Coarb Float b
coarbitraryFloat :: Coarb Float b
coarbitraryFloat = Coarb Float b
forall a b. RealFloat a => Coarb a b
coarbitraryRealFloat
coarbitraryDouble :: Coarb Double b
coarbitraryDouble :: Coarb Double b
coarbitraryDouble = Coarb Double b
forall a b. RealFloat a => Coarb a b
coarbitraryRealFloat

fraction :: Integer -> Integer -> Integer -> a
fraction Integer
a Integer
b Integer
c = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
a a -> a -> a
forall a. Num a => a -> a -> a
+ (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
b a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a -> a
forall a. Num a => a -> a
abs (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
c) a -> a -> a
forall a. Num a => a -> a -> a
+ a
1))

arbitraryRealFloat :: RealFloat a => Gen a
arbitraryRealFloat :: Gen a
arbitraryRealFloat     = (Integer -> Integer -> Integer -> a)
-> Gen Integer -> Gen Integer -> Gen Integer -> Gen a
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Integer -> Integer -> Integer -> a
forall a. Fractional a => Integer -> Integer -> Integer -> a
fraction Gen Integer
arbitraryInteger Gen Integer
arbitraryInteger Gen Integer
arbitraryInteger
coarbitraryRealFloat :: RealFloat a => Coarb a b
coarbitraryRealFloat :: Coarb a b
coarbitraryRealFloat a
x = let (Integer
sig, Int
xpo) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x in Integer -> Gen b -> Gen b
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
newvariant Integer
sig (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen b -> Gen b
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
newvariant Int
xpo

arbitraryChar :: Gen Char
arbitraryChar = do Int
r <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
arbitraryR (Int
0,Int
11)
                   [Gen Char
arbNum, Gen Char
arbNum, Gen Char
arbASC, Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n', Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n', Gen Char
retSpc, Gen Char
retSpc, Gen Char
retSpc, Gen Char
arbLow, Gen Char
arbLow, Gen Char
arbUpp, Gen Char
arbUpp] [Gen Char] -> Int -> Gen Char
forall a. [a] -> Int -> a
!! Int
r
retSpc :: Gen Char
retSpc = Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ' 
arbASC :: Gen Char
arbASC = (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
arbitraryR (Char
' ', Int -> Char
chr Int
126)
arbNum :: Gen Char
arbNum = (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
arbitraryR (Char
'0',Char
'9')
arbLow :: Gen Char
arbLow = (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
arbitraryR (Char
'a',Char
'z')
arbUpp :: Gen Char
arbUpp = (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
arbitraryR (Char
'A',Char
'Z')
coarbitraryChar :: Char -> Gen a -> Gen a
coarbitraryChar Char
c = Int -> Gen a -> Gen a
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
logvariant (Char -> Int
ord Char
c)

arbitraryOrdering :: Gen Ordering
arbitraryOrdering :: Gen Ordering
arbitraryOrdering  = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
arbitraryR (Int
0,Int
2) Gen Int -> (Int -> Gen Ordering) -> Gen Ordering
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ordering -> Gen Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> Gen Ordering)
-> (Int -> Ordering) -> Int -> Gen Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ordering
forall a. Enum a => Int -> a
toEnum
-- Ordering is not an instance of Random!

-- For arbitraryRatio we need a type constraint anyway in order to deal with the div0 case, so we have to do something tricky.
arbitraryRatio :: (Random i, Integral i) => Gen (Ratio i)
arbitraryRatio :: Gen (Ratio i)
arbitraryRatio = (i -> i -> Ratio i) -> Gen i -> Gen i -> Gen (Ratio i)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 i -> i -> Ratio i
forall a. Integral a => a -> a -> Ratio a
(%) Gen i
forall i. (Random i, Integral i) => Gen i
arbitraryIntegral ((i -> i) -> Gen i -> Gen i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i
x->i
1i -> i -> i
forall a. Num a => a -> a -> a
+i -> i
forall a. Num a => a -> a
abs i
x) Gen i
forall i. (Random i, Integral i) => Gen i
arbitraryIntegral)

arbitraryMaybe    :: Gen a -> Gen (Maybe a)
arbitraryMaybe :: Gen a -> Gen (Maybe a)
arbitraryMaybe Gen a
arb = do Bool
b <- Gen Bool
arbitraryBool
                        if Bool
b then Maybe a -> Gen (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just Gen a
arb

arbitraryList     :: Gen a -> Gen [a]
-- arbitraryList  arb = sized $ \n -> arbitraryR (0,n) >>= \n -> sequence $ replicate n arb -- This causes examples bloat rapidly in the case of deeply-nested lists, such as [[[[[[a]]]]]].
#ifdef TFRANDOM
arbitraryList  (Gen f) = sized $ \n -> arbitraryR (0,n) >>= \i -> sequenceSized (lg i + 1) $ replicate i (Gen $ \s g -> f (max 1 (lg s * k)) g)

sequenceSized :: Int -> [Gen a] -> Gen [a]
sequenceSized bits arbs = Gen $ \n g ->  zipWith (\(Gen m) g -> m n g) arbs $ map (splitn g bits) [0..]
#else
arbitraryList :: Gen a -> Gen [a]
arbitraryList  (Gen Int -> StdGen -> a
f) = (Int -> Gen [a]) -> Gen [a]
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen [a]) -> Gen [a]) -> (Int -> Gen [a]) -> Gen [a]
forall a b. (a -> b) -> a -> b
$ \Int
n -> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
arbitraryR (Int
0,Int
n) Gen Int -> (Int -> Gen [a]) -> Gen [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> [Gen a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Gen a] -> Gen [a]) -> [Gen a] -> Gen [a]
forall a b. (a -> b) -> a -> b
$ Int -> Gen a -> [Gen a]
forall a. Int -> a -> [a]
replicate Int
i ((Int -> StdGen -> a) -> Gen a
forall a. (Int -> StdGen -> a) -> Gen a
Gen ((Int -> StdGen -> a) -> Gen a) -> (Int -> StdGen -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \Int
s StdGen
g -> Int -> StdGen -> a
f (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int
forall a b. (Integral a, Integral b) => a -> b
lg Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k)) StdGen
g)
#endif
k :: Int
k = Int
1

-- bitvector algorithm for computing log2, translated from http://graphics.stanford.edu/~seander/bithacks.html#IntegerLogDeBruijn.
-- maybe overkill?
lg :: (Integral a, Integral b) => a -> b
lg :: a -> b
lg = Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> b) -> (a -> Word8) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word8
lg' (Word32 -> Word8) -> (a -> Word32) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
lg' :: Word32 -> Word8
lg' :: Word32 -> Word8
lg' Word32
v = let v2 :: Word32
v2  = Word32
v   Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v   Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1)
            v4 :: Word32
v4  = Word32
v2  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v2  Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
            v8 :: Word32
v8  = Word32
v4  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v4  Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4)
            v16 :: Word32
v16 = Word32
v8  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v8  Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8)
            v32 :: Word32
v32 = Word32
v16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v16 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16)
        in ByteString
multiplyDeBruijnBitPosition ByteString -> Int -> Word8
`BS.index` Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
v32 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
0x07C4ACDD) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
27)
multiplyDeBruijnBitPosition :: BS.ByteString
multiplyDeBruijnBitPosition :: ByteString
multiplyDeBruijnBitPosition = [Word8] -> ByteString
BS.pack [ Word8
0, Word8
9, Word8
1, Word8
10, Word8
13, Word8
21, Word8
2, Word8
29, Word8
11, Word8
14, Word8
16, Word8
18, Word8
22, Word8
25, Word8
3, Word8
30, Word8
8, Word8
12, Word8
20, Word8
28, Word8
15, Word8
17, Word8
24, Word8
7, Word8
19, Word8
27, Word8
23, Word8
6, Word8
26, Word8
5, Word8
4, Word8
31 ]


arbitraryPair     :: Gen a -> Gen b -> Gen (a,b)
arbitraryPair :: Gen a -> Gen b -> Gen (a, b)
arbitraryPair      = (a -> b -> (a, b)) -> Gen a -> Gen b -> Gen (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)

arbitraryEither   :: Gen a -> Gen b -> Gen (Either a b)
arbitraryEither :: Gen a -> Gen b -> Gen (Either a b)
arbitraryEither Gen a
arb0 Gen b
arb1 = do Bool
b <- Gen Bool
arbitraryBool
                               if Bool
b then (a -> Either a b) -> Gen a -> Gen (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either a b
forall a b. a -> Either a b
Left Gen a
arb0 else (b -> Either a b) -> Gen b -> Gen (Either a b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Either a b
forall a b. b -> Either a b
Right Gen b
arb1

arbitraryTriplet  :: Gen a -> Gen b -> Gen c -> Gen (a,b,c)
arbitraryTriplet :: Gen a -> Gen b -> Gen c -> Gen (a, b, c)
arbitraryTriplet   = (a -> b -> c -> (a, b, c))
-> Gen a -> Gen b -> Gen c -> Gen (a, b, c)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,)

arbitraryFun :: Coarb a b -> Gen b -> Gen (a->b)
arbitraryFun :: Coarb a b -> Gen b -> Gen (a -> b)
arbitraryFun Coarb a b
coarb Gen b
arb = (Int -> StdGen -> a -> b) -> Gen (a -> b)
forall a. (Int -> StdGen -> a) -> Gen a
Gen (\Int
n StdGen
r a
a -> Gen b -> Int -> StdGen -> b
forall a. Gen a -> Int -> StdGen -> a
unGen (Coarb a b
coarb a
a Gen b
arb) Int
n StdGen
r)

arbitraryRational :: Gen Rational
arbitraryRational :: Gen Rational
arbitraryRational = Gen Rational
forall a. Arbitrary a => Gen a
arbitrary


coarbitraryOrdering :: Coarb Ordering b
#ifdef TFRANDOM
coarbitraryOrdering = coarbitraryBits 2 . fromEnum
#else
coarbitraryOrdering :: Coarb Ordering b
coarbitraryOrdering Ordering
x = case Ordering
x of Ordering
LT -> Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
True
                                  Ordering
EQ -> Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
True
                                  Ordering
GT -> Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
False
#endif
coarbitraryList :: Coarb a b -> Coarb [a] b
coarbitraryList :: Coarb a b -> Coarb [a] b
coarbitraryList Coarb a b
_     []     = Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
True
coarbitraryList Coarb a b
coarb (a
x:[a]
xs) = Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb a b
coarb a
x (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb a b -> Coarb [a] b
forall a b. Coarb a b -> Coarb [a] b
coarbitraryList Coarb a b
coarb [a]
xs

coarbitraryMaybe :: Coarb a b -> Coarb (Maybe a) b
coarbitraryMaybe :: Coarb a b -> Coarb (Maybe a) b
coarbitraryMaybe Coarb a b
_     Maybe a
Nothing  = Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
True
coarbitraryMaybe Coarb a b
coarb (Just a
x) = Coarb Bool b
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb a b
coarb a
x

coarbitraryEither :: Coarb a c -> Coarb b c -> Coarb (Either a b) c
coarbitraryEither :: Coarb a c -> Coarb b c -> Coarb (Either a b) c
coarbitraryEither Coarb a c
coarb0 Coarb b c
_      (Left a
x)  = Coarb Bool c
forall b. Coarb Bool b
coarbitraryBool Bool
True (Gen c -> Gen c) -> (Gen c -> Gen c) -> Gen c -> Gen c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb a c
coarb0 a
x
coarbitraryEither Coarb a c
_      Coarb b c
coarb1 (Right b
y) = Coarb Bool c
forall b. Coarb Bool b
coarbitraryBool Bool
False (Gen c -> Gen c) -> (Gen c -> Gen c) -> Gen c -> Gen c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb b c
coarb1 b
y

coarbitraryRatio :: (Bits a, Integral a) => Coarb (Ratio a) b
coarbitraryRatio :: Coarb (Ratio a) b
coarbitraryRatio Ratio a
r = a -> Gen b -> Gen b
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
newvariant (Ratio a -> a
forall a. Integral a => Ratio a -> a
numerator Ratio a
r) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Gen b -> Gen b
forall i a. (Bits i, Integral i) => i -> Gen a -> Gen a
logvariant (Ratio a -> a
forall a. Integral a => Ratio a -> a
denominator Ratio a
r)

coarbitraryPair :: Coarb a c -> Coarb b c -> Coarb (a,b) c
coarbitraryPair :: Coarb a c -> Coarb b c -> Coarb (a, b) c
coarbitraryPair Coarb a c
coarb0 Coarb b c
coarb1 (a
a,b
b) = Coarb a c
coarb0 a
a (Gen c -> Gen c) -> (Gen c -> Gen c) -> Gen c -> Gen c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb b c
coarb1 b
b

coarbitraryTriplet :: Coarb a d -> Coarb b d -> Coarb c d -> Coarb (a,b,c) d
coarbitraryTriplet :: Coarb a d -> Coarb b d -> Coarb c d -> Coarb (a, b, c) d
coarbitraryTriplet Coarb a d
coarb0 Coarb b d
coarb1 Coarb c d
coarb2 (a
a,b
b,c
c) = Coarb a d
coarb0 a
a (Gen d -> Gen d) -> (Gen d -> Gen d) -> Gen d -> Gen d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb b d
coarb1 b
b (Gen d -> Gen d) -> (Gen d -> Gen d) -> Gen d -> Gen d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coarb c d
coarb2 c
c

coarbitraryFun :: Gen a -> Coarb b d -> Coarb (a->b) d
-- This is based on QuickCheck-1, and quite lightweight.
coarbitraryFun :: Gen a -> Coarb b d -> Coarb (a -> b) d
coarbitraryFun Gen a
arb Coarb b d
coarb a -> b
f Gen d
gen = Gen a
arb Gen a -> (a -> Gen d) -> Gen d
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Coarb b d
coarb (a -> b
f a
x) Gen d
gen

-- This is a definition based on QuickCheck-2:
-- coarbitraryFun arb coarb f gen = arbitraryList arb >>= \xs -> coarbitraryList coarb (map f xs) gen

-- This does even heavier check.
-- coarbitraryFun arb coarb f gen = (sized $ \n -> sequence $ replicate n arb) >>= \xs -> coarbitraryList coarb (map f xs) gen

class Arbitrary a where
    arbitrary   :: Gen a
class Coarbitrary a where
    coarbitrary :: a -> Gen b -> Gen b

instance Arbitrary () where
    arbitrary :: Gen ()
arbitrary = Gen ()
arbitraryUnit
instance Coarbitrary () where
    coarbitrary :: () -> Gen b -> Gen b
coarbitrary = () -> Gen b -> Gen b
forall b. () -> Gen b -> Gen b
coarbitraryUnit

instance Arbitrary Bool where
    arbitrary :: Gen Bool
arbitrary = Gen Bool
arbitraryBool
instance Coarbitrary Bool where
    coarbitrary :: Bool -> Gen b -> Gen b
coarbitrary = Bool -> Gen b -> Gen b
forall b. Coarb Bool b
coarbitraryBool

instance Arbitrary Int where
    arbitrary :: Gen Int
arbitrary = Gen Int
arbitraryInt
instance Coarbitrary Int where
    coarbitrary :: Int -> Gen b -> Gen b
coarbitrary = Int -> Gen b -> Gen b
forall b. Int -> Gen b -> Gen b
coarbitraryInt

instance Arbitrary Integer where
    arbitrary :: Gen Integer
arbitrary = Gen Integer
arbitraryInteger
instance Coarbitrary Integer where
    coarbitrary :: Integer -> Gen b -> Gen b
coarbitrary = Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
coarbitraryInteger

instance Arbitrary Float where
    arbitrary :: Gen Float
arbitrary = Gen Float
arbitraryFloat
instance Coarbitrary Float where
    coarbitrary :: Float -> Gen b -> Gen b
coarbitrary = Float -> Gen b -> Gen b
forall b. Float -> Gen b -> Gen b
coarbitraryFloat

instance Arbitrary Double where
    arbitrary :: Gen Double
arbitrary = Gen Double
arbitraryDouble
instance Coarbitrary Double where
    coarbitrary :: Double -> Gen b -> Gen b
coarbitrary = Double -> Gen b -> Gen b
forall b. Double -> Gen b -> Gen b
coarbitraryDouble

instance Arbitrary Char where
    arbitrary :: Gen Char
arbitrary = Gen Char
arbitraryChar
instance Coarbitrary Char where
    coarbitrary :: Char -> Gen b -> Gen b
coarbitrary = Char -> Gen b -> Gen b
forall b. Char -> Gen b -> Gen b
coarbitraryChar

instance Arbitrary Ordering where
    arbitrary :: Gen Ordering
arbitrary = Gen Ordering
arbitraryOrdering
instance Coarbitrary Ordering where
    coarbitrary :: Ordering -> Gen b -> Gen b
coarbitrary = Ordering -> Gen b -> Gen b
forall b. Ordering -> Gen b -> Gen b
coarbitraryOrdering

instance Arbitrary a => Arbitrary (Maybe a) where
    arbitrary :: Gen (Maybe a)
arbitrary = Gen a -> Gen (Maybe a)
forall a. Gen a -> Gen (Maybe a)
arbitraryMaybe Gen a
forall a. Arbitrary a => Gen a
arbitrary
instance Coarbitrary a => Coarbitrary (Maybe a) where
    coarbitrary :: Maybe a -> Gen b -> Gen b
coarbitrary = Coarb a b -> Maybe a -> Gen b -> Gen b
forall a b. Coarb a b -> Coarb (Maybe a) b
coarbitraryMaybe Coarb a b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary

instance Arbitrary a => Arbitrary [a] where
    arbitrary :: Gen [a]
arbitrary = Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
arbitraryList Gen a
forall a. Arbitrary a => Gen a
arbitrary
instance Coarbitrary a => Coarbitrary [a] where
    coarbitrary :: [a] -> Gen b -> Gen b
coarbitrary = Coarb a b -> [a] -> Gen b -> Gen b
forall a b. Coarb a b -> Coarb [a] b
coarbitraryList Coarb a b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary

instance (Arbitrary a, Arbitrary b) => Arbitrary (a,b) where
    arbitrary :: Gen (a, b)
arbitrary = Gen a -> Gen b -> Gen (a, b)
forall a b. Gen a -> Gen b -> Gen (a, b)
arbitraryPair Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
instance (Coarbitrary a, Coarbitrary b) => Coarbitrary (a,b) where
    coarbitrary :: (a, b) -> Gen b -> Gen b
coarbitrary = Coarb a b -> Coarb b b -> (a, b) -> Gen b -> Gen b
forall a c b. Coarb a c -> Coarb b c -> Coarb (a, b) c
coarbitraryPair Coarb a b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary Coarb b b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary

instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
    arbitrary :: Gen (Either a b)
arbitrary = Gen a -> Gen b -> Gen (Either a b)
forall a b. Gen a -> Gen b -> Gen (Either a b)
arbitraryEither Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
instance (Coarbitrary a, Coarbitrary b) => Coarbitrary (Either a b) where
    coarbitrary :: Either a b -> Gen b -> Gen b
coarbitrary = Coarb a b -> Coarb b b -> Either a b -> Gen b -> Gen b
forall a c b. Coarb a c -> Coarb b c -> Coarb (Either a b) c
coarbitraryEither Coarb a b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary Coarb b b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary

instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (a,b,c) where
    arbitrary :: Gen (a, b, c)
arbitrary = Gen a -> Gen b -> Gen c -> Gen (a, b, c)
forall a b c. Gen a -> Gen b -> Gen c -> Gen (a, b, c)
arbitraryTriplet Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary Gen c
forall a. Arbitrary a => Gen a
arbitrary
instance (Coarbitrary a, Coarbitrary b, Coarbitrary c) => Coarbitrary (a,b,c) where
    coarbitrary :: (a, b, c) -> Gen b -> Gen b
coarbitrary = Coarb a b -> Coarb b b -> Coarb c b -> (a, b, c) -> Gen b -> Gen b
forall a d b c.
Coarb a d -> Coarb b d -> Coarb c d -> Coarb (a, b, c) d
coarbitraryTriplet Coarb a b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary Coarb b b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary Coarb c b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary

instance  (Coarbitrary a, Arbitrary b) => Arbitrary (a->b) where
    arbitrary :: Gen (a -> b)
arbitrary = Coarb a b -> Gen b -> Gen (a -> b)
forall a b. Coarb a b -> Gen b -> Gen (a -> b)
arbitraryFun Coarb a b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
instance  (Arbitrary a, Coarbitrary b) => Coarbitrary (a->b) where
    coarbitrary :: (a -> b) -> Gen b -> Gen b
coarbitrary = Gen a -> Coarb b b -> (a -> b) -> Gen b -> Gen b
forall a b d. Gen a -> Coarb b d -> Coarb (a -> b) d
coarbitraryFun Gen a
forall a. Arbitrary a => Gen a
arbitrary Coarb b b
forall a b. Coarbitrary a => a -> Gen b -> Gen b
coarbitrary

instance (Integral i, Random i) => Arbitrary (Ratio i) where
    arbitrary :: Gen (Ratio i)
arbitrary  = Gen (Ratio i)
forall i. (Random i, Integral i) => Gen (Ratio i)
arbitraryRatio
instance (Integral i, Bits i) => Coarbitrary (Ratio i) where
    coarbitrary :: Ratio i -> Gen b -> Gen b
coarbitrary = Ratio i -> Gen b -> Gen b
forall a b. (Bits a, Integral a) => Coarb (Ratio a) b
coarbitraryRatio