-- | This module allows to use QuickCheck properties in tasty.
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
module Test.Tasty.QuickCheck
  ( testProperty
  , testProperties
  , QuickCheckTests(..)
  , QuickCheckReplay(..)
  , QuickCheckShowReplay(..)
  , QuickCheckMaxSize(..)
  , QuickCheckMaxRatio(..)
  , QuickCheckVerbose(..)
  , QuickCheckMaxShrinks(..)
    -- * Re-export of Test.QuickCheck
  , module Test.QuickCheck
    -- * Internal
    -- | If you are building a test suite, you don't need these functions.
    --
    -- They may be used by other tasty add-on packages (such as tasty-hspec).
  , QC(..)
  , optionSetToArgs
  ) where

import Test.Tasty ( testGroup )
import Test.Tasty.Providers
import Test.Tasty.Options
import qualified Test.QuickCheck as QC
import Test.Tasty.Runners (formatMessage)
import Test.QuickCheck hiding -- for re-export
  ( quickCheck
  , Args(..)
  , Result
  , stdArgs
  , quickCheckWith
  , quickCheckWithResult
  , quickCheckResult
  , verboseCheck
  , verboseCheckWith
  , verboseCheckWithResult
  , verboseCheckResult
  , verbose
  -- Template Haskell functions
#if MIN_VERSION_QuickCheck(2,11,0)
  , allProperties
#endif
  , forAllProperties
  , quickCheckAll
  , verboseCheckAll
  )

import Data.Typeable
import Data.List
import Text.Printf
import Test.QuickCheck.Random (mkQCGen)
import Options.Applicative (metavar)
import System.Random (getStdRandom, randomR)
#if !MIN_VERSION_base(4,9,0)
import Control.Applicative
import Data.Monoid
#endif

newtype QC = QC QC.Property
  deriving Typeable

-- | Create a 'Test' for a QuickCheck 'QC.Testable' property
testProperty :: QC.Testable a => TestName -> a -> TestTree
testProperty :: forall a. Testable a => String -> a -> TestTree
testProperty String
name a
prop = forall t. IsTest t => String -> t -> TestTree
singleTest String
name forall a b. (a -> b) -> a -> b
$ Property -> QC
QC forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => prop -> Property
QC.property a
prop

-- | Create a test from a list of QuickCheck properties. To be used
-- with 'Test.QuickCheck.allProperties'. E.g.
--
-- >tests :: TestTree
-- >tests = testProperties "Foo" $allProperties
testProperties :: TestName -> [(String, Property)] -> TestTree
testProperties :: String -> [(String, Property)] -> TestTree
testProperties String
name = String -> [TestTree] -> TestTree
testGroup String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Testable a => String -> a -> TestTree
testProperty)

