{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE CPP #-}
module Test.QuickCheck.Safe (
quickCheck, quickCheckResult, quickCheckWith, quickCheckWithResult,
STestable(),
(==>), (.||.), (.&&.), (.&.), (===),
label, shrinking, noShrinking, mapSize,
forAll, forAllShrink,
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
class STestable prop where
sProperty :: prop -> SProperty
newtype SProperty = MkSProperty{ SProperty -> Gen SResult
unSProperty :: Gen SResult }
data SResult
= SOk
| SDiscard
| SFail{
SResult -> [String]
sLabels :: [String],
SResult -> Maybe AnException
sException :: Maybe AnException,
SResult -> [SResult]
sSmaller :: [SResult]
}
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 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
(==>) :: 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 = [] }
(===) :: (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)
(.&&.) :: (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
(.||.) :: (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
(.&.) :: (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 :: 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
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
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
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
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 [])
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)
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)
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
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
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