{-# LANGUAGE LambdaCase #-}

-- |
-- Most of the code is borrowed from
-- <http://haskell.1045720.n5.nabble.com/darcs-patch-GenT-monad-transformer-variant-of-Gen-QuickCheck-2-td3172136.html a mailing list discussion>.
-- Therefor, credits go to Paul Johnson and Felix Martini.
module QuickCheck.GenT
  ( GenT,
    runGenT,
    MonadGen (..),

    -- * Lifted functions
    arbitrary',
    oneof,
    frequency,
    elements,
    growingElements,
    getSize,
    scale,
    suchThat,
    suchThatMap,
    suchThatMaybe,
    applyArbitrary2,
    applyArbitrary3,
    applyArbitrary4,
    listOf,
    listOf1,
    vectorOf,
    vector,
    infiniteListOf,
    infiniteList,
    shuffle,
    sublistOf,
    orderedList,

    -- * Re-exports
    Arbitrary (..),
    QC.Gen,

    -- * Safe functions
    oneofMay,
    elementsMay,
    growingElementsMay,
  )
where

import QuickCheck.GenT.Prelude
import qualified System.Random as Random
import Test.QuickCheck (Arbitrary (..))
import qualified Test.QuickCheck.Arbitrary as QC
import qualified Test.QuickCheck.Gen as QC
import qualified Test.QuickCheck.Random as QC

newtype GenT m a = GenT {forall (m :: * -> *) a. GenT m a -> QCGen -> Int -> m a
unGenT :: QC.QCGen -> Int -> m a}

instance MFunctor GenT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> GenT m b -> GenT n b
hoist forall a. m a -> n a
f (GenT QCGen -> Int -> m b
g) = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> forall a. m a -> n a
f forall a b. (a -> b) -> a -> b
$ QCGen -> Int -> m b
g QCGen
r Int
n

instance (Functor m) => Functor (GenT m) where
  fmap :: forall a b. (a -> b) -> GenT m a -> GenT m b
fmap a -> b
f GenT m a
m = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. GenT m a -> QCGen -> Int -> m a
unGenT GenT m a
m QCGen
r Int
n

instance (Monad m) => Monad (GenT m) where
  return :: forall a. a -> GenT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  GenT m a
m >>= :: forall a b. GenT m a -> (a -> GenT m b) -> GenT m b
>>= a -> GenT m b
k = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> do
    let (QCGen
r1, QCGen
r2) = forall g. RandomGen g => g -> (g, g)
Random.split QCGen
r
    a
a <- forall (m :: * -> *) a. GenT m a -> QCGen -> Int -> m a
unGenT GenT m a
m QCGen
r1 Int
n
    forall (m :: * -> *) a. GenT m a -> QCGen -> Int -> m a
unGenT (a -> GenT m b
k a
a) QCGen
r2 Int
n

instance (MonadFail m) => MonadFail (GenT m) where
  fail :: forall a. String -> GenT m a
fail String
msg = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT (\QCGen
_ Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg)

instance (Functor m, Monad m) => Applicative (GenT m) where
  pure :: forall a. a -> GenT m a
pure a
a = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT (\QCGen
_ Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a)
  <*> :: forall a b. GenT m (a -> b) -> GenT m a -> GenT m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadTrans GenT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> GenT m a
lift m a
m = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT (\QCGen
_ Int
_ -> m a
m)

instance (MonadIO m) => MonadIO (GenT m) where
  liftIO :: forall a. IO a -> GenT m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

class (Applicative g, Monad g) => MonadGen g where
  liftGen :: QC.Gen a -> g a
  variant :: (Integral n) => n -> g a -> g a
  sized :: (Int -> g a) -> g a
  resize :: Int -> g a -> g a
  choose :: (Random.Random a) => (a, a) -> g a

instance (Applicative m, Monad m) => MonadGen (GenT m) where
  liftGen :: forall a. Gen a -> GenT m a
liftGen Gen a
gen = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> QCGen -> Int -> a
QC.unGen Gen a
gen QCGen
r Int
n
  choose :: forall a. Random a => (a, a) -> GenT m a
choose (a, a)
rng = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (a, a)
rng QCGen
r
  variant :: forall n a. Integral n => n -> GenT m a -> GenT m a
variant n
k (GenT QCGen -> Int -> m a
g) = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> QCGen -> Int -> m a
g (forall n. Integral n => n -> QCGen -> QCGen
var n
k QCGen
r) Int
n
  sized :: forall a. (Int -> GenT m a) -> GenT m a
sized Int -> GenT m a
f = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> let GenT QCGen -> Int -> m a
g = Int -> GenT m a
f Int
n in QCGen -> Int -> m a
g QCGen
r Int
n
  resize :: forall a. Int -> GenT m a -> GenT m a
resize Int
n (GenT QCGen -> Int -> m a
g) = forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
_ -> QCGen -> Int -> m a
g QCGen
r Int
n

instance MonadGen QC.Gen where
  liftGen :: forall a. Gen a -> Gen a
liftGen = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  variant :: forall n a. Integral n => n -> Gen a -> Gen a
variant n
k (QC.MkGen QCGen -> Int -> a
g) = forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> QCGen -> Int -> a
g (forall n. Integral n => n -> QCGen -> QCGen
var n
k QCGen
r) Int
n
  sized :: forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen a
f = forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> let QC.MkGen QCGen -> Int -> a
g = Int -> Gen a
f Int
n in QCGen -> Int -> a
g QCGen
r Int
n
  resize :: forall a. Int -> Gen a -> Gen a
resize Int
n (QC.MkGen QCGen -> Int -> a
g) = forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
_ -> QCGen -> Int -> a
g QCGen
r Int
n
  choose :: forall a. Random a => (a, a) -> Gen a
choose (a, a)
range = forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
_ -> forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (a, a)
range QCGen
r

runGenT :: GenT m a -> QC.Gen (m a)
runGenT :: forall (m :: * -> *) a. GenT m a -> Gen (m a)
runGenT (GenT QCGen -> Int -> m a
run) = forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen QCGen -> Int -> m a
run

-- |
-- Private variant-generating function.  Converts an integer into a chain
-- of (fst . split) and (snd . split) applications.  Every integer (including
-- negative ones) will give rise to a different random number generator in
-- log2 n steps.
var :: (Integral n) => n -> QC.QCGen -> QC.QCGen
var :: forall n. Integral n => n -> QCGen -> QCGen
var n
k =
  (if n
k forall a. Eq a => a -> a -> Bool
== n
k' then forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id else forall n. Integral n => n -> QCGen -> QCGen
var n
k') forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (if forall a. Integral a => a -> Bool
even n
k then forall a b. (a, b) -> a
fst else forall a b. (a, b) -> b
snd) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall g. RandomGen g => g -> (g, g)
Random.split
  where
    k' :: n
k' = n
k forall a. Integral a => a -> a -> a
`div` n
2

-- ** Lifted functions

arbitrary' :: (Arbitrary a, MonadGen m) => m a
arbitrary' :: forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary' = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall a. Arbitrary a => Gen a
arbitrary

getSize :: (MonadGen m) => m Int
getSize :: forall (m :: * -> *). MonadGen m => m Int
getSize = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall (m :: * -> *). MonadGen m => m Int
getSize

scale :: (MonadGen m) => (Int -> Int) -> m a -> m a
scale :: forall (m :: * -> *) a. MonadGen m => (Int -> Int) -> m a -> m a
scale Int -> Int
f m a
g = forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized (\Int
n -> forall (g :: * -> *) a. MonadGen g => Int -> g a -> g a
resize (Int -> Int
f Int
n) m a
g)

applyArbitrary2 :: (MonadGen m) => (Arbitrary a, Arbitrary b) => (a -> b -> r) -> m r
applyArbitrary2 :: forall (m :: * -> *) a b r.
(MonadGen m, Arbitrary a, Arbitrary b) =>
(a -> b -> r) -> m r
applyArbitrary2 = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b r. (Arbitrary a, Arbitrary b) => (a -> b -> r) -> Gen r
QC.applyArbitrary2

applyArbitrary3 :: (MonadGen m) => (Arbitrary a, Arbitrary b, Arbitrary c) => (a -> b -> c -> r) -> m r
applyArbitrary3 :: forall (m :: * -> *) a b c r.
(MonadGen m, Arbitrary a, Arbitrary b, Arbitrary c) =>
(a -> b -> c -> r) -> m r
applyArbitrary3 = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c r.
(Arbitrary a, Arbitrary b, Arbitrary c) =>
(a -> b -> c -> r) -> Gen r
QC.applyArbitrary3

applyArbitrary4 :: (MonadGen m) => (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => (a -> b -> c -> d -> r) -> m r
applyArbitrary4 :: forall (m :: * -> *) a b c d r.
(MonadGen m, Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =>
(a -> b -> c -> d -> r) -> m r
applyArbitrary4 = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c d r.
(Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =>
(a -> b -> c -> d -> r) -> Gen r
QC.applyArbitrary4

infiniteListOf :: (MonadGen m) => m a -> m [a]
infiniteListOf :: forall (m :: * -> *) a. MonadGen m => m a -> m [a]
infiniteListOf = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> [a]
repeat

infiniteList :: (Arbitrary a, MonadGen m) => m [a]
infiniteList :: forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m [a]
infiniteList = forall (m :: * -> *) a. MonadGen m => m a -> m [a]
infiniteListOf forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary'

shuffle :: (MonadGen m) => [a] -> m [a]
shuffle :: forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
shuffle = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. [a] -> Gen [a]
QC.shuffle

sublistOf :: (MonadGen m) => [a] -> m [a]
sublistOf :: forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
sublistOf = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. [a] -> Gen [a]
QC.sublistOf

orderedList :: (Ord a, Arbitrary a, MonadGen m) => m [a]
orderedList :: forall a (m :: * -> *). (Ord a, Arbitrary a, MonadGen m) => m [a]
orderedList = forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen forall a. (Ord a, Arbitrary a) => Gen [a]
QC.orderedList

-- ** Common generator combinators

-- | Generates a value that satisfies a predicate.
suchThat :: (MonadGen m) => m a -> (a -> Bool) -> m a
m a
gen suchThat :: forall (m :: * -> *) a. MonadGen m => m a -> (a -> Bool) -> m a
`suchThat` a -> Bool
p =
  do
    Maybe a
mx <- m a
gen forall (m :: * -> *) a.
MonadGen m =>
m a -> (a -> Bool) -> m (Maybe a)
`suchThatMaybe` a -> Bool
p
    case Maybe a
mx of
      Just a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      Maybe a
Nothing -> forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized (\Int
n -> forall (g :: * -> *) a. MonadGen g => Int -> g a -> g a
resize (Int
n forall a. Num a => a -> a -> a
+ Int
1) (m a
gen forall (m :: * -> *) a. MonadGen m => m a -> (a -> Bool) -> m a
`suchThat` a -> Bool
p))

-- | Generates a value for which the given function returns a 'Just', and then
-- applies the function.
suchThatMap :: (MonadGen m) => m a -> (a -> Maybe b) -> m b
m a
gen suchThatMap :: forall (m :: * -> *) a b.
MonadGen m =>
m a -> (a -> Maybe b) -> m b
`suchThatMap` a -> Maybe b
f =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f m a
gen forall (m :: * -> *) a. MonadGen m => m a -> (a -> Bool) -> m a
`suchThat` forall a. Maybe a -> Bool
isJust

-- | Tries to generate a value that satisfies a predicate.
suchThatMaybe :: (MonadGen m) => m a -> (a -> Bool) -> m (Maybe a)
m a
gen suchThatMaybe :: forall (m :: * -> *) a.
MonadGen m =>
m a -> (a -> Bool) -> m (Maybe a)
`suchThatMaybe` a -> Bool
p = forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized (Int -> Int -> m (Maybe a)
try Int
0 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Ord a => a -> a -> a
max Int
1)
  where
    try :: Int -> Int -> m (Maybe a)
try Int
_ Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    try Int
k Int
n = do
      a
x <- forall (g :: * -> *) a. MonadGen g => Int -> g a -> g a
resize (Int
2 forall a. Num a => a -> a -> a
* Int
k forall a. Num a => a -> a -> a
+ Int
n) m a
gen
      if a -> Bool
p a
x then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x) else Int -> Int -> m (Maybe a)
try (Int
k forall a. Num a => a -> a -> a
+ Int
1) (Int
n forall a. Num a => a -> a -> a
- Int
1)

-- | Generates a list of random length. The maximum length depends on the
-- size parameter.
listOf :: (MonadGen m) => m a -> m [a]
listOf :: forall (m :: * -> *) a. MonadGen m => m a -> m [a]
listOf m a
gen = forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized forall a b. (a -> b) -> a -> b
$ \Int
n ->
  do
    Int
k <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
0, Int
n)
    forall (m :: * -> *) a. MonadGen m => Int -> m a -> m [a]
vectorOf Int
k m a
gen

-- | Generates a non-empty list of random length. The maximum length
-- depends on the size parameter.
listOf1 :: (MonadGen m) => m a -> m [a]
listOf1 :: forall (m :: * -> *) a. MonadGen m => m a -> m [a]
listOf1 m a
gen = forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized forall a b. (a -> b) -> a -> b
$ \Int
n ->
  do
    Int
k <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
1 forall a. Ord a => a -> a -> a
`max` Int
n)
    forall (m :: * -> *) a. MonadGen m => Int -> m a -> m [a]
vectorOf Int
k m a
gen

-- | Generates a list of the given length.
vectorOf :: (MonadGen m) => Int -> m a -> m [a]
vectorOf :: forall (m :: * -> *) a. MonadGen m => Int -> m a -> m [a]
vectorOf Int
k m a
gen = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [m a
gen | Int
_ <- [Int
1 .. Int
k]]

-- | Generates a list of a given length.
vector :: (Arbitrary a, MonadGen m) => Int -> m [a]
vector :: forall a (m :: * -> *). (Arbitrary a, MonadGen m) => Int -> m [a]
vector Int
n = forall (m :: * -> *) a. MonadGen m => Int -> m a -> m [a]
vectorOf Int
n forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary'

-- * Partial functions

-- | Randomly uses one of the given generators. The input list
-- must be non-empty.
oneof :: (MonadGen m) => [m a] -> m a
oneof :: forall (m :: * -> *) a. MonadGen m => [m a] -> m a
oneof =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.oneof used with empty list"))
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadGen m => [m a] -> m (Maybe a)
oneofMay

-- | Chooses one of the given generators, with a weighted random distribution.
-- The input list must be non-empty.
frequency :: (MonadGen m) => [(Int, m a)] -> m a
frequency :: forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
frequency [] = forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.frequency used with empty list"
frequency [(Int, m a)]
xs0 = forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
tot) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall {t} {b}. (Ord t, Num t) => t -> [(t, b)] -> b
`pick` [(Int, m a)]
xs0)
  where
    tot :: Int
