-- | This module implements a simplified, pure version of Test.Quickcheck's
-- quickCheck functionality.

-- Author: Bertram Felgenhauer
-- License: MIT

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE CPP #-}

module Test.QuickCheck.Safe (
    -- * Checking properties
    quickCheck, quickCheckResult, quickCheckWith, quickCheckWithResult,
    -- * Creating and combining properties
    STestable(),
    (==>), (.||.), (.&&.), (.&.), (===),
    label, shrinking, noShrinking, mapSize,
    forAll, forAllShrink,
    -- * Miscellaneous
    inventQCGen,
    module Test.QuickCheck
) where

import Test.QuickCheck.Safe.Trusted

import Test.QuickCheck hiding (
    Testable(..), Property(..),
    (==>), (.||.), (.&&.), (.&.), (===),
    label, shrinking, noShrinking, mapSize,
    forAll, forAllShrink,
    classify, collect, conjoin, counterexample, cover, disjoin,
    expectFailure, once, printTestCase, verbose, within,
    quickCheck, quickCheckResult, quickCheckWith, quickCheckWithResult)
import Test.QuickCheck.Gen (Gen(..))
import Control.Monad
import qualified Data.Set as S
import qualified Data.Map as M

-- STestable and SProperty are simplified versions of Testable/Property
class STestable prop where
    sProperty :: prop -> SProperty

newtype SProperty = MkSProperty{ SProperty -> Gen SResult
unSProperty :: Gen SResult }

data SResult
    = SOk                                -- success
    | SDiscard                           -- discarded sample
    | SFail{                             -- failed sample
        SResult -> [String]
sLabels :: [String],             -- text describing counterexample
        SResult -> Maybe AnException
sException :: Maybe AnException, -- caught exception, if any
        SResult -> [SResult]
sSmaller :: [SResult]            -- results of shrunk examples
    }

instance STestable SProperty where
    sProperty :: SProperty -> SProperty
sProperty SProperty
prop = SProperty
prop

instance STestable prop => STestable (Gen prop) where
    sProperty :: Gen prop -> SProperty
sProperty Gen prop
gen = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ Gen prop
gen Gen prop -> (prop -> Gen SResult) -> Gen SResult
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop -> SProperty) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty

-- instance STestable Discard where
--     sProperty _ = MkSProperty . return $ SDiscard

instance STestable Bool where
    sProperty :: Bool -> SProperty
sProperty Bool
b = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty)
-> (SResult -> Gen SResult) -> SResult -> SProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SResult -> Gen SResult
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SResult -> SProperty) -> SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ case Bool -> Either AnException Bool
forall a. a -> Either AnException a
pureEvaluate Bool
b of
        Right Bool
True -> SResult
SOk
        Right Bool
_ -> SFail{ sLabels :: [String]
sLabels = [], sException :: Maybe AnException
sException = Maybe AnException
forall a. Maybe a
Nothing, sSmaller :: [SResult]
sSmaller = [] }
        Left AnException
e -> SFail{ sLabels :: [String]
sLabels = [], sException :: Maybe AnException
sException = AnException -> Maybe AnException
forall a. a -> Maybe a
Just AnException
e, sSmaller :: [SResult]
sSmaller = [] }

instance (Arbitrary a, Show a, STestable prop) => STestable (a -> prop) where
    sProperty :: (a -> prop) -> SProperty
sProperty = Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forall a prop.
(Show a, STestable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forAllShrink Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | Implication. Cf. 'Test.QuickCheck.==>'.
(==>) :: STestable prop => Bool -> prop -> SProperty
Bool
t ==> :: forall prop. STestable prop => Bool -> prop -> SProperty
==> prop
p = case Bool -> Either AnException Bool
forall a. a -> Either AnException a
pureEvaluate Bool
t of
    Right Bool
True -> prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop -> SProperty) -> prop -> SProperty
forall a b. (a -> b) -> a -> b
$ prop
p
    Right Bool
_ -> Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty)
-> (SResult -> Gen SResult) -> SResult -> SProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SResult -> Gen SResult
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SResult -> SProperty) -> SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ SResult
SDiscard
    Left AnException
