{-# 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) = (QCGen -> Int -> n b) -> GenT n b
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> n b) -> GenT n b)
-> (QCGen -> Int -> n b) -> GenT n b
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> m b -> n b
forall a. m a -> n a
f (m b -> n b) -> m b -> n b
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 = (QCGen -> Int -> m b) -> GenT m b
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m b) -> GenT m b)
-> (QCGen -> Int -> m b) -> GenT m b
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ GenT m a -> QCGen -> Int -> m a
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 = a -> GenT m a
forall a. a -> GenT m a
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 = (QCGen -> Int -> m b) -> GenT m b
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m b) -> GenT m b)
-> (QCGen -> Int -> m b) -> GenT m b
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> do
    let (QCGen
r1, QCGen
r2) = QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
Random.split QCGen
r
    a
a <- GenT m a -> QCGen -> Int -> m a
forall (m :: * -> *) a. GenT m a -> QCGen -> Int -> m a
unGenT GenT m a
m QCGen
r1 Int
n
    GenT m b -> QCGen -> Int -> m b
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 = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT (\QCGen
_ Int
_ -> String -> m a
forall a. String -> m a
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 = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT (\QCGen
_ Int
_ -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)
  <*> :: forall a b. GenT m (a -> b) -> GenT m a -> GenT m 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 = (QCGen -> Int -> m a) -> GenT m a
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 = m a -> GenT m a
forall (m :: * -> *) a. Monad m => m a -> GenT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GenT m a) -> (IO a -> m a) -> IO a -> GenT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> m a
forall a. IO a -> m a
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 = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m a) -> GenT m a)
-> (QCGen -> Int -> m a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Gen a -> QCGen -> Int -> a
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 = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m a) -> GenT m a)
-> (QCGen -> Int -> m a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
_ -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ (a, QCGen) -> a
forall a b. (a, b) -> a
fst ((a, QCGen) -> a) -> (a, QCGen) -> a
forall a b. (a -> b) -> a -> b
$ (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)
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) = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m a) -> GenT m a)
-> (QCGen -> Int -> m a) -> GenT m a
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> QCGen -> Int -> m a
g (n -> QCGen -> QCGen
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 = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m a) -> GenT m a)
-> (QCGen -> Int -> m a) -> GenT m a
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) = (QCGen -> Int -> m a) -> GenT m a
forall (m :: * -> *) a. (QCGen -> Int -> m a) -> GenT m a
GenT ((QCGen -> Int -> m a) -> GenT m a)
-> (QCGen -> Int -> m a) -> GenT m a
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 = Gen a -> Gen a
forall a. a -> a
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) = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
n -> QCGen -> Int -> a
g (n -> QCGen -> QCGen
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 = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
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) = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
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 = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \QCGen
r Int
_ -> (a, QCGen) -> a
forall a b. (a, b) -> a
fst ((a, QCGen) -> a) -> (a, QCGen) -> a
forall a b. (a -> b) -> a -> b
$ (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)
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) = (QCGen -> Int -> m a) -> Gen (m a)
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 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
k' then QCGen -> QCGen
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id else n -> QCGen -> QCGen
forall n. Integral n => n -> QCGen -> QCGen
var n
k') (QCGen -> QCGen) -> (QCGen -> QCGen) -> QCGen -> QCGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (if n -> Bool
forall a. Integral a => a -> Bool
even n
k then (QCGen, QCGen) -> QCGen
forall a b. (a, b) -> a
fst else (QCGen, QCGen) -> QCGen
forall a b. (a, b) -> b
snd) ((QCGen, QCGen) -> QCGen)
-> (QCGen -> (QCGen, QCGen)) -> QCGen -> QCGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
Random.split
  where
    k' :: n
k' = n
k n -> n -> n
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' = Gen a -> m a
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen Gen a
forall a. Arbitrary a => Gen a
arbitrary

getSize :: (MonadGen m) => m Int
getSize :: forall (m :: * -> *). MonadGen m => m Int
getSize = Gen Int -> m Int
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen Gen Int
QC.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 = (Int -> m a) -> m a
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized (\Int
n -> Int -> m a -> m a
forall a. Int -> m a -> m a
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 = Gen r -> m r
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Gen r -> m r) -> ((a -> b -> r) -> Gen r) -> (a -> b -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b -> r) -> Gen r
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 = Gen r -> m r
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Gen r -> m r)
-> ((a -> b -> c -> r) -> Gen r) -> (a -> b -> c -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b -> c -> r) -> Gen r
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 = Gen r -> m r
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Gen r -> m r)
-> ((a -> b -> c -> d -> r) -> Gen r)
-> (a -> b -> c -> d -> r)
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b -> c -> d -> r) -> Gen r
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 = [m a] -> m [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 ([m a] -> m [a]) -> (m a -> [m a]) -> m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> [m a]
forall a. a -> [a]
repeat

infiniteList :: (Arbitrary a, MonadGen m) => m [a]
infiniteList :: forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m [a]
infiniteList = m a -> m [a]
forall (m :: * -> *) a. MonadGen m => m a -> m [a]
infiniteListOf m a
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 = Gen [a] -> m [a]
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Gen [a] -> m [a]) -> ([a] -> Gen [a]) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> Gen [a]
forall a. [a] -> Gen [a]
QC.shuffle

