{-# LANGUAGE CPP #-}
#ifndef NO_ST_MONAD
{-# LANGUAGE Rank2Types #-}
#endif
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Safe #-}
#endif
-- | Test case generation.
--
-- __Note__: the contents of this module (except for the definition of
-- 'Gen') are re-exported by "Test.QuickCheck". You probably do not
-- need to import it directly.
module Test.QuickCheck.Gen where

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

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

--------------------------------------------------------------------------
-- ** Generator type

-- | A generator for values of type @a@.
--
-- The third-party packages
-- <http://hackage.haskell.org/package/QuickCheck-GenT QuickCheck-GenT>
-- and
-- <http://hackage.haskell.org/package/quickcheck-transformer quickcheck-transformer>
-- provide monad transformer versions of @Gen@.
newtype Gen a = MkGen{
  forall a. Gen a -> QCGen -> Int -> a
unGen :: QCGen -> Int -> a -- ^ Run the generator on a particular seed.
                             -- If you just want to get a random value out, consider using 'generate'.
  }

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
  -- We don't need to split the seed for these.
  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

--------------------------------------------------------------------------
-- ** Primitive generator combinators

-- | Modifies a generator using an integer seed.
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)

-- | Used to construct generators that depend on the size parameter.
--
-- For example, 'listOf', which uses the size parameter as an upper bound on
-- length of lists it generates, can be defined like this:
--
-- > listOf :: Gen a -> Gen [a]
-- > listOf gen = sized $ \n ->
-- >   do k <- choose (0,n)
-- >      vectorOf k gen
--
-- You can also do this using 'getSize'.
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)

-- | Returns the size parameter. Used to construct generators that depend on
-- the size parameter.
--
-- For example, 'listOf', which uses the size parameter as an upper bound on
-- length of lists it generates, can be defined like this:
--
-- > listOf :: Gen a -> Gen [a]
-- > listOf gen = do
-- >   n <- getSize
-- >   k <- choose (0,n)
-- >   vectorOf k gen
--
-- You can also do this using 'sized'.
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

-- | Overrides the size parameter. Returns a generator which uses
-- the given size instead of the runtime-size parameter.
resize :: Int -> Gen a -> Gen a
resize :: forall a. 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)

-- | Adjust the size parameter, by transforming it with the given
-- function.
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. Int -> Gen a -> Gen a
resize (Int -> Int
f Int
n) Gen a
g)

-- | Generates a random element in the given inclusive range.
-- For integral and enumerated types, the specialised variants of
-- 'choose' below run much quicker.
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)

-- | Generates a random element over the natural range of `a`.
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)

-- | A fast implementation of 'choose' for enumerated types.
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))

-- | A fast implementation of 'choose' for 'Int'.
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

-- Note about INLINEABLE: we specialise chooseBoundedIntegral
-- for each concrete type, so that all the bounds checks get
-- simplified away.
{-# INLINEABLE chooseBoundedIntegral #-}
-- | A fast implementation of 'choose' for bounded integral types.
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

-- | A fast implementation of 'choose' for 'Integer'.
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

-- | Run a generator. The size passed to the generator is always 30;
-- if you want another size then you should explicitly use 'resize'.
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)

-- | Generates some example values.
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. Int -> Gen a -> Gen a
resize Int
n Gen a
g | Int
n <- [Int
0,Int
2..Int
20] ])

-- | Generates some example values and prints them to 'stdout'.
sample :: Show a => Gen a -> IO ()
sample :: forall a. Show a => Gen a -> IO ()
sample Gen a
g =
  do [a]
cases <- Gen a -> IO [a]
forall a. Gen a -> IO [a]
sample' Gen a
g
     (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. Show a => a -> IO ()
print [a]
cases

--------------------------------------------------------------------------
-- ** Floating point

-- | Generate 'Double' in 0..1 range
genDouble :: Gen Double

-- | Generate 'Float' in 0..1 range
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

--------------------------------------------------------------------------
-- ** Common generator combinators

-- | Generates a value that satisfies a predicate.
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. 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))

-- | Generates a value for which the given function returns a 'Just', and then
-- applies the function.
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

-- | Tries to generate a value that satisfies a predicate.
-- If it fails to do so after enough attempts, returns @Nothing@.
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. 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

-- | Randomly uses one of the given generators. The input list
-- must be non-empty.
oneof :: [Gen a] -> Gen a
oneof :: forall a. [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
!!)

-- | Chooses one of the given generators, with a weighted random distribution.
-- The input list must be non-empty.
frequency :: [(Int, Gen a)] -> Gen a
frequency :: forall a. [(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"

-- | Generates one of the given values. The input list must be non-empty.
elements :: [a] -> Gen a
elements :: forall a. [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)

-- | Generates a random subsequence of the given list.
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

-- | Generates a random permutation of the given list.
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)))

-- | Takes a list of elements of increasing size, and chooses
-- among an initial segment of the list. The size of this initial
-- segment increases with the size parameter.
-- The input list must be non-empty.
growingElements :: [a] -> Gen a
growingElements :: forall a. [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. [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

{- WAS:
growingElements xs = sized $ \n -> elements (take (1 `max` (n * k `div` 100)) xs)
 where
  k = length xs
-}

-- | Generates a list of random length. The maximum length depends on the
-- size parameter.
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

-- | Generates a non-empty list of random length. The maximum length
-- depends on the size parameter.
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

-- | Generates a list of the given length.
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

-- | Generates an infinite list.
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)

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