-- | This module allows to use QuickCheck properties in tasty.
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, NamedFieldPuns #-}
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 qualified Test.QuickCheck.Test as QC
import qualified Test.QuickCheck.State as QC
import qualified Test.QuickCheck.Text as QC
import Test.Tasty.Runners (formatMessage, emptyProgress)
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 qualified Data.Char as Char
import Data.Typeable
import Data.List
import Text.Printf
import Text.Read (readMaybe)
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 'TestTree' 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
      replayMsg :: String
replayMsg = Int -> Int -> String
makeReplayMsg Int
replaySeed Int
maxSize

    -- Quickcheck already catches exceptions, no need to do it here.
    Result
r <- (Progress -> IO ()) -> Args -> Property -> IO Result
quickCheck Progress -> IO ()
yieldProgress
                    Args
args
                    (if Bool
verbose then forall prop. Testable prop => prop -> Property
QC.verbose Property
prop else 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
""))


-- | Like the original 'QC.quickCheck' but is reporting progress using tasty
-- callback.
--
quickCheck :: (Progress -> IO ())
           -> QC.Args
           -> QC.Property
           -> IO QC.Result
quickCheck :: (Progress -> IO ()) -> Args -> Property -> IO Result
quickCheck Progress -> IO ()
yieldProgress Args
args Property
prop = do
  -- Here we rely on the fact that QuickCheck currently prints its progress to
  -- stderr and the overall status (which we don't need) to stdout
  Terminal
tm <- (String -> IO ()) -> (String -> IO ()) -> IO Terminal
QC.newTerminal
          (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
          (\String
progressText -> Progress -> IO ()
yieldProgress Progress
emptyProgress { progressPercent :: Float
progressPercent = String -> Float
parseProgress String
progressText })
  forall a. Args -> (State -> IO a) -> IO a
QC.withState Args
args forall a b. (a -> b) -> a -> b
$ \ State
s ->
    State -> Property -> IO Result
QC.test State
s { terminal :: Terminal
QC.terminal = Terminal
tm } Property
prop
  where
    -- QuickCheck outputs something like "(15461 tests)\b\b\b\b\b\b\b\b\b\b\b\b\b"
    parseProgress :: String -> Float
    parseProgress :: String -> Float
parseProgress = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Float
0 (\Int
n -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n :: Int) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Args -> Int
QC.maxSuccess Args
args))
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
Char.isDigit
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1

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