sublistOf :: (MonadGen m) => [a] -> m [a]
sublistOf :: forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
sublistOf = Gen [a] -> m [a]
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Gen [a] -> m [a]) -> ([a] -> Gen [a]) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> Gen [a]
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 = Gen [a] -> m [a]
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen Gen [a]
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 m a -> (a -> Bool) -> m (Maybe a)
forall (m :: * -> *) a.
MonadGen m =>
m a -> (a -> Bool) -> m (Maybe a)
`suchThatMaybe` a -> Bool
p
    case Maybe a
mx of
      Just a
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      Maybe a
Nothing -> (Int -> m a) -> m a
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized (\Int
n -> Int -> m a -> m a
forall a. Int -> m a -> m a
forall (g :: * -> *) a. MonadGen g => Int -> g a -> g a
resize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (m a
gen m a -> (a -> Bool) -> m a
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 =
  (Maybe b -> b) -> m (Maybe b) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust (m (Maybe b) -> m b) -> m (Maybe b) -> m b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> m a -> m (Maybe b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f m a
gen m (Maybe b) -> (Maybe b -> Bool) -> m (Maybe b)
forall (m :: * -> *) a. MonadGen m => m a -> (a -> Bool) -> m a
`suchThat` Maybe b -> Bool
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 = (Int -> m (Maybe a)) -> m (Maybe a)
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized (Int -> Int -> m (Maybe a)
try Int
0 (Int -> m (Maybe a)) -> (Int -> Int) -> Int -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1)
  where
    try :: Int -> Int -> m (Maybe a)
try Int
_ Int
0 = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    try Int
k Int
n = do
      a
x <- Int -> m a -> m a
forall a. Int -> m a -> m a
forall (g :: * -> *) a. MonadGen g => Int -> g a -> g a
resize (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) m a
gen
      if a -> Bool
p a
x then Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x) else Int -> Int -> m (Maybe a)
try (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
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 = (Int -> m [a]) -> m [a]
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized ((Int -> m [a]) -> m [a]) -> (Int -> m [a]) -> m [a]
forall a b. (a -> b) -> a -> b
$ \Int
n ->
  do
    Int
k <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
0, Int
n)
    Int -> m a -> m [a]
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 = (Int -> m [a]) -> m [a]
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized ((Int -> m [a]) -> m [a]) -> (Int -> m [a]) -> m [a]
forall a b. (a -> b) -> a -> b
$ \Int
n ->
  do
    Int
k <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
n)
    Int -> m a -> m [a]
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 = [m a] -> m [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 [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 = Int -> m a -> m [a]
forall (m :: * -> *) a. MonadGen m => Int -> m a -> m [a]
vectorOf Int
n m a
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 =
  (Maybe a -> a) -> m (Maybe a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.oneof used with empty list"))
    (m (Maybe a) -> m a) -> ([m a] -> m (Maybe a)) -> [m a] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [m a] -> m (Maybe a)
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 [] = String -> m a
forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.frequency used with empty list"
frequency [(Int, m a)]
xs0 = (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
tot) m Int -> (Int -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> [(Int, m a)] -> m a
forall {t} {b}. (Ord t, Num t) => t -> [(t, b)] -> b
`pick` [(Int, m 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, m a) -> Int) -> [(Int, m a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, m a) -> Int
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 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
k = b
x
      | Bool
otherwise = t -> [(t, b)] -> b
pick (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
k) [(t, b)]
xs
    pick t
_ [(t, b)]
_ = String -> 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 =
  (Maybe a -> a) -> m (Maybe a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.elements used with empty list"))
    (m (Maybe a) -> m a) -> ([a] -> m (Maybe a)) -> [a] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> m (Maybe a)
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 =
  (Maybe a -> a) -> m (Maybe a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"QuickCheck.GenT.growingElements used with empty list"))
    (m (Maybe a) -> m a) -> ([a] -> m (Maybe a)) -> [a] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> m (Maybe a)
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
  [] -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  [m a]
l -> (a -> Maybe a) -> m a -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (m a -> m (Maybe a)) -> m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
0, [m a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [m a]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) m Int -> (Int -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([m a]
l [m a] -> Int -> m a
forall a. HasCallStack => [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
  [] -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  [a]
l -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Int -> a) -> Int -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a]
l [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!) (Int -> Maybe a) -> m Int -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Int
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
  [] -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  [a]
xs -> (a -> Maybe a) -> m a -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (m a -> m (Maybe a)) -> m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Int -> m a) -> m a
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized ((Int -> m a) -> m a) -> (Int -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Int
n -> [a] -> m a
forall (m :: * -> *) a. MonadGen m => [a] -> m 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 :: a
mx = a
100
      log' :: a -> c
log' = Double -> c
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> c) -> (a -> Double) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Double
forall a. Floating a => a -> a
log (Double -> Double) -> (a -> Double) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      size :: Int -> Int
size Int
n = (Int -> Int
forall {c} {a}. (Integral c, Integral a) => a -> c
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` Integer -> Int
forall {c} {a}. (Integral c, Integral a) => a -> c
log' Integer
forall {a}. Num a => a
mx