-- | Number of test cases for QuickCheck to generate
newtype QuickCheckTests = QuickCheckTests Int
  deriving (Integer -> QuickCheckTests
QuickCheckTests -> QuickCheckTests
QuickCheckTests -> QuickCheckTests -> QuickCheckTests
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> QuickCheckTests
$cfromInteger :: Integer -> QuickCheckTests
signum :: QuickCheckTests -> QuickCheckTests
$csignum :: QuickCheckTests -> QuickCheckTests
abs :: QuickCheckTests -> QuickCheckTests
$cabs :: QuickCheckTests -> QuickCheckTests
negate :: QuickCheckTests -> QuickCheckTests
$cnegate :: QuickCheckTests -> QuickCheckTests
* :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$c* :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
- :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$c- :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
+ :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$c+ :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
Num, Eq QuickCheckTests
QuickCheckTests -> QuickCheckTests -> Bool
QuickCheckTests -> QuickCheckTests -> Ordering
QuickCheckTests -> QuickCheckTests -> QuickCheckTests
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$cmin :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
max :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$cmax :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
>= :: QuickCheckTests -> QuickCheckTests -> Bool
$c>= :: QuickCheckTests -> QuickCheckTests -> Bool
> :: QuickCheckTests -> QuickCheckTests -> Bool
$c> :: QuickCheckTests -> QuickCheckTests -> Bool
<= :: QuickCheckTests -> QuickCheckTests -> Bool
$c<= :: QuickCheckTests -> QuickCheckTests -> Bool
< :: QuickCheckTests -> QuickCheckTests -> Bool
$c< :: QuickCheckTests -> QuickCheckTests -> Bool
compare :: QuickCheckTests -> QuickCheckTests -> Ordering
$ccompare :: QuickCheckTests -> QuickCheckTests -> Ordering
Ord, QuickCheckTests -> QuickCheckTests -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickCheckTests -> QuickCheckTests -> Bool
$c/= :: QuickCheckTests -> QuickCheckTests -> Bool
== :: QuickCheckTests -> QuickCheckTests -> Bool
$c== :: QuickCheckTests -> QuickCheckTests -> Bool
Eq, Num QuickCheckTests
Ord QuickCheckTests
QuickCheckTests -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: QuickCheckTests -> Rational
$ctoRational :: QuickCheckTests -> Rational
Real, Int -> QuickCheckTests
QuickCheckTests -> Int
QuickCheckTests -> [QuickCheckTests]
QuickCheckTests -> QuickCheckTests
QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
QuickCheckTests
-> QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuickCheckTests
-> QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
$cenumFromThenTo :: QuickCheckTests
-> QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
enumFromTo :: QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
$cenumFromTo :: QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
enumFromThen :: QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
$cenumFromThen :: QuickCheckTests -> QuickCheckTests -> [QuickCheckTests]
enumFrom :: QuickCheckTests -> [QuickCheckTests]
$cenumFrom :: QuickCheckTests -> [QuickCheckTests]
fromEnum :: QuickCheckTests -> Int
$cfromEnum :: QuickCheckTests -> Int
toEnum :: Int -> QuickCheckTests
$ctoEnum :: Int -> QuickCheckTests
pred :: QuickCheckTests -> QuickCheckTests
$cpred :: QuickCheckTests -> QuickCheckTests
succ :: QuickCheckTests -> QuickCheckTests
$csucc :: QuickCheckTests -> QuickCheckTests
Enum, Enum QuickCheckTests
Real QuickCheckTests
QuickCheckTests -> Integer
QuickCheckTests
-> QuickCheckTests -> (QuickCheckTests, QuickCheckTests)
QuickCheckTests -> QuickCheckTests -> QuickCheckTests
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: QuickCheckTests -> Integer
$ctoInteger :: QuickCheckTests -> Integer
divMod :: QuickCheckTests
-> QuickCheckTests -> (QuickCheckTests, QuickCheckTests)
$cdivMod :: QuickCheckTests
-> QuickCheckTests -> (QuickCheckTests, QuickCheckTests)
quotRem :: QuickCheckTests
-> QuickCheckTests -> (QuickCheckTests, QuickCheckTests)
$cquotRem :: QuickCheckTests
-> QuickCheckTests -> (QuickCheckTests, QuickCheckTests)
mod :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$cmod :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
div :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$cdiv :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
rem :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$crem :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
quot :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
$cquot :: QuickCheckTests -> QuickCheckTests -> QuickCheckTests
Integral, Typeable)

newtype QuickCheckReplay = QuickCheckReplay (Maybe Int)
  deriving (Typeable)

-- | If a test case fails unexpectedly, show the replay token
newtype QuickCheckShowReplay = QuickCheckShowReplay Bool
  deriving (Typeable)