e -> Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty)
-> (SResult -> Gen SResult) -> SResult -> SProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SResult -> Gen SResult
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SResult -> SProperty) -> SResult -> SProperty
forall a b. (a -> b) -> a -> b
$
        SFail{ sLabels :: [String]
sLabels = [], sException :: Maybe AnException
sException = AnException -> Maybe AnException
forall a. a -> Maybe a
Just AnException
e, sSmaller :: [SResult]
sSmaller = [] }

-- | Equality test. Cf. 'Test.QuickCheck.==='.
(===) :: (Eq a, Show a) => a -> a -> SProperty
a
a === :: forall a. (Eq a, Show a) => a -> a -> SProperty
=== a
b = String -> SProperty -> SProperty
forall prop. STestable prop => String -> prop -> SProperty
label (a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b) (SProperty -> SProperty) -> SProperty -> SProperty
forall a b. (a -> b) -> a -> b
$ Bool -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b)

-- | Conjunction. Cf. 'Test.QuickCheck..&&.'.
(.&&.) :: (STestable prop2, STestable prop1) => prop1 -> prop2 -> SProperty
prop1
prop1 .&&. :: forall prop2 prop1.
(STestable prop2, STestable prop1) =>
prop1 -> prop2 -> SProperty
.&&. prop2
prop2 = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ do
    SResult
res1 <- SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult) -> SProperty -> Gen SResult
forall a b. (a -> b) -> a -> b
$ String -> prop1 -> SProperty
forall prop. STestable prop => String -> prop -> SProperty
label String
"LHS" (prop1 -> SProperty) -> prop1 -> SProperty
forall a b. (a -> b) -> a -> b
$ prop1
prop1
    case SResult
res1 of
        SResult
SOk -> SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult) -> SProperty -> Gen SResult
forall a b. (a -> b) -> a -> b
$ String -> prop2 -> SProperty
forall prop. STestable prop => String -> prop -> SProperty
label String
"RHS" (prop2 -> SProperty) -> prop2 -> SProperty
forall a b. (a -> b) -> a -> b
$ prop2
prop2
        SResult
_ -> SResult -> Gen SResult
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return SResult
res1

-- | Disjunction. Cf. 'Test.QuickCheck..||.'.
(.||.) :: (STestable prop2, STestable prop1) => prop1 -> prop2 -> SProperty
prop1
prop1 .||. :: forall prop2 prop1.
(STestable prop2, STestable prop1) =>
prop1 -> prop2 -> SProperty
.||. prop2
prop2 = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ do
    SResult
res1 <- SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop1 -> SProperty) -> prop1 -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop1 -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop1 -> Gen SResult) -> prop1 -> Gen SResult
forall a b. (a -> b) -> a -> b
$ prop1
prop1
    SResult
res2 <- SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop2 -> SProperty) -> prop2 -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop2 -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop2 -> Gen SResult) -> prop2 -> Gen SResult
forall a b. (a -> b) -> a -> b
$ prop2
prop2
    let merge :: SResult -> SResult -> SResult
