-- |
-- 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 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

-- |
-- 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 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


--------------------------------------------------------------------------
-- ** 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
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))

-- | 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 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)

-- | 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] ]


-- * 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 => [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

-- | 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 => [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"

-- | 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 => [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

-- | 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 => [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


-- * Non-partial 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 [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
!!)

-- | Generates one of the given values.
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)

-- | 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 [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