-- | Size of the biggest test cases
newtype QuickCheckMaxSize = QuickCheckMaxSize Int
  deriving (Integer -> QuickCheckMaxSize
QuickCheckMaxSize -> QuickCheckMaxSize
QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> QuickCheckMaxSize
$cfromInteger :: Integer -> QuickCheckMaxSize
signum :: QuickCheckMaxSize -> QuickCheckMaxSize
$csignum :: QuickCheckMaxSize -> QuickCheckMaxSize
abs :: QuickCheckMaxSize -> QuickCheckMaxSize
$cabs :: QuickCheckMaxSize -> QuickCheckMaxSize
negate :: QuickCheckMaxSize -> QuickCheckMaxSize
$cnegate :: QuickCheckMaxSize -> QuickCheckMaxSize
* :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$c* :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
- :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$c- :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
+ :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$c+ :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
Num, Eq QuickCheckMaxSize
QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
QuickCheckMaxSize -> QuickCheckMaxSize -> Ordering
QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$cmin :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
max :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$cmax :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
>= :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
$c>= :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
> :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
$c> :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
<= :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
$c<= :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
< :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
$c< :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
compare :: QuickCheckMaxSize -> QuickCheckMaxSize -> Ordering
$ccompare :: QuickCheckMaxSize -> QuickCheckMaxSize -> Ordering
Ord, QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
$c/= :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
== :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
$c== :: QuickCheckMaxSize -> QuickCheckMaxSize -> Bool
Eq, Num QuickCheckMaxSize
Ord QuickCheckMaxSize
QuickCheckMaxSize -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: QuickCheckMaxSize -> Rational
$ctoRational :: QuickCheckMaxSize -> Rational
Real, Int -> QuickCheckMaxSize
QuickCheckMaxSize -> Int
QuickCheckMaxSize -> [QuickCheckMaxSize]
QuickCheckMaxSize -> QuickCheckMaxSize
QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
QuickCheckMaxSize
-> QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuickCheckMaxSize
-> QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
$cenumFromThenTo :: QuickCheckMaxSize
-> QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
enumFromTo :: QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
$cenumFromTo :: QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
enumFromThen :: QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
$cenumFromThen :: QuickCheckMaxSize -> QuickCheckMaxSize -> [QuickCheckMaxSize]
enumFrom :: QuickCheckMaxSize -> [QuickCheckMaxSize]
$cenumFrom :: QuickCheckMaxSize -> [QuickCheckMaxSize]
fromEnum :: QuickCheckMaxSize -> Int
$cfromEnum :: QuickCheckMaxSize -> Int
toEnum :: Int -> QuickCheckMaxSize
$ctoEnum :: Int -> QuickCheckMaxSize
pred :: QuickCheckMaxSize -> QuickCheckMaxSize
$cpred :: QuickCheckMaxSize -> QuickCheckMaxSize
succ :: QuickCheckMaxSize -> QuickCheckMaxSize
$csucc :: QuickCheckMaxSize -> QuickCheckMaxSize
Enum, Enum QuickCheckMaxSize
Real QuickCheckMaxSize
QuickCheckMaxSize -> Integer
QuickCheckMaxSize
-> QuickCheckMaxSize -> (QuickCheckMaxSize, QuickCheckMaxSize)
QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: QuickCheckMaxSize -> Integer
$ctoInteger :: QuickCheckMaxSize -> Integer
divMod :: QuickCheckMaxSize
-> QuickCheckMaxSize -> (QuickCheckMaxSize, QuickCheckMaxSize)
$cdivMod :: QuickCheckMaxSize
-> QuickCheckMaxSize -> (QuickCheckMaxSize, QuickCheckMaxSize)
quotRem :: QuickCheckMaxSize
-> QuickCheckMaxSize -> (QuickCheckMaxSize, QuickCheckMaxSize)
$cquotRem :: QuickCheckMaxSize
-> QuickCheckMaxSize -> (QuickCheckMaxSize, QuickCheckMaxSize)
mod :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$cmod :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
div :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$cdiv :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
rem :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$crem :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
quot :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
$cquot :: QuickCheckMaxSize -> QuickCheckMaxSize -> QuickCheckMaxSize
Integral, Typeable)

