-- | 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 prop :: SProperty
prop = SProperty
prop

instance STestable prop => STestable (Gen prop) where
    sProperty :: Gen prop -> SProperty
sProperty gen :: 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 (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 b :: 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 (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 True -> SResult
SOk
        Right _ -> SFail :: [String] -> Maybe AnException -> [SResult] -> SResult
SFail{ sLabels :: [String]
sLabels = [], sException :: Maybe AnException
sException = Maybe AnException
forall a. Maybe a
Nothing, sSmaller :: [SResult]
sSmaller = [] }
        Left e :: AnException
e -> SFail :: [String] -> Maybe AnException -> [SResult] -> SResult
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
t :: Bool
t ==> :: Bool -> prop -> SProperty
==> p :: prop
p = case Bool -> Either AnException Bool
forall a. a -> Either AnException a
pureEvaluate Bool
t of
    Right True -> prop -> SProperty
forall prop. STestable prop => prop -> SProperty
sProperty (prop -> SProperty) -> prop -> SProperty
forall a b. (a -> b) -> a -> b
$ prop
p
    Right _ -> 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 (m :: * -> *) a. Monad m => a -> m a
return (SResult -> SProperty) -> SResult -> SProperty
forall a b. (a -> b) -> a -> b
$ SResult
SDiscard
    Left e :: 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 (m :: * -> *) a. Monad m => a -> m a
return (SResult -> SProperty) -> SResult -> SProperty
forall a b. (a -> b) -> a -> b
$
        SFail :: [String] -> Maybe AnException -> [SResult] -> SResult
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
a === :: a -> a -> SProperty
=== b :: 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
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
prop1 .&&. :: prop1 -> prop2 -> SProperty
.&&. prop2 :: 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 "LHS" (prop1 -> SProperty) -> prop1 -> SProperty
forall a b. (a -> b) -> a -> b
$ prop1
prop1
    case SResult
res1 of
        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 "RHS" (prop2 -> SProperty) -> prop2 -> SProperty
forall a b. (a -> b) -> a -> b
$ prop2
prop2
        _ -> SResult -> Gen SResult
forall (m :: * -> *) a. Monad m => a -> m a
return SResult
res1

-- | Disjunction. Cf. 'Test.QuickCheck..||.'.
(.||.) :: (STestable prop2, STestable prop1) => prop1 -> prop2 -> SProperty
prop1 :: prop1
prop1 .||. :: prop1 -> prop2 -> SProperty
.||. prop2 :: 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 :: [String] -> Maybe AnException -> [SResult] -> SResult
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 (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 res1 :: SResult
res1 SFail{} = SResult
res1
        merge SFail{} res2 :: SResult
res2 = SResult
res2
    SResult -> Gen SResult
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
prop1 .&. :: prop1 -> prop2 -> SProperty
.&. prop2 :: 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 (0, 1)
    case Int
c :: Int of
        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 "LHS" prop1
prop1
        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 "RHS" prop2
prop2

-- | Label tests. Cf. 'Test.QuickCheck.label'.
label :: STestable prop => String -> prop -> SProperty
label :: String -> prop -> SProperty
label lab :: 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 (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 lab :: 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 f :: [String] -> [String]
f res :: SResult
res@SFail{} = SResult
res{
    sLabels :: [String]
sLabels = [String] -> [String]
f (SResult -> [String]
sLabels SResult
res),
    sSmaller :: [SResult]
sSmaller = (SResult -> SResult) -> [SResult] -> [SResult]
forall a b. (a -> b) -> [a] -> [b]
map (([String] -> [String]) -> SResult -> SResult
mapSResultLabels [String] -> [String]
f) (SResult -> [SResult]
sSmaller SResult
res)
 }
mapSResultLabels _ res :: SResult
res = SResult
res

-- | Shrink counterexamples. Cf. 'Test.QuickCheck.shrinking'.
shrinking :: STestable prop => (a -> [a]) -> a -> (a -> prop) -> SProperty
shrinking :: (a -> [a]) -> a -> (a -> prop) -> SProperty
shrinking shr :: a -> [a]
shr x :: a
x f :: 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
$ \seed :: QCGen
seed size :: Int
size -> do
    let unfold :: a -> SResult
unfold x :: 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 :: [SResult]
sSmaller = (a -> SResult) -> [a] -> [SResult]
forall a b. (a -> b) -> [a] -> [b]
map a -> SResult
unfold (a -> [a]
shr a
x) [SResult] -> [SResult] -> [SResult]
forall a. [a] -> [a] -> [a]
++ SResult -> [SResult]
sSmaller SResult
res }
            res :: SResult
res -> SResult
res
    a -> SResult
unfold a
x

-- | Suppress shrinking of counterexamples. Cf. 'Test.QuickCheck.noShrinking'.
noShrinking :: STestable prop => prop -> SProperty
noShrinking :: prop -> SProperty
noShrinking prop :: 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 (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]
sSmaller = [] }
        _ -> SResult
res

-- | Universal quantification with shrinking.
-- Cf. 'Test.QuickCheck.forAllShrink'.
forAllShrink :: (Show a, STestable prop) =>
    Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forAllShrink :: Gen a -> (a -> [a]) -> (a -> prop) -> SProperty
forAllShrink gen :: Gen a
gen shr :: a -> [a]
shr f :: 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 :: Gen a -> (a -> prop) -> SProperty
forAll gen :: 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 :: (Int -> Int) -> prop -> SProperty
mapSize f :: 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 f :: Int -> Int
f a :: Gen a
a = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized (\n :: 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 :: Args -> QCGen -> prop -> Result
quickCheckWithResult args :: Args
args seed :: QCGen
seed prop :: prop
prop = Gen Result -> QCGen -> Int -> Result
forall a. Gen a -> QCGen -> Int -> a
unGen (Int -> Int -> [Int] -> Gen Result
runTests 0 0 [Int]
sizes) QCGen
seed' 0 where
    runTests :: Int -> Int -> [Int] -> Gen Result
    runTests :: Int -> Int -> [Int] -> Gen Result
runTests pass :: Int
pass disc :: Int
disc (size :: Int
size : sizes :: [Int]
sizes)
        | Int
pass Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Args -> Int
maxSuccess Args
args =
            Result -> Gen Result
forall (m :: * -> *) a. Monad m => a -> m a
return $WSuccess :: Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> String
-> Result
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 = "+++ 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]
++ " 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
- 1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Args -> Int
maxSuccess Args
args =
            Result -> Gen Result
forall (m :: * -> *) a. Monad m => a -> m a
return $WGaveUp :: Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> String
-> Result
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 = "*** 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]
++ " tests.\n"
             }
        | Bool
otherwise = do
            (seed :: QCGen
seed, _) <- (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
                SOk -> Int -> Int -> [Int] -> Gen Result
runTests (Int
pass Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int
disc [Int]
sizes
                SDiscard -> Int -> Int -> [Int] -> Gen Result
runTests Int
pass (Int
disc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [Int]
sizes
                SFail{} -> Result -> Gen Result
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 0 0 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 pass :: Int
pass disc :: Int
disc !Int
shr !Int
shrT !Int
shrF seed :: QCGen
seed size :: Int
size res :: SResult
res@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = [] } =
        Failure :: Int
-> Int
-> Int
-> Int
-> Int
-> QCGen
-> Int
-> String
-> Maybe AnException
-> String
-> [String]
-> [String]
-> Set String
-> Result
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 = "*** Failed! " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
reason String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  " (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
+ 1) "test" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  (if Int
shr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then " 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 "shrink" else "") String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  "):\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (SResult -> [String]
sLabels SResult
res)
        }
      where
        count :: a -> String -> String
count i :: a
i w :: String
w = a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['s' | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 1]
        reason :: String
reason = String -> (AnException -> String) -> Maybe AnException -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "Falsifiable" (\e :: AnException
e -> "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]
++ "'") (Maybe AnException -> String) -> Maybe AnException -> String
forall a b. (a -> b) -> a -> b
$
            SResult -> Maybe AnException
sException SResult
res
    deflate pass :: Int
pass disc :: Int
disc shr :: Int
shr shrT :: Int
shrT shrF :: Int
shrF seed :: QCGen
seed size :: Int
size res :: SResult
res@SFail{ sSmaller :: SResult -> [SResult]
sSmaller = res' :: SResult
res' : rs :: [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
+ 1) (Int
shrT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shrF) 0 QCGen
seed Int
size SResult
res'
            _ -> 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
+ 1) QCGen
seed Int
size SResult
res{ sSmaller :: [SResult]
sSmaller = [SResult]
rs }

    sizes :: [Int]
    sizes :: [Int]
sizes = [Int] -> [Int]
forall a. [a] -> [a]
cycle [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 :: 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 :: Args -> QCGen -> prop -> String
quickCheckWith args :: Args
args seed :: 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 :: QCGen -> prop -> String
quickCheck = Args -> QCGen -> prop -> String
forall prop. STestable prop => Args -> QCGen -> prop -> String
quickCheckWith Args
stdArgs