merge res1 :: SResult
res1@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = [SResult]
shr1 } res2 :: SResult
res2@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = [SResult]
shr2 } =
            SFail{
                sLabels :: [String]
sLabels = SResult -> [String]
sLabels SResult
res1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ SResult -> [String]
sLabels SResult
res2,
                sException :: Maybe AnException
sException = SResult -> Maybe AnException
sException SResult
res1 Maybe AnException -> Maybe AnException -> Maybe AnException
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` SResult -> Maybe AnException
sException SResult
res2,
                sSmaller :: [SResult]
sSmaller = (SResult -> SResult) -> [SResult] -> [SResult]
forall a b. (a -> b) -> [a] -> [b]
map (SResult -> SResult -> SResult
`merge` SResult
res2) [SResult]
shr1 [SResult] -> [SResult] -> [SResult]
forall a. [a] -> [a] -> [a]
++ (SResult -> SResult) -> [SResult] -> [SResult]
forall a b. (a -> b) -> [a] -> [b]
map (SResult
res1 SResult -> SResult -> SResult
`merge`) [SResult]
shr2
            }
        merge SResult
res1 SFail{} = SResult
res1
        merge SFail{} SResult
res2 = SResult
res2
    SResult -> Gen SResult
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SResult -> Gen SResult) -> SResult -> Gen SResult
forall a b. (a -> b) -> a -> b
$ SResult
res1 SResult -> SResult -> SResult
`merge` SResult
res2

-- | Nondeterministic conjunction. Cf. 'Test.QuickCheck.&.'.
(.&.) :: (STestable prop2, STestable prop1) => prop1 -> prop2 -> SProperty
prop1
prop1 .&. :: forall prop2 prop1.
(STestable prop2, STestable prop1) =>
prop1 -> prop2 -> SProperty
.&. prop2
prop2 = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ do
    Int
c <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
1)
    case Int
c :: Int of
        Int
0 -> SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult) -> SProperty -> Gen SResult
forall a b. (a -> b) -> a -> b
$ String -> prop1 -> SProperty
forall prop. STestable prop => String -> prop -> SProperty
label String
"LHS" prop1
prop1
        Int
1 -> SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult) -> SProperty -> Gen SResult
forall a b. (a -> b) -> a -> b
$ String -> prop2 -> SProperty
forall prop. STestable prop => String -> prop -> SProperty
label String
"RHS" prop2
prop2

-- | Label tests. Cf. 'Test.QuickCheck.label'.
label :: STestable prop => String -> prop -> SProperty
label :: forall prop. STestable prop => String -> prop -> SProperty
label String
lab = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty)
-> (prop -> Gen SResult) -> prop -> SProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SResult -> SResult) -> Gen SResult -> Gen SResult
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> SResult -> SResult
labelSResult String
lab) (Gen SResult -> Gen SResult)
-> (prop -> Gen SResult) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop -> SProperty) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty

labelSResult :: String -> SResult -> SResult
labelSResult :: String -> SResult -> SResult
labelSResult String
lab = ([String] -> [String]) -> SResult -> SResult
mapSResultLabels (String
lab String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)

mapSResultLabels :: ([String] -> [String]) -> SResult -> SResult
mapSResultLabels :: ([String] -> [String]) -> SResult -> SResult
mapSResultLabels [String] -> [String]
f res :: SResult
res@SFail{} = SResult
res{
    sLabels = f (sLabels res),
    sSmaller = map (mapSResultLabels f) (sSmaller res)
 }
mapSResultLabels [String] -> [String]
_ SResult
res = SResult
res

-- | Shrink counterexamples. Cf. 'Test.QuickCheck.shrinking'.
shrinking :: STestable prop => (a -> [a]) -> a -> (a -> prop) -> SProperty
shrinking :: forall prop a.
STestable prop =>
(a -> [a]) -> a -> (a -> prop) -> SProperty
shrinking a -> [a]
shr a
x a -> prop
f = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ (QCGen -> Int -> SResult) -> Gen SResult
forall a. (QCGen -> Int -> a) -> Gen a
MkGen ((QCGen -> Int -> SResult) -> Gen SResult)
-> (QCGen -> Int -> SResult) -> Gen SResult
forall a b. (a -> b) -> a -> b
$ \QCGen
seed Int
size -> do
    let unfold :: a -> SResult
unfold a
x = case Gen SResult -> QCGen -> Int -> SResult
forall a. Gen a -> QCGen -> Int -> a
unGen (SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop -> SProperty) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop -> Gen SResult) -> prop -> Gen SResult
forall a b. (a -> b) -> a -> b
$ a -> prop
f a
x) QCGen
seed Int
size of
            res :: SResult
res@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = [SResult]
ps } ->
                SResult
res{ sSmaller = map unfold (shr x) ++ sSmaller res }
            SResult
res -> SResult
res
    a -> SResult
unfold a
x

-- | Suppress shrinking of counterexamples. Cf. 'Test.QuickCheck.noShrinking'.
noShrinking :: STestable prop => prop -> SProperty
noShrinking :: forall prop. STestable prop => prop -> SProperty
noShrinking prop
prop = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ do
    SResult
res <- SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop -> SProperty) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop -> Gen SResult) -> prop -> Gen SResult
forall a b. (a -> b) -> a -> b
$ prop
prop
    SResult -> Gen SResult
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SResult -> Gen SResult) -> SResult -> Gen SResult
forall a b. (a -> b) -> a -> b
$ case SResult
res of
        SFail{} -> SResult
res{ sSmaller = [] }
        SResult
_ -> SResult
res

-- | Universal quantification with shrinking.
-- Cf. 'Test.QuickCheck.forAllShrink'.
forAllShrink :: (Show a, STestable prop) =>
    Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forAllShrink :: forall a prop.
(Show a, STestable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forAllShrink Gen a
gen a -> [a]
shr a -> prop
f = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty) -> Gen SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ do
    a
x <- Gen a
gen
    SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (SProperty -> SProperty) -> SProperty -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SProperty -> SProperty
forall prop. STestable prop => String -> prop -> SProperty
label (a -> String
forall a. Show a => a -> String
show a
x) (SProperty -> Gen SResult) -> SProperty -> Gen SResult
forall a b. (a -> b) -> a -> b
$ (a -> [a]) -> a -> (a -> prop) -> SProperty
forall prop a.
STestable prop =>
(a -> [a]) -> a -> (a -> prop) -> SProperty
shrinking a -> [a]
shr a
x a -> prop
f

-- | Universal quantification. Cf. 'Test.QuickCheck.forAll'.
forAll :: (Show a, STestable prop) => Gen a -> (a -> prop) -> SProperty
forAll :: forall a prop.
(Show a, STestable prop) =>
Gen a -> (a -> prop) -> SProperty
forAll Gen a
gen = Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forall a prop.
(Show a, STestable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forAllShrink Gen a
gen ([a] -> a -> [a]
forall a b. a -> b -> a
const [])

-- | Adjust testcase sizes. Cf. 'Test.QuickCheck.mapSize'.
mapSize :: STestable prop => (Int -> Int) -> prop -> SProperty
mapSize :: forall prop. STestable prop => (Int -> Int) -> prop -> SProperty
mapSize Int -> Int
f = Gen SResult -> SProperty
MkSProperty (Gen SResult -> SProperty)
-> (prop -> Gen SResult) -> prop -> SProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Gen SResult -> Gen SResult
forall {a}. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
f (Gen SResult -> Gen SResult)
-> (prop -> Gen SResult) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop -> SProperty) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty where
    scale :: (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
f Gen a
a = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized (\Int
n -> Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize (Int -> Int
f Int
n) Gen a
a)

-- Other combinators that may be considered:

-- classify :: STestable prop => Bool -> String -> prop -> SProperty
-- collect :: (Show a, STestable prop) => a -> prop -> SProperty
-- conjoin :: STestable prop => [prop] -> SProperty
-- counterexample :: STestable prop => String -> prop -> SProperty
-- cover :: STestable prop => Bool -> Int -> String -> prop -> SProperty
-- disjoin :: STestable prop => [prop] -> SProperty
-- expectFailure :: STestable prop => prop -> SProperty
-- once :: STestable prop => prop -> SProperty
-- printTestCase :: STestable prop => String -> prop -> SProperty
-- verbose :: STestable prop => prop -> SProperty
-- within :: STestable prop => Int -> prop -> SProperty

-- | Cf. 'Test.QuickCheck.quickCheckWithResult'. Note that in contrast to
-- QuickCheck's function, this one takes an additional 'QCGen' argument.
quickCheckWithResult :: STestable prop => Args -> QCGen -> prop -> Result
quickCheckWithResult :: forall prop. STestable prop => Args -> QCGen -> prop -> Result
quickCheckWithResult Args
args QCGen
seed prop
prop = Gen Result -> QCGen -> Int -> Result
forall a. Gen a -> QCGen -> Int -> a
unGen (Int -> Int -> [Int] -> Gen Result
runTests Int
0 Int
0 [Int]
sizes) QCGen
seed' Int
0 where
    runTests :: Int -> Int -> [Int] -> Gen Result
    runTests :: Int -> Int -> [Int] -> Gen Result
runTests Int
pass Int
disc (Int
size : [Int]
sizes)
        | Int
pass Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Args -> Int
maxSuccess Args
args =
            Result -> Gen Result
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Success{
                numTests :: Int
numTests = Int
pass,
#if MIN_VERSION_QuickCheck(2,12,0)
                numDiscarded :: Int
numDiscarded = Int
disc,
                labels :: Map [String] Int
labels = Map [String] Int
forall k a. Map k a
M.empty,
                classes :: Map String Int
classes = Map String Int
forall k a. Map k a
M.empty,
                tables :: Map String (Map String Int)
tables = Map String (Map String Int)
forall k a. Map k a
M.empty,
#else
                labels = [],
#endif
                output :: String
output = String
"+++ OK, passed " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pass String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests.\n"
             }
        | Int
disc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Args -> Int
maxDiscardRatio Args
args Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Args -> Int
maxSuccess Args
args =
            Result -> Gen Result
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return GaveUp{
                numTests :: Int
numTests = Int
pass,
#if MIN_VERSION_QuickCheck(2,12,0)
                numDiscarded :: Int
numDiscarded = Int
disc,
                labels :: Map [String] Int
labels = Map [String] Int
forall k a. Map k a
M.empty,
                classes :: Map String Int
classes = Map String Int
forall k a. Map k a
M.empty,
                tables :: Map String (Map String Int)
tables = Map String (Map String Int)
forall k a. Map k a
M.empty,
#else
                labels = [],
#endif
                output :: String
output = String
"*** Gave up! Passed only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pass String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests.\n"
             }
        | Bool
otherwise = do
            (QCGen
seed, Int
_) <- (QCGen -> Int -> (QCGen, Int)) -> Gen (QCGen, Int)
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (,)
            SResult
res <- Int -> Gen SResult -> Gen SResult
forall a. Int -> Gen a -> Gen a
resize Int
size (SProperty -> Gen SResult
unSProperty (SProperty -> Gen SResult)
-> (prop -> SProperty) -> prop -> Gen SResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop -> Gen SResult) -> prop -> Gen SResult
forall a b. (a -> b) -> a -> b
$ prop
prop)
            case SResult
res of
                SResult
SOk -> Int -> Int -> [Int] -> Gen Result
runTests (Int
pass Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
disc [Int]
sizes
                SResult
SDiscard -> Int -> Int -> [Int] -> Gen Result
runTests Int
pass (Int
disc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
sizes
                SFail{} -> Result -> Gen Result
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> Gen Result) -> Result -> Gen Result
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> Int -> Int -> Int -> QCGen -> Int -> SResult -> Result
deflate Int
pass Int
disc Int
0 Int
0 Int
0 QCGen
seed Int
size SResult
res

    deflate :: Int -> Int -> Int -> Int -> Int -> QCGen -> Int -> SResult -> Result
    deflate :: Int
-> Int -> Int -> Int -> Int -> QCGen -> Int -> SResult -> Result
deflate Int
pass Int
disc !Int
shr !Int
shrT !Int
shrF QCGen
seed Int
size res :: SResult
res@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = [] } =
        Failure{
            numTests :: Int
numTests = Int
pass,
            numShrinks :: Int
numShrinks = Int
shr,
            numShrinkTries :: Int
numShrinkTries = Int
shrT,
            numShrinkFinal :: Int
numShrinkFinal = Int
shrF,
            usedSeed :: QCGen
usedSeed = QCGen
seed,
            usedSize :: Int
usedSize = Int
size,
            reason :: String
reason = String
reason,
            theException :: Maybe AnException
theException = SResult -> Maybe AnException
sException SResult
res,
#if MIN_VERSION_QuickCheck(2,10,0)
            failingTestCase :: [String]
failingTestCase = SResult -> [String]
sLabels SResult
res,
#endif
#if !MIN_VERSION_QuickCheck(2,12,0)
            labels = map (\x -> (x, 0)) (sLabels res),
#else
            numDiscarded :: Int
numDiscarded = Int
disc,
            failingLabels :: [String]
failingLabels = SResult -> [String]
sLabels SResult
res,
            failingClasses :: Set String
failingClasses = Set String
forall a. Set a
S.empty,
#endif
            output :: String
output = String
"*** Failed! " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reason String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
" (after " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall {a}. (Show a, Eq a, Num a) => a -> String -> String
count (Int
pass Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
"test" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  (if Int
shr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall {a}. (Show a, Eq a, Num a) => a -> String -> String
count Int
shr String
"shrink" else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
"):\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (SResult -> [String]
sLabels SResult
res)
        }
      where
        count :: a -> String -> String
count a
i String
w = a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
's' | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
1]
        reason :: String
reason = String -> (AnException -> String) -> Maybe AnException -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Falsifiable" (\AnException
e -> String
"Exception: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnException -> String
forall a. Show a => a -> String
show AnException
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") (Maybe AnException -> String) -> Maybe AnException -> String
forall a b. (a -> b) -> a -> b
$
            SResult -> Maybe AnException
sException SResult
res
    deflate Int
pass Int
disc Int
shr Int
shrT Int
shrF QCGen
seed Int
size res :: SResult
res@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = SResult
res' : [SResult]
rs } =
        case SResult
res' of
            SFail{} -> Int
-> Int -> Int -> Int -> Int -> QCGen -> Int -> SResult -> Result
deflate Int
pass Int
disc (Int
shr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
shrT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shrF) Int
0 QCGen
seed Int
size SResult
res'
            SResult
_ -> Int
-> Int -> Int -> Int -> Int -> QCGen -> Int -> SResult -> Result
deflate Int
pass Int
disc Int
shr Int
shrT (Int
shrF Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) QCGen
seed Int
size SResult
res{ sSmaller = rs }

    sizes :: [Int]
    sizes :: [Int]
sizes = [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
cycle [Int
0..Args -> Int
maxSize Args
args]

    seed' :: QCGen
    seed' :: QCGen
seed' = QCGen -> ((QCGen, Int) -> QCGen) -> Maybe (QCGen, Int) -> QCGen
forall b a. b -> (a -> b) -> Maybe a -> b
maybe QCGen
seed (QCGen, Int) -> QCGen
forall a b. (a, b) -> a
fst (Args -> Maybe (QCGen, Int)
replay Args
args)

-- | Cf. 'Test.QuickCheck.quickCheckResult'. Note that in contrast to
-- QuickCheck's function, this one takes an additional 'QCGen' argument.
quickCheckResult :: STestable prop => QCGen -> prop -> Result
quickCheckResult :: forall prop. STestable prop => QCGen -> prop -> Result
quickCheckResult = Args -> QCGen -> prop -> Result
forall prop. STestable prop => Args -> QCGen -> prop -> Result
quickCheckWithResult Args
stdArgs

-- | Cf. 'Test.QuickCheck.quickCheckWith'. Note that in contrast to
-- QuickCheck's function, this one takes an additional 'QCGen' argument.
quickCheckWith :: STestable prop => Args -> QCGen -> prop -> String
quickCheckWith :: forall prop. STestable prop => Args -> QCGen -> prop -> String
quickCheckWith Args
args QCGen
seed = Result -> String
output (Result -> String) -> (prop -> Result) -> prop -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> QCGen -> prop -> Result
forall prop. STestable prop => Args -> QCGen -> prop -> Result
quickCheckWithResult Args
args QCGen
seed

-- | Cf. 'Test.QuickCheck.quickCheck'. Note that in contrast to QuickCheck's
-- function, this one takes an additional 'QCGen' argument.
--
-- >>> putStr $ quickCheck (inventQCGen ()) (\x -> length (x :: [()]) < 10)
-- *** Failed! Falsifiable (after 18 tests and 3 shrinks):
-- [(),(),(),(),(),(),(),(),(),(),(),(),(),(),()]
quickCheck :: STestable prop => QCGen -> prop -> String
quickCheck :: forall prop. STestable prop => QCGen -> prop -> String
quickCheck = Args -> QCGen -> prop -> String
forall prop. STestable prop => Args -> QCGen -> prop -> String
quickCheckWith Args
stdArgs