-- | Maximum number of of discarded tests per successful test before giving up.
newtype QuickCheckMaxRatio = QuickCheckMaxRatio Int
  deriving (Integer -> QuickCheckMaxRatio
QuickCheckMaxRatio -> QuickCheckMaxRatio
QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> QuickCheckMaxRatio
$cfromInteger :: Integer -> QuickCheckMaxRatio
signum :: QuickCheckMaxRatio -> QuickCheckMaxRatio
$csignum :: QuickCheckMaxRatio -> QuickCheckMaxRatio
abs :: QuickCheckMaxRatio -> QuickCheckMaxRatio
$cabs :: QuickCheckMaxRatio -> QuickCheckMaxRatio
negate :: QuickCheckMaxRatio -> QuickCheckMaxRatio
$cnegate :: QuickCheckMaxRatio -> QuickCheckMaxRatio
* :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$c* :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
- :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$c- :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
+ :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$c+ :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
Num, Eq QuickCheckMaxRatio
QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
QuickCheckMaxRatio -> QuickCheckMaxRatio -> Ordering
QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$cmin :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
max :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$cmax :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
>= :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
$c>= :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
> :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
$c> :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
<= :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
$c<= :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
< :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
$c< :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
compare :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Ordering
$ccompare :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Ordering
Ord, QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
$c/= :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
== :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
$c== :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> Bool
Eq, Num QuickCheckMaxRatio
Ord QuickCheckMaxRatio
QuickCheckMaxRatio -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: QuickCheckMaxRatio -> Rational
$ctoRational :: QuickCheckMaxRatio -> Rational
Real, Int -> QuickCheckMaxRatio
QuickCheckMaxRatio -> Int
QuickCheckMaxRatio -> [QuickCheckMaxRatio]
QuickCheckMaxRatio -> QuickCheckMaxRatio
QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
QuickCheckMaxRatio
-> QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuickCheckMaxRatio
-> QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
$cenumFromThenTo :: QuickCheckMaxRatio
-> QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
enumFromTo :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
$cenumFromTo :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
enumFromThen :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
$cenumFromThen :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> [QuickCheckMaxRatio]
enumFrom :: QuickCheckMaxRatio -> [QuickCheckMaxRatio]
$cenumFrom :: QuickCheckMaxRatio -> [QuickCheckMaxRatio]
fromEnum :: QuickCheckMaxRatio -> Int
$cfromEnum :: QuickCheckMaxRatio -> Int
toEnum :: Int -> QuickCheckMaxRatio
$ctoEnum :: Int -> QuickCheckMaxRatio
pred :: QuickCheckMaxRatio -> QuickCheckMaxRatio
$cpred :: QuickCheckMaxRatio -> QuickCheckMaxRatio
succ :: QuickCheckMaxRatio -> QuickCheckMaxRatio
$csucc :: QuickCheckMaxRatio -> QuickCheckMaxRatio
Enum, Enum QuickCheckMaxRatio
Real QuickCheckMaxRatio
QuickCheckMaxRatio -> Integer
QuickCheckMaxRatio
-> QuickCheckMaxRatio -> (QuickCheckMaxRatio, QuickCheckMaxRatio)
QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: QuickCheckMaxRatio -> Integer
$ctoInteger :: QuickCheckMaxRatio -> Integer
divMod :: QuickCheckMaxRatio
-> QuickCheckMaxRatio -> (QuickCheckMaxRatio, QuickCheckMaxRatio)
$cdivMod :: QuickCheckMaxRatio
-> QuickCheckMaxRatio -> (QuickCheckMaxRatio, QuickCheckMaxRatio)
quotRem :: QuickCheckMaxRatio
-> QuickCheckMaxRatio -> (QuickCheckMaxRatio, QuickCheckMaxRatio)
$cquotRem :: QuickCheckMaxRatio
-> QuickCheckMaxRatio -> (QuickCheckMaxRatio, QuickCheckMaxRatio)
mod :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$cmod :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
div :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$cdiv :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
rem :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$crem :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
quot :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
$cquot :: QuickCheckMaxRatio -> QuickCheckMaxRatio -> QuickCheckMaxRatio
Integral, Typeable)

-- | Show the test cases that QuickCheck generates
newtype QuickCheckVerbose = QuickCheckVerbose Bool
  deriving (Typeable)

-- | Number of shrinks allowed before QuickCheck will fail a test.
--
-- @since 0.10.2
newtype QuickCheckMaxShrinks = QuickCheckMaxShrinks Int
  deriving (Integer -> QuickCheckMaxShrinks
QuickCheckMaxShrinks -> QuickCheckMaxShrinks
QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> QuickCheckMaxShrinks
$cfromInteger :: Integer -> QuickCheckMaxShrinks
signum :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$csignum :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
abs :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cabs :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
negate :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cnegate :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
* :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$c* :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
- :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$c- :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
+ :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$c+ :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
Num, Eq QuickCheckMaxShrinks
QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Ordering
QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cmin :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
max :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cmax :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
>= :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
$c>= :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
> :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
$c> :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
<= :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
$c<= :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
< :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
$c< :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
compare :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Ordering
$ccompare :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Ordering
Ord, QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
$c/= :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
== :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
$c== :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks -> Bool
Eq, Num QuickCheckMaxShrinks
Ord QuickCheckMaxShrinks
QuickCheckMaxShrinks -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: QuickCheckMaxShrinks -> Rational
$ctoRational :: QuickCheckMaxShrinks -> Rational
Real, Int -> QuickCheckMaxShrinks
QuickCheckMaxShrinks -> Int
QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
QuickCheckMaxShrinks -> QuickCheckMaxShrinks
QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> [QuickCheckMaxShrinks]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> [QuickCheckMaxShrinks]
$cenumFromThenTo :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> [QuickCheckMaxShrinks]
enumFromTo :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
$cenumFromTo :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
enumFromThen :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
$cenumFromThen :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
enumFrom :: QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
$cenumFrom :: QuickCheckMaxShrinks -> [QuickCheckMaxShrinks]
fromEnum :: QuickCheckMaxShrinks -> Int
$cfromEnum :: QuickCheckMaxShrinks -> Int
toEnum :: Int -> QuickCheckMaxShrinks
$ctoEnum :: Int -> QuickCheckMaxShrinks
pred :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cpred :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
succ :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$csucc :: QuickCheckMaxShrinks -> QuickCheckMaxShrinks
Enum, Enum QuickCheckMaxShrinks
Real QuickCheckMaxShrinks
QuickCheckMaxShrinks -> Integer
QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> (QuickCheckMaxShrinks, QuickCheckMaxShrinks)
QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: QuickCheckMaxShrinks -> Integer
$ctoInteger :: QuickCheckMaxShrinks -> Integer
divMod :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> (QuickCheckMaxShrinks, QuickCheckMaxShrinks)
$cdivMod :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> (QuickCheckMaxShrinks, QuickCheckMaxShrinks)
quotRem :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> (QuickCheckMaxShrinks, QuickCheckMaxShrinks)
$cquotRem :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks
-> (QuickCheckMaxShrinks, QuickCheckMaxShrinks)
mod :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cmod :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
div :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cdiv :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
rem :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$crem :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
quot :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
$cquot :: QuickCheckMaxShrinks
-> QuickCheckMaxShrinks -> QuickCheckMaxShrinks
Integral, Typeable)

instance IsOption QuickCheckTests where
  defaultValue :: QuickCheckTests
defaultValue = QuickCheckTests
100
  parseValue :: String -> Maybe QuickCheckTests
parseValue =
    -- We allow numeric underscores for readability; see
    -- https://github.com/UnkindPartition/tasty/issues/263
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> QuickCheckTests
QuickCheckTests forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
safeRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'_')
  optionName :: Tagged QuickCheckTests String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-tests"
  optionHelp :: Tagged QuickCheckTests String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Number of test cases for QuickCheck to generate. Underscores accepted: e.g. 10_000_000"
  optionCLParser :: Parser QuickCheckTests
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER"

instance IsOption QuickCheckReplay where
  defaultValue :: QuickCheckReplay
defaultValue = Maybe Int -> QuickCheckReplay
QuickCheckReplay forall a. Maybe a
Nothing
  -- Reads a replay int seed
  parseValue :: String -> Maybe QuickCheckReplay
parseValue String
v = Maybe Int -> QuickCheckReplay
QuickCheckReplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => String -> Maybe a
safeRead String
v
  optionName :: Tagged QuickCheckReplay String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-replay"
  optionHelp :: Tagged QuickCheckReplay String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Random seed to use for replaying a previous test run (use same --quickcheck-max-size)"
  optionCLParser :: Parser QuickCheckReplay
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEED"

