{-# LANGUAGE CPP #-}
#ifndef NO_ST_MONAD
{-# LANGUAGE Rank2Types #-}
#endif
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Safe #-}
#endif
module Test.QuickCheck.Gen where
import Test.QuickCheck.Exception
import System.Random
( Random
, random
, randomR
, split
)
import Control.Monad
( ap
, replicateM
, filterM
)
import Control.Monad.Fix
( MonadFix(..) )
import Control.Applicative
( Applicative(..) )
import Test.QuickCheck.Random
import Data.List (sortBy)
import Data.Ord
import Data.Maybe
#ifndef NO_SPLITMIX
import System.Random.SplitMix(bitmaskWithRejection64', nextInteger, nextDouble, nextFloat, SMGen)
#endif
import Data.Word
import Data.Int
import Data.Bits
import Control.Applicative
#ifndef NO_CALLSTACK
import GHC.Stack
#define WITHCALLSTACK(ty) HasCallStack => ty
#else
#define WITHCALLSTACK(ty) ty
#endif
newtype Gen a = MkGen{
forall a. Gen a -> QCGen -> Int -> a
unGen :: QCGen -> Int -> a
}
instance Functor Gen where
fmap :: forall a b. (a -> b) -> Gen a -> Gen b
fmap a -> b
f (MkGen QCGen -> Int -> a
h) =
(QCGen -> Int -> b) -> Gen b
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
n -> a -> b
f (QCGen -> Int -> a
h QCGen
r Int
n))
instance Applicative Gen where
pure :: forall a. a -> Gen a
pure a
x =
(QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
_ Int
_ -> a
x)
<*> :: forall a b. 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
#ifndef NO_EXTRA_METHODS_IN_APPLICATIVE
Gen a
_ *> :: forall a b. Gen a -> Gen b -> Gen b
*> Gen b
m = Gen b
m
Gen a
m <* :: forall a b. Gen a -> Gen b -> Gen a
<* Gen b
_ = Gen a
m
#endif
instance Monad Gen where
return :: forall a. a -> Gen a
return = a -> Gen a
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
MkGen QCGen -> Int -> a
m >>= :: forall a b. Gen a -> (a -> Gen b) -> Gen b
>>= a -> Gen b
k =
(QCGen -> Int -> b) -> Gen b
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
n ->
case QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
split QCGen
r of
(QCGen
r1, QCGen
r2) ->
let MkGen QCGen -> Int -> b
m' = a -> Gen b
k (QCGen -> Int -> a
m QCGen
r1 Int
n)
in QCGen -> Int -> b
m' QCGen
r2 Int
n
)
>> :: forall a b. Gen a -> Gen b -> Gen b
(>>) = Gen a -> Gen b -> Gen b
forall a b. Gen a -> Gen b -> Gen b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
instance MonadFix Gen where
mfix :: forall a. (a -> Gen a) -> Gen a
mfix a -> Gen a
f =
(QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n ->
let a :: a
a = Gen a -> QCGen -> Int -> a
forall a. Gen a -> QCGen -> Int -> a
unGen (a -> Gen a
f a
a) QCGen
r Int
n
in a
a
variant :: Integral n => n -> Gen a -> Gen a
variant :: forall n a. Integral n => n -> Gen a -> Gen a
variant n
k (MkGen QCGen -> Int -> a
g) = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
n -> QCGen -> Int -> a
g (Integer -> QCGen -> QCGen
forall a. Splittable a => Integer -> a -> a
integerVariant (n -> Integer
forall a. Integral a => a -> Integer
toInteger n
k) (QCGen -> QCGen) -> QCGen -> QCGen
forall a b. (a -> b) -> a -> b
$! QCGen
r) Int
n)
sized :: (Int -> Gen a) -> Gen a
sized :: forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen a
f = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
n -> let MkGen QCGen -> Int -> a
m = Int -> Gen a
f Int
n in QCGen -> Int -> a
m QCGen
r Int
n)
getSize :: Gen Int
getSize :: Gen Int
getSize = (Int -> Gen Int) -> Gen Int
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
resize :: WITHCALLSTACK(Int -> Gen a -> Gen a)
resize :: forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
n Gen a
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"Test.QuickCheck.resize: negative size"
resize Int
n (MkGen QCGen -> Int -> a
g) = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_ -> QCGen -> Int -> a
g QCGen
r Int
n)
scale :: (Int -> Int) -> Gen a -> Gen a
scale :: forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
f Gen a
g = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized (\Int
n -> Int -> Gen a -> Gen a
forall a. HasCallStack => Int -> Gen a -> Gen a
resize (Int -> Int
f Int
n) Gen a
g)
choose :: Random a => (a,a) -> Gen a
choose :: forall a. Random a => (a, a) -> Gen a
choose (a, a)
rng = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_ -> let (a
x,QCGen
_) = (a, a) -> QCGen -> (a, QCGen)
forall g. RandomGen g => (a, a) -> g -> (a, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a, a)
rng QCGen
r in a
x)
chooseAny :: Random a => Gen a
chooseAny :: forall a. Random a => Gen a
chooseAny = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_ -> let (a
x,QCGen
_) = QCGen -> (a, QCGen)
forall g. RandomGen g => g -> (a, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random QCGen
r in a
x)
chooseEnum :: Enum a => (a, a) -> Gen a
chooseEnum :: forall a. Enum a => (a, a) -> Gen a
chooseEnum (a
lo, a
hi) =
(Int -> a) -> Gen Int -> Gen a
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
forall a. Enum a => Int -> a
toEnum ((Int, Int) -> Gen Int
chooseInt (a -> Int
forall a. Enum a => a -> Int
fromEnum a
lo, a -> Int
forall a. Enum a => a -> Int
fromEnum a
hi))
chooseInt :: (Int, Int) -> Gen Int
chooseInt :: (Int, Int) -> Gen Int
chooseInt = (Int, Int) -> Gen Int
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral
{-# INLINEABLE chooseBoundedIntegral #-}
chooseBoundedIntegral :: (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral :: forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral (a
lo, a
hi)
#ifndef NO_SPLITMIX
| a -> Integer
forall a. Integral a => a -> Integer
toInteger a
mn Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64) Bool -> Bool -> Bool
&&
a -> Integer
forall a. Integral a => a -> Integer
toInteger a
mx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64) =
(Int64 -> a) -> Gen Int64 -> Gen a
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64, Int64) -> Gen Int64
chooseInt64 (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
lo, a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
hi))
| a -> Integer
forall a. Integral a => a -> Integer
toInteger a
mn Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
minBound :: Word64) Bool -> Bool -> Bool
&&
a -> Integer
forall a. Integral a => a -> Integer
toInteger a
mx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64) =
(Word64 -> a) -> Gen Word64 -> Gen a
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64, Word64) -> Gen Word64
chooseWord64 (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
lo, a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
hi))
#endif
| Bool
otherwise =
(Integer -> a) -> Gen Integer -> Gen a
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> a
forall a. Num a => Integer -> a
fromInteger ((Integer, Integer) -> Gen Integer
chooseInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
lo, a -> Integer
forall a. Integral a => a -> Integer
toInteger a
hi))
#ifndef NO_SPLITMIX
where
mn :: a
mn = a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
lo
mx :: a
mx = a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
hi
#endif
chooseInteger :: (Integer, Integer) -> Gen Integer
#ifdef NO_SPLITMIX
chooseInteger = choose
#else
chooseInteger :: (Integer, Integer) -> Gen Integer
chooseInteger (Integer
lo, Integer
hi)
| Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64) Bool -> Bool -> Bool
&& Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64) Bool -> Bool -> Bool
&&
Integer
hi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64) Bool -> Bool -> Bool
&& Integer
hi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64) =
(Int64 -> Integer) -> Gen Int64 -> Gen Integer
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger ((Int64, Int64) -> Gen Int64
chooseInt64 (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
lo, Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
hi))
| Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
minBound :: Word64) Bool -> Bool -> Bool
&& Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64) Bool -> Bool -> Bool
&&
Integer
hi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
minBound :: Word64) Bool -> Bool -> Bool
&& Integer
hi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64) =
(Word64 -> Integer) -> Gen Word64 -> Gen Integer
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger ((Word64, Word64) -> Gen Word64
chooseWord64 (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
lo, Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
hi))
| Bool
otherwise = (QCGen -> Int -> Integer) -> Gen Integer
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Integer) -> Gen Integer)
-> (QCGen -> Int -> Integer) -> Gen Integer
forall a b. (a -> b) -> a -> b
$ \(QCGen SMGen
g) Int
_ -> (Integer, SMGen) -> Integer
forall a b. (a, b) -> a
fst (Integer -> Integer -> SMGen -> (Integer, SMGen)
nextInteger Integer
lo Integer
hi SMGen
g)
chooseWord64 :: (Word64, Word64) -> Gen Word64
chooseWord64 :: (Word64, Word64) -> Gen Word64
chooseWord64 (Word64
lo, Word64
hi)
| Word64
lo Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
hi = (Word64, Word64) -> Gen Word64
chooseWord64' (Word64
lo, Word64
hi)
| Bool
otherwise = (Word64, Word64) -> Gen Word64
chooseWord64' (Word64
hi, Word64
lo)
where
chooseWord64' :: (Word64, Word64) -> Gen Word64
chooseWord64' :: (Word64, Word64) -> Gen Word64
chooseWord64' (Word64
lo, Word64
hi) =
(Word64 -> Word64) -> Gen Word64 -> Gen Word64
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
lo) (Word64 -> Gen Word64
chooseUpTo (Word64
hi Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
lo))
chooseInt64 :: (Int64, Int64) -> Gen Int64
chooseInt64 :: (Int64, Int64) -> Gen Int64
chooseInt64 (Int64
lo, Int64
hi)
| Int64
lo Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
hi = (Int64, Int64) -> Gen Int64
chooseInt64' (Int64
lo, Int64
hi)
| Bool
otherwise = (Int64, Int64) -> Gen Int64
chooseInt64' (Int64
hi, Int64
lo)
where
chooseInt64' :: (Int64, Int64) -> Gen Int64
chooseInt64' :: (Int64, Int64) -> Gen Int64
chooseInt64' (Int64
lo, Int64
hi) = do
Word64
w <- Word64 -> Gen Word64
chooseUpTo (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
hi Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
lo)
Int64 -> Gen Int64
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
lo))
chooseUpTo :: Word64 -> Gen Word64
chooseUpTo :: Word64 -> Gen Word64
chooseUpTo Word64
n =
(QCGen -> Int -> Word64) -> Gen Word64
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Word64) -> Gen Word64)
-> (QCGen -> Int -> Word64) -> Gen Word64
forall a b. (a -> b) -> a -> b
$ \(QCGen SMGen
g) Int
_ ->
(Word64, SMGen) -> Word64
forall a b. (a, b) -> a
fst (Word64 -> SMGen -> (Word64, SMGen)
bitmaskWithRejection64' Word64
n SMGen
g)
#endif
generate :: Gen a -> IO a
generate :: forall a. Gen a -> IO a
generate (MkGen QCGen -> Int -> a
g) =
do QCGen
r <- IO QCGen
newQCGen
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QCGen -> Int -> a
g QCGen
r Int
30)
sample' :: Gen a -> IO [a]
sample' :: forall a. Gen a -> IO [a]
sample' Gen a
g =
Gen [a] -> IO [a]
forall a. Gen a -> IO a
generate ([Gen a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ Int -> Gen a -> Gen a
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
n Gen a
g | Int
n <- [Int
0,Int
2..Int
20] ])
sample :: Show a => Gen a -> IO ()
sample :: forall a. Show a => Gen a -> IO ()
sample Gen a
g =
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ do QCGen
r <- IO QCGen
newQCGen
Either AnException ()
munit <- IO () -> IO (Either AnException ())
forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (a -> IO ()
forall a. Show a => a -> IO ()
print (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ Gen a -> QCGen -> Int -> a
forall a. Gen a -> QCGen -> Int -> a
unGen Gen a
g QCGen
r Int
n)
case Either AnException ()
munit of
Left AnException
e
| AnException -> Bool
isDiscard AnException
e -> [Char] -> IO ()
putStrLn [Char]
"<DISCARDED>"
| Bool
otherwise -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Uncaught exception in sample: " [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ AnException -> [Char]
forall a. Show a => a -> [Char]
show AnException
e)
Right () -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Int
n <- [Int
0,Int
2..Int
20] ]
genDouble :: Gen Double
genFloat :: Gen Float
#ifndef NO_SPLITMIX
genDouble :: Gen Double
genDouble = (QCGen -> Int -> Double) -> Gen Double
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Double) -> Gen Double)
-> (QCGen -> Int -> Double) -> Gen Double
forall a b. (a -> b) -> a -> b
$ \(QCGen SMGen
g) Int
_ -> (Double, SMGen) -> Double
forall a b. (a, b) -> a
fst (SMGen -> (Double, SMGen)
nextDouble SMGen
g)
genFloat :: Gen Float
genFloat = (QCGen -> Int -> Float) -> Gen Float
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> Float) -> Gen Float)
-> (QCGen -> Int -> Float) -> Gen Float
forall a b. (a -> b) -> a -> b
$ \(QCGen SMGen
g) Int
_ -> (Float, SMGen) -> Float
forall a b. (a, b) -> a
fst (SMGen -> (Float, SMGen)
nextFloat SMGen
g)
#else
genDouble = choose (0,1)
genFloat = choose (0,1)
#endif
suchThat :: Gen a -> (a -> Bool) -> Gen a
Gen a
gen suchThat :: forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` a -> Bool
p =
do Maybe a
mx <- Gen a
gen Gen a -> (a -> Bool) -> Gen (Maybe a)
forall a. Gen a -> (a -> Bool) -> Gen (Maybe a)
`suchThatMaybe` a -> Bool
p
case Maybe a
mx of
Just a
x -> a -> Gen a
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Maybe a
Nothing -> (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized (\Int
n -> Int -> Gen a -> Gen a
forall a. HasCallStack => Int -> Gen a -> Gen a
resize (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Gen a
gen Gen a -> (a -> Bool) -> Gen a
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` a -> Bool
p))
suchThatMap :: Gen a -> (a -> Maybe b) -> Gen b
Gen a
gen suchThatMap :: forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` a -> Maybe b
f =
(Maybe b -> b) -> Gen (Maybe b) -> Gen b
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust (Gen (Maybe b) -> Gen b) -> Gen (Maybe b) -> Gen b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> Gen a -> Gen (Maybe b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f Gen a
gen Gen (Maybe b) -> (Maybe b -> Bool) -> Gen (Maybe b)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Maybe b -> Bool
forall a. Maybe a -> Bool
isJust
suchThatMaybe :: Gen a -> (a -> Bool) -> Gen (Maybe a)
Gen a
gen suchThatMaybe :: forall a. Gen a -> (a -> Bool) -> Gen (Maybe a)
`suchThatMaybe` a -> Bool
p = (Int -> Gen (Maybe a)) -> Gen (Maybe a)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
n -> Int -> Int -> Gen (Maybe a)
try Int
n (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n))
where
try :: Int -> Int -> Gen (Maybe a)
try Int
m Int
n
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = Maybe a -> Gen (Maybe a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = do
a
x <- Int -> Gen a -> Gen a
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
m Gen a
gen
if a -> Bool
p a
x then Maybe a -> Gen (Maybe a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x) else Int -> Int -> Gen (Maybe a)
try (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
n
oneof :: WITHCALLSTACK([Gen a] -> Gen a)
oneof :: forall a. HasCallStack => [Gen a] -> Gen a
oneof [] = [Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.oneof used with empty list"
oneof [Gen a]
gs = (Int, Int) -> Gen Int
chooseInt (Int
0,[Gen a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Gen a]
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Gen Int -> (Int -> Gen a) -> Gen a
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Gen a]
gs [Gen a] -> Int -> Gen a
forall a. HasCallStack => [a] -> Int -> a
!!)
frequency :: WITHCALLSTACK([(Int, Gen a)] -> Gen a)
frequency :: forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [] = [Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.frequency used with empty list"
frequency [(Int, Gen a)]
xs
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (((Int, Gen a) -> Int) -> [(Int, Gen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Gen a) -> Int
forall a b. (a, b) -> a
fst [(Int, Gen a)]
xs) =
[Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.frequency: negative weight"
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (((Int, Gen a) -> Int) -> [(Int, Gen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Gen a) -> Int
forall a b. (a, b) -> a
fst [(Int, Gen a)]
xs) =
[Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.frequency: all weights were zero"
frequency [(Int, Gen a)]
xs0 = (Int, Int) -> Gen Int
chooseInt (Int
1, Int
tot) Gen Int -> (Int -> Gen a) -> Gen a
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> [(Int, Gen a)] -> Gen a
forall {t} {b}. (Ord t, Num t) => t -> [(t, b)] -> b
`pick` [(Int, Gen a)]
xs0)
where
tot :: Int
tot = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, Gen a) -> Int) -> [(Int, Gen a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Gen a) -> Int
forall a b. (a, b) -> a
fst [(Int, Gen a)]
xs0)
pick :: t -> [(t, b)] -> b
pick t
n ((t
k,b
x):[(t, b)]
xs)
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
k = b
x
| Bool
otherwise = t -> [(t, b)] -> b
pick (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
k) [(t, b)]
xs
pick t
_ [(t, b)]
_ = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.pick used with empty list"
elements :: WITHCALLSTACK([a] -> Gen a)
elements :: forall a. HasCallStack => [a] -> Gen a
elements [] = [Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.elements used with empty list"
elements [a]
xs = ([a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!) (Int -> a) -> Gen Int -> Gen a
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Int, Int) -> Gen Int
chooseInt (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
sublistOf :: [a] -> Gen [a]
sublistOf :: forall a. [a] -> Gen [a]
sublistOf [a]
xs = (a -> Gen Bool) -> [a] -> Gen [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\a
_ -> (Bool, Bool) -> Gen Bool
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Bool
False, Bool
True)) [a]
xs
shuffle :: [a] -> Gen [a]
shuffle :: forall a. [a] -> Gen [a]
shuffle [a]
xs = do
[Int]
ns <- Int -> Gen Int -> Gen [Int]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) ((Int, Int) -> Gen Int
chooseInt (Int
forall a. Bounded a => a
minBound :: Int, Int
forall a. Bounded a => a
maxBound))
[a] -> Gen [a]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd (((Int, a) -> (Int, a) -> Ordering) -> [(Int, a)] -> [(Int, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, a) -> Int) -> (Int, a) -> (Int, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, a) -> Int
forall a b. (a, b) -> a
fst) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ns [a]
xs)))
growingElements :: WITHCALLSTACK([a] -> Gen a)
growingElements :: forall a. HasCallStack => [a] -> Gen a
growingElements [] = [Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.growingElements used with empty list"
growingElements [a]
xs = (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 -> [a] -> Gen a
forall a. HasCallStack => [a] -> Gen a
elements (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int -> Int
size Int
n) [a]
xs)
where
k :: Int
k = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
mx :: Int
mx = Int
100
log' :: Int -> Int
log' = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
log (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
toDouble
size :: Int -> Int
size Int
n = (Int -> Int
log' Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
log' Int
mx
toDouble :: Int -> Double
toDouble = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double
listOf :: Gen a -> Gen [a]
listOf :: forall a. Gen a -> Gen [a]
listOf Gen a
gen = (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 ->
do Int
k <- (Int, Int) -> Gen Int
chooseInt (Int
0,Int
n)
Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
k Gen a
gen
listOf1 :: Gen a -> Gen [a]
listOf1 :: forall a. Gen a -> Gen [a]
listOf1 Gen a
gen = (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 ->
do Int
k <- (Int, Int) -> Gen Int
chooseInt (Int
1,Int
1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
n)
Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
k Gen a
gen
vectorOf :: Int -> Gen a -> Gen [a]
vectorOf :: forall a. Int -> Gen a -> Gen [a]
vectorOf = Int -> Gen a -> Gen [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
infiniteListOf :: Gen a -> Gen [a]
infiniteListOf :: forall a. Gen a -> Gen [a]
infiniteListOf Gen a
gen = [Gen a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Gen a -> [Gen a]
forall a. a -> [a]
repeat Gen a
gen)