module Test.QuickCheck.GenT (
GenT (GenT, unGenT),
runGenT,
MonadGen (liftGen, variant, sized, resize, choose),
var,
suchThat,
suchThatMaybe,
listOf,
listOf1,
vectorOf,
oneof,
frequency,
elements,
growingElements,
oneofMay,
elementsMay,
growingElementsMay,
) where
import qualified Test.QuickCheck.Gen as QC
import qualified Test.QuickCheck.Random as QC
import qualified System.Random as Random
import Test.QuickCheck.GenT.Private (GenT(..))
import Control.Applicative (Applicative, (<$>))
import Data.Maybe (fromMaybe)
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
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 a. 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
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 a. a -> a
id else forall n. Integral n => n -> QCGen -> QCGen
var n
k') forall b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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
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
nforall 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))
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 b c a. (b -> c) -> (a -> b) -> 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
2forall a. Num a => a -> a -> a
*Int
kforall 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
kforall a. Num a => a -> a -> a
+Int
1) (Int
nforall a. Num a => a -> a -> a
-Int
1)
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
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
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] ]
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 => [Char] -> a
error [Char]
"QuickCheck.GenT.oneof used with empty list")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *) a. MonadGen m => [m a] -> m (Maybe a)
oneofMay
frequency :: MonadGen m => [(Int, m a)] -> m a
frequency :: forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
frequency [] = forall a. HasCallStack => [Char] -> a
error [Char]
"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
nforall a. Num a => a -> a -> a
-t
k) [(t, b)]
xs
pick t
_ [(t, b)]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"QuickCheck.GenT.pick used with empty list"
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 => [Char] -> a
error [Char]
"QuickCheck.GenT.elements used with empty list")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
elementsMay
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 => [Char] -> a
error [Char]
"QuickCheck.GenT.growingElements used with empty list")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
growingElementsMay
oneofMay :: MonadGen m => [m a] -> m (Maybe a)
oneofMay :: forall (m :: * -> *) a. MonadGen m => [m a] -> m (Maybe a)
oneofMay [m a]
as =
case [m a]
as of
[] -> 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
!!)
elementsMay :: MonadGen m => [a] -> m (Maybe a)
elementsMay :: forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
elementsMay [a]
as =
case [a]
as of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
[a]
l -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> 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)
growingElementsMay :: MonadGen m => [a] -> m (Maybe a)
growingElementsMay :: forall (m :: * -> *) a. MonadGen m => [a] -> m (Maybe a)
growingElementsMay [a]
as =
case [a]
as of
[] -> 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 :: Int
mx = Int
100
log' :: Int -> Int
log' = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
log forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> a
id :: Double -> Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
size :: Int -> Int
size Int
n = (Int -> Int
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` Int -> Int
log' Int
mx