instance IsOption QuickCheckShowReplay where
  defaultValue :: QuickCheckShowReplay
defaultValue = Bool -> QuickCheckShowReplay
QuickCheckShowReplay Bool
False
  parseValue :: String -> Maybe QuickCheckShowReplay
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> QuickCheckShowReplay
QuickCheckShowReplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
safeReadBool
  optionName :: Tagged QuickCheckShowReplay String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-show-replay"
  optionHelp :: Tagged QuickCheckShowReplay String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Show a replay token for replaying tests"
  optionCLParser :: Parser QuickCheckShowReplay
optionCLParser = forall v. IsOption v => Maybe Char -> v -> Parser v
flagCLParser forall a. Maybe a
Nothing (Bool -> QuickCheckShowReplay
QuickCheckShowReplay Bool
True)

defaultMaxSize :: Int
defaultMaxSize :: Int
defaultMaxSize = Args -> Int
QC.maxSize Args
QC.stdArgs

instance IsOption QuickCheckMaxSize where
  defaultValue :: QuickCheckMaxSize
defaultValue = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultMaxSize
  parseValue :: String -> Maybe QuickCheckMaxSize
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> QuickCheckMaxSize
QuickCheckMaxSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged QuickCheckMaxSize String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-max-size"
  optionHelp :: Tagged QuickCheckMaxSize String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Size of the biggest test cases quickcheck generates"
  optionCLParser :: Parser QuickCheckMaxSize
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER"

instance IsOption QuickCheckMaxRatio where
  defaultValue :: QuickCheckMaxRatio
defaultValue = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Args -> Int
QC.maxDiscardRatio Args
QC.stdArgs
  parseValue :: String -> Maybe QuickCheckMaxRatio
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> QuickCheckMaxRatio
QuickCheckMaxRatio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged QuickCheckMaxRatio String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-max-ratio"
  optionHelp :: Tagged QuickCheckMaxRatio String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Maximum number of discared tests per successful test before giving up"
  optionCLParser :: Parser QuickCheckMaxRatio
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER"

instance IsOption QuickCheckVerbose where
  defaultValue :: QuickCheckVerbose
defaultValue = Bool -> QuickCheckVerbose
QuickCheckVerbose Bool
False
  parseValue :: String -> Maybe QuickCheckVerbose
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> QuickCheckVerbose
QuickCheckVerbose forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
safeReadBool
  optionName :: Tagged QuickCheckVerbose String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-verbose"
  optionHelp :: Tagged QuickCheckVerbose String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Show the generated test cases"
  optionCLParser :: Parser QuickCheckVerbose
optionCLParser = forall v. IsOption v => Mod FlagFields v -> v -> Parser v
mkFlagCLParser forall a. Monoid a => a
mempty (Bool -> QuickCheckVerbose
QuickCheckVerbose Bool
True)

instance IsOption QuickCheckMaxShrinks where
  defaultValue :: QuickCheckMaxShrinks
defaultValue = Int -> QuickCheckMaxShrinks
QuickCheckMaxShrinks (Args -> Int
QC.maxShrinks Args
QC.stdArgs)
  parseValue :: String -> Maybe QuickCheckMaxShrinks
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> QuickCheckMaxShrinks
QuickCheckMaxShrinks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged QuickCheckMaxShrinks String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"quickcheck-shrinks"
  optionHelp :: Tagged QuickCheckMaxShrinks String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Number of shrinks allowed before QuickCheck will fail a test"
  optionCLParser :: Parser QuickCheckMaxShrinks
optionCLParser = forall v. IsOption v => Mod OptionFields v -> Parser v
mkOptionCLParser forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER"

-- | Convert tasty options into QuickCheck options.
--
-- This is a low-level function that was originally added for tasty-hspec
-- but may be used by others.
--
-- @since 0.9.1
optionSetToArgs :: OptionSet -> IO (Int, QC.Args)
optionSetToArgs :: OptionSet -> IO (Int, Args)
optionSetToArgs OptionSet
opts = do
  Int
replaySeed <- case Maybe Int
mReplay of
    Maybe Int
Nothing -> forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom (forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
1,Int
999999))
    Just Int
