#ifndef NO_ST_MONAD
#endif
module Test.QuickCheck.Gen where
import System.Random
( Random
, StdGen
, randomR
, split
, newStdGen
)
import Control.Monad
( liftM
, ap
, replicateM
, filterM
)
import Control.Applicative
( Applicative(..)
, (<$>)
)
import Control.Arrow
( second
)
import Test.QuickCheck.Random
newtype Gen a = MkGen{
unGen :: QCGen -> Int -> a
}
instance Functor Gen where
fmap f (MkGen h) =
MkGen (\r n -> f (h r n))
instance Applicative Gen where
pure = return
(<*>) = ap
instance Monad Gen where
return x =
MkGen (\_ _ -> x)
MkGen m >>= k =
MkGen (\r n ->
let (r1,r2) = split r
MkGen m' = k (m r1 n)
in m' r2 n
)
variant :: Integral n => n -> Gen a -> Gen a
variant k (MkGen g) = MkGen (\r n -> g (variantQCGen k r) n)
sized :: (Int -> Gen a) -> Gen a
sized f = MkGen (\r n -> let MkGen m = f n in m r n)
resize :: Int -> Gen a -> Gen a
resize n _ | n < 0 = error "Test.QuickCheck.resize: negative size"
resize n (MkGen g) = MkGen (\r _ -> g r n)
scale :: (Int -> Int) -> Gen a -> Gen a
scale f g = sized (\n -> resize (f n) g)
choose :: Random a => (a,a) -> Gen a
choose rng = MkGen (\r _ -> let (x,_) = randomR rng r in x)
generate :: Gen a -> IO a
generate (MkGen g) =
do r <- newQCGen
return (g r 30)
sample' :: Gen a -> IO [a]
sample' g =
generate (sequence [ resize n g | n <- [0,2..20] ])
sample :: Show a => Gen a -> IO ()
sample g =
do cases <- sample' g
mapM_ print cases
suchThat :: Gen a -> (a -> Bool) -> Gen a
gen `suchThat` p =
do mx <- gen `suchThatMaybe` p
case mx of
Just x -> return x
Nothing -> sized (\n -> resize (n+1) (gen `suchThat` p))
suchThatMaybe :: Gen a -> (a -> Bool) -> Gen (Maybe a)
gen `suchThatMaybe` p = sized (try 0 . max 1)
where
try _ 0 = return Nothing
try k n = do x <- resize (2*k+n) gen
if p x then return (Just x) else try (k+1) (n1)
oneof :: [Gen a] -> Gen a
oneof [] = error "QuickCheck.oneof used with empty list"
oneof gs = choose (0,length gs 1) >>= (gs !!)
frequency :: [(Int, Gen a)] -> Gen a
frequency [] = error "QuickCheck.frequency used with empty list"
frequency xs0 = choose (1, tot) >>= (`pick` xs0)
where
tot = sum (map fst xs0)
pick n ((k,x):xs)
| n <= k = x
| otherwise = pick (nk) xs
pick _ _ = error "QuickCheck.pick used with empty list"
elements :: [a] -> Gen a
elements [] = error "QuickCheck.elements used with empty list"
elements xs = (xs !!) `fmap` choose (0, length xs 1)
sublistOf :: [a] -> Gen [a]
sublistOf xs = filterM (\_ -> choose (False, True)) xs
shuffle :: [a] -> Gen [a]
shuffle [] = return []
shuffle xs = do
(y, ys) <- elements (selectOne xs)
(y:) <$> shuffle ys
where
selectOne [] = []
selectOne (y:ys) = (y,ys) : map (second (y:)) (selectOne ys)
growingElements :: [a] -> Gen a
growingElements [] = error "QuickCheck.growingElements used with empty list"
growingElements xs = sized $ \n -> elements (take (1 `max` size n) xs)
where
k = length xs
mx = 100
log' = round . log . toDouble
size n = (log' n + 1) * k `div` log' mx
toDouble = fromIntegral :: Int -> Double
listOf :: Gen a -> Gen [a]
listOf gen = sized $ \n ->
do k <- choose (0,n)
vectorOf k gen
listOf1 :: Gen a -> Gen [a]
listOf1 gen = sized $ \n ->
do k <- choose (1,1 `max` n)
vectorOf k gen
vectorOf :: Int -> Gen a -> Gen [a]
vectorOf = replicateM
infiniteListOf :: Gen a -> Gen [a]
infiniteListOf gen = sequence (repeat gen)