tot = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, m a)]
xs0)

    pick :: t -> [(t, b)] -> b
pick t
n ((t
k, b
x) : [(t, b)]
xs)
      | t
n forall a. Ord a => a -> a -> Bool
<= t
k = b
x
      | Bool
otherwise = t -> [(t, b)] -> b
pick (t
n forall a. Num a => a -> a -> a
- t
k) [(t, b)]
xs
    pick t
_ [(t, b)]
_ = forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.pick used with empty list"

-- | Generates one of the given values. The input list must be non-empty.
elements :: (MonadGen m) => [a] -> m a
elements :: forall (m :: * -> *) a. MonadGen m => [a] -> m a
elements =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.elements used with empty list"))
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
elementsMay

-- | 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 :: (MonadGen m) => [a] -> m a
growingElements :: forall (m :: * -> *) a. MonadGen m => [a] -> m a
growingElements =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.growingElements used with empty list"))
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
growingElementsMay

-- * Total functions resulting in Maybe

-- |
-- Randomly uses one of the given generators.
oneofMay :: (MonadGen m) => [m a] -> m (Maybe a)
oneofMay :: forall (m :: * -> *) a. MonadGen m => [m a] -> m (Maybe a)
oneofMay = \case
  [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  [m a]
l -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [m a]
l forall a. Num a => a -> a -> a
- Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([m a]
l forall a. [a] -> Int -> a
!!)

-- | Generates one of the given values.
elementsMay :: (MonadGen m) => [a] -> m (Maybe a)
elementsMay :: forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
elementsMay = \case
  [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  [a]
l -> forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a]
l forall a. [a] -> Int -> a
!!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l forall a. Num a => a -> a -> a
- Int
1)

-- | 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.
growingElementsMay :: (MonadGen m) => [a] -> m (Maybe a)
growingElementsMay :: forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
growingElementsMay = \case
  [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  [a]
xs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized forall a b. (a -> b) -> a -> b
$ \Int
n -> forall (m :: * -> *) a. MonadGen m => [a] -> m a
elements (forall a. Int -> [a] -> [a]
take (Int
1 forall a. Ord a => a -> a -> a
`max` Int -> Int
size Int
n) [a]
xs)
    where
      k :: Int
k = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
      mx :: a
mx = a
100
      log' :: a -> c
log' = forall a b. (RealFrac a, Integral b) => a -> b
round forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Floating a => a -> a
log forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
      size :: Int -> Int
size Int
n = (forall {c} {a}. (Integral c, Integral a) => a -> c
log' Int
n forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Int
k forall a. Integral a => a -> a -> a
`div` forall {c} {a}. (Integral c, Integral a) => a -> c
log' forall {a}. Num a => a
mx