seed -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
seed

  let args :: Args
args = Args
QC.stdArgs
        { chatty :: Bool
QC.chatty          = Bool
False
        , maxSuccess :: Int
QC.maxSuccess      = Int
nTests
        , maxSize :: Int
QC.maxSize         = Int
maxSize
        , replay :: Maybe (QCGen, Int)
QC.replay          = forall a. a -> Maybe a
Just (Int -> QCGen
mkQCGen Int
replaySeed, Int
0)
        , maxDiscardRatio :: Int
QC.maxDiscardRatio = Int
maxRatio
        , maxShrinks :: Int
QC.maxShrinks      = Int
maxShrinks
        }

  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
replaySeed, Args
args)

  where
    QuickCheckTests      Int
nTests     = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    QuickCheckReplay     Maybe Int
mReplay    = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    QuickCheckMaxSize    Int
maxSize    = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    QuickCheckMaxRatio   Int
maxRatio   = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    QuickCheckMaxShrinks Int
maxShrinks = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts

instance IsTest QC where
  testOptions :: Tagged QC [OptionDescription]
testOptions = forall (m :: * -> *) a. Monad m => a -> m a
return
    [ forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckTests)
    , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckReplay)
    , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckShowReplay)
    , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckMaxSize)
    , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckMaxRatio)
    , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckVerbose)
    , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy QuickCheckMaxShrinks)
    ]

  run :: OptionSet -> QC -> (Progress -> IO ()) -> IO Result
run OptionSet
opts (QC Property
prop) Progress -> IO ()
_yieldProgress = do
    (Int
replaySeed, Args
args) <- OptionSet -> IO (Int, Args)
optionSetToArgs OptionSet
opts

    let
      QuickCheckShowReplay Bool
showReplay = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      QuickCheckVerbose    Bool
verbose    = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      maxSize :: Int
maxSize = Args -> Int
QC.maxSize Args
args
      testRunner :: Args -> Property -> IO Result
testRunner = if Bool
verbose
                     then forall prop. Testable prop => Args -> prop -> IO Result
QC.verboseCheckWithResult
                     else forall prop. Testable prop => Args -> prop -> IO Result
QC.quickCheckWithResult
      replayMsg :: String
replayMsg = Int -> Int -> String
makeReplayMsg Int
replaySeed Int
maxSize

    -- Quickcheck already catches exceptions, no need to do it here.
    Result
r <- Args -> Property -> IO Result
testRunner Args
args Property
prop

    String
qcOutput <- String -> IO String
formatMessage forall a b. (a -> b) -> a -> b
$ Result -> String
QC.output Result
r
    let qcOutputNl :: String
qcOutputNl =
          if String
"\n" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
qcOutput
            then String
qcOutput
            else String
qcOutput forall a. [a] -> [a] -> [a]
++ String
"\n"
        testSuccessful :: Bool
testSuccessful = Result -> Bool
successful Result
r
        putReplayInDesc :: Bool
putReplayInDesc = (Bool -> Bool
not Bool
testSuccessful) Bool -> Bool -> Bool
|| Bool
showReplay
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      (if Bool
testSuccessful then String -> Result
testPassed else String -> Result
testFailed)
      (String
qcOutputNl forall a. [a] -> [a] -> [a]
++
        (if Bool
putReplayInDesc then String
replayMsg else String
""))

successful :: QC.Result -> Bool
successful :: Result -> Bool
successful Result
r =
  case Result
r of
    QC.Success {} -> Bool
True
    Result
_ -> Bool
False

makeReplayMsg :: Int -> Int -> String
makeReplayMsg :: Int -> Int -> String
makeReplayMsg Int
seed Int
size = let
    sizeStr :: String
sizeStr = if (Int
size forall a. Eq a => a -> a -> Bool
/= Int
defaultMaxSize)
                 then forall r. PrintfType r => String -> r
printf String
" --quickcheck-max-size=%d" Int
size
                 else String
""
  in forall r. PrintfType r => String -> r
printf String
"Use --quickcheck-replay=%d%s to reproduce." Int
seed String
sizeStr