{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module:       Distribution.TestSuite.QuickCheck
-- Description:  Convert QuickCheck properties into Cabal tests
-- Copyright:    ⓒ Anselm Schüler 2022
-- License:      MIT
-- Maintainer:   Anselm Schüler <mail@anselmschueler.com>
-- Stability:    stable
-- Portability:  Portable
--
-- This module allows you to easily make Cabal tests for the @detailed-0.9@ interface. See the [docs](https://cabal.readthedocs.io/en/3.6/cabal-package.html#example-package-using-detailed-0-9-interface).
-- It sets sensible option declarations for the tests.
--
-- This module re-uses record names from "Distribution.TestSuite" and "Test.QuickCheck".
-- It is recommended that you enable the [@DisambiguateRecordFields@](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/exts/disambiguate_record_fields.html) extension in GHC and/or import the module qualified.
-- For many basic tests, you don’t need to import "Distribution.TestSuite".
--
-- To make a test, simply construct a 'PropertyTest' and call 'getPropertyTest' on it.
--
-- A simple sample test suite:
--
-- @
-- module Tests (tests) where
-- import "Distribution.TestSuite.QuickCheck"
-- import "Test.QuickCheck"
-- tests = [
--   'getPropertyTest' 'PropertyTest' {
--     'name' = /"addition-is-commutative"/,
--     'tags' = [],
--     'property' = \\a b -> a + b 'QC.===' b + a
--     }
--   ]
-- @
--
-- The tests you get as a result support several parameters:
--
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | Property name      | Valid values | Effect                                                                          |
-- +====================+==============+=================================================================================+
-- | @silent@           | booleans     | If true, all output is disabled.                                                |
-- |                    |              | Sets 'verbosity' to 'Silent'. See 'QC.chatty'.                                  |
-- |                    |              | Disabling Silent raises the verbosity to Chatty if it is not already higher.    |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @chatty@           | booleans     | If true, the default amount of output is emitted by QuickCheck.                 |
-- |                    |              | Sets 'verbosity' to 'Chatty'. See 'QC.chatty'.                                  |
-- |                    |              | Note that setting this verbosity option to false does not undo setting it to    |
-- |                    |              | true, but lowers the verbosity by one level if it is not already lower.         |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @verbose@          | booleans     | If true, prints checked values as output.                                       |
-- |                    |              | Sets 'verbosity' to 'Verbose'. See 'QC.verbose'.                                |
-- |                    |              | Note that setting this verbosity option to false does not undo setting it to    |
-- |                    |              | true, but lowers the verbosity by one level if it is not already lower.         |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @verboseShrinking@ | booleans     | If true, prints all checked and shrunk values as output.                        |
-- |                    |              | See 'QC.verboseShrinking'.                                                      |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @verbosity@        | @Silent@,    | Sets the 'verbosity' to the desired level.                                      |
-- |                    | @Chatty@,    |                                                                                 |
-- |                    | or @Verbose@ |                                                                                 |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @maxDiscardRatio@  | positive     | Maximum number of discarded tests per successful test before giving up.         |
-- |                    | integer      | See 'QC.maxDiscardRatio'.                                                       |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @noShrinking@      | booleans     | Disables shrinking of test cases.                                               |
-- |                    |              | See 'QC.noShrinking'.                                                           |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @shrinking@        | booleans     | Opposite of @noShrinking@.                                                      |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @maxShrinks@       | nonnegative  | Maximum number of shrinks before giving up or zero to disable shrinking.        |
-- |                    | integer      | See 'QC.maxShrinks'.                                                            |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @maxSuccess@       | positive     | Maximum number of successful tests before succeeding.                           |
-- |                    | integer      | See 'QC.maxSuccess'.                                                            |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @maxSize@          | positive     | Size to use for the biggest test cases.                                         |
-- |                    | integer      | See 'QC.maxSize'.                                                               |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @sizeScale@        | positive     | Scales all sizes by a number.                                                   |
-- |                    | integer      | See 'QC.mapSize'.                                                               |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
-- | @replay@           | tuple of     | Replays a previous test case. Pass a string representing a tuple of             |
-- |                    | 'QCGen' and  | the 'QC.usedSeed' and 'QC.usedSize' values of a test case. Use empty string to  |
-- |                    | nonnegative  | disable.                                                                        |
-- |                    | integer or   |                                                                                 |
-- |                    | empty        |                                                                                 |
-- +--------------------+--------------+---------------------------------------------------------------------------------+
--
-- You can set default values by using 'getPropertyTestWith'
-- You can access these values in your test by using 'getPropertyTestUsing'.
-- Do both with 'getPropertyTestWithUsing'.
module Distribution.TestSuite.QuickCheck
  ( -- * Create tests
    getPropertyTest,
    getPropertyTestWith,
    getPropertyTestUsing,
    getPropertyTestWithUsing,
    getPropertyTests,
    propertyTestGroup,

    -- * Argument data types
    PropertyTest (..),
    TestArgs (..),
    Verbosity (..),

    -- * Functions for using arguments
    argsToTestArgs,
    argsToTestArgsWith,
    testArgsToArgs,
    stdTestArgs,
  )
where

import Data.Bool (bool)
import Data.Functor ((<&>))
import qualified Distribution.TestSuite as T
import qualified Test.QuickCheck as QC
import Test.QuickCheck.Random (QCGen)
import Text.Read (readMaybe)

-- | Datatype for setting the verbosity of tests
data Verbosity
  = -- | QuickCheck prints nothing. This sets @'QC.chatty' = 'False'@.
    Silent
  | -- | Print basic statistics. This sets @'QC.chatty' = 'True'@.
    Chatty
  | -- | Print every test case. This applies 'QC.verbose'.
    Verbose
  deriving
    ( Verbosity -> Verbosity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq,
      -- | 'Silent' < 'Chatty' < 'Verbose'
      Eq Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
Ord,
      Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show,
      ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbosity]
$creadListPrec :: ReadPrec [Verbosity]
readPrec :: ReadPrec Verbosity
$creadPrec :: ReadPrec Verbosity
readList :: ReadS [Verbosity]
$creadList :: ReadS [Verbosity]
readsPrec :: Int -> ReadS Verbosity
$creadsPrec :: Int -> ReadS Verbosity
Read,
      Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
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 :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum,
      Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded
    )

-- ! [PARTIAL] This function fails when passed Silent
switchVerbosity :: Verbosity -> Bool -> Verbosity -> Verbosity
switchVerbosity :: Verbosity -> Bool -> Verbosity -> Verbosity
switchVerbosity Verbosity
v' Bool
True Verbosity
v = Verbosity
v'
switchVerbosity Verbosity
v' Bool
False Verbosity
v = forall a. Ord a => a -> a -> a
min (forall a. Enum a => a -> a
pred Verbosity
v') Verbosity
v

-- | Arguments for altering property test behaviour.
--   These can be altered in the final Cabal 'T.Test' using 'T.setOption'.
data TestArgs = TestArgs
  { -- | Verbosity for tests. See 'QC.verbose' and 'QC.chatty'.
    TestArgs -> Verbosity
verbosity :: Verbosity,
    -- TODO Consider joining verboseShrinking back into verbosity

    -- | Whether QuickCheck should print shrinks. See 'QC.verboseShrinking'.
    TestArgs -> Bool
verboseShrinking :: Bool,
    -- | Maximum discarded tests per successful test. See 'QC.maxDiscardRatio'.
    TestArgs -> Int
maxDiscardRatio :: Int,
    -- | Disable shrinking. See 'QC.noShrinking'.
    TestArgs -> Bool
noShrinking :: Bool,
    -- | Maximum number of shrink attempts. See 'QC.maxShrinks'.
    TestArgs -> Int
maxShrinks :: Int,
    -- | Maximum number of successful checks before passing. See 'QC.maxSuccess'.
    TestArgs -> Int
maxSuccess :: Int,
    -- | Maximum size of test cases. See 'QC.maxSize'.
    TestArgs -> Int
maxSize :: Int,
    -- | Scale size by an integer using 'QC.mapSize'.
    TestArgs -> Int
sizeScale :: Int,
    -- | Replay a previous test. Pass the seed and size given by 'QC.usedSeed' and 'QC.usedSize'.
    TestArgs -> Maybe (QCGen, Int)
replay :: Maybe (QCGen, Int)
  }

-- | Transform a QuickCheck 'QC.Args' value to a 'TestArgs' value, defaulting all missing properties
--
--   @'argsToTestArgs' = 'argsToTestArgsWith' 'stdTestArgs'@
argsToTestArgs :: QC.Args -> TestArgs
argsToTestArgs :: Args -> TestArgs
argsToTestArgs = TestArgs -> Args -> TestArgs
argsToTestArgsWith TestArgs
stdTestArgs

-- | Transform a QuickCheck 'QC.Args' value to a 'TestArgs' value, with fallbacks for missing properties given by the first argument.
argsToTestArgsWith :: TestArgs -> QC.Args -> TestArgs
argsToTestArgsWith :: TestArgs -> Args -> TestArgs
argsToTestArgsWith TestArgs
testArgs QC.Args {Bool
Int
Maybe (QCGen, Int)
replay :: Args -> Maybe (QCGen, Int)
maxSuccess :: Args -> Int
maxDiscardRatio :: Args -> Int
maxSize :: Args -> Int
chatty :: Args -> Bool
maxShrinks :: Args -> Int
maxShrinks :: Int
chatty :: Bool
maxSize :: Int
maxDiscardRatio :: Int
maxSuccess :: Int
replay :: Maybe (QCGen, Int)
..} =
  TestArgs
testArgs
    { verbosity :: Verbosity
verbosity = if Bool
chatty then Verbosity
Chatty else Verbosity
Silent,
      Int
maxDiscardRatio :: Int
maxDiscardRatio :: Int
maxDiscardRatio,
      Int
maxShrinks :: Int
maxShrinks :: Int
maxShrinks,
      Int
maxSuccess :: Int
maxSuccess :: Int
maxSuccess,
      Int
maxSize :: Int
maxSize :: Int
maxSize,
      Maybe (QCGen, Int)
replay :: Maybe (QCGen, Int)
replay :: Maybe (QCGen, Int)
replay
    }

-- | Recover arguments passed to 'QC.quickCheck' from a 'TestArgs'
testArgsToArgs :: TestArgs -> QC.Args
testArgsToArgs :: TestArgs -> Args
testArgsToArgs TestArgs {Bool
Int
Maybe (QCGen, Int)
Verbosity
replay :: Maybe (QCGen, Int)
sizeScale :: Int
maxSize :: Int
maxSuccess :: Int
maxShrinks :: Int
noShrinking :: Bool
maxDiscardRatio :: Int
verboseShrinking :: Bool
verbosity :: Verbosity
replay :: TestArgs -> Maybe (QCGen, Int)
sizeScale :: TestArgs -> Int
maxSize :: TestArgs -> Int
maxSuccess :: TestArgs -> Int
maxShrinks :: TestArgs -> Int
noShrinking :: TestArgs -> Bool
maxDiscardRatio :: TestArgs -> Int
verboseShrinking :: TestArgs -> Bool
verbosity :: TestArgs -> Verbosity
..} =
  QC.Args
    { Maybe (QCGen, Int)
replay :: Maybe (QCGen, Int)
replay :: Maybe (QCGen, Int)
replay,
      Int
maxSuccess :: Int
maxSuccess :: Int
maxSuccess,
      Int
maxDiscardRatio :: Int
maxDiscardRatio :: Int
maxDiscardRatio,
      Int
maxSize :: Int
maxSize :: Int
maxSize,
      chatty :: Bool
chatty = Verbosity
verbosity forall a. Ord a => a -> a -> Bool
>= Verbosity
Chatty,
      Int
maxShrinks :: Int
maxShrinks :: Int
maxShrinks
    }

-- | Default arguments for property tests
stdTestArgs :: TestArgs
stdTestArgs :: TestArgs
stdTestArgs =
  TestArgs
    { verbosity :: Verbosity
verbosity = Verbosity
Chatty,
      verboseShrinking :: Bool
verboseShrinking = Bool
False,
      maxDiscardRatio :: Int
maxDiscardRatio = Int
10,
      noShrinking :: Bool
noShrinking = Bool
False,
      maxShrinks :: Int
maxShrinks = forall a. Bounded a => a
maxBound,
      maxSuccess :: Int
maxSuccess = Int
100,
      maxSize :: Int
maxSize = Int
100,
      sizeScale :: Int
sizeScale = Int
1,
      replay :: Maybe (QCGen, Int)
replay = forall a. Maybe a
Nothing
    }

switchVIn :: Verbosity -> Bool -> TestArgs -> TestArgs
switchVIn :: Verbosity -> Bool -> TestArgs -> TestArgs
switchVIn Verbosity
v' Bool
q args :: TestArgs
args@TestArgs {Verbosity
verbosity :: Verbosity
verbosity :: TestArgs -> Verbosity
verbosity} = TestArgs
args {verbosity :: Verbosity
verbosity = Verbosity -> Bool -> Verbosity -> Verbosity
switchVerbosity Verbosity
v' Bool
q Verbosity
verbosity}

setArgStr :: String -> String -> Maybe (TestArgs -> TestArgs)
setArgStr :: String -> String -> Maybe (TestArgs -> TestArgs)
setArgStr String
"silent" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
val args :: TestArgs
args@TestArgs {Verbosity
verbosity :: Verbosity
verbosity :: TestArgs -> Verbosity
verbosity} ->
    if Bool
val
      then TestArgs
args {verbosity :: Verbosity
verbosity = Verbosity
Silent}
      else TestArgs
args {verbosity :: Verbosity
verbosity = forall a. Ord a => a -> a -> a
max Verbosity
Chatty Verbosity
verbosity}
setArgStr String
"chatty" String
str = forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Verbosity -> Bool -> TestArgs -> TestArgs
switchVIn Verbosity
Chatty
setArgStr String
"verbose" String
str = forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Verbosity -> Bool -> TestArgs -> TestArgs
switchVIn Verbosity
Verbose
setArgStr String
"verboseShrinking" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
val TestArgs
args ->
    TestArgs
args {verboseShrinking :: Bool
verboseShrinking = Bool
val}
setArgStr String
"verbosity" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Verbosity
val TestArgs
args ->
    TestArgs
args {verbosity :: Verbosity
verbosity = Verbosity
val}
setArgStr String
"maxDiscardRatio" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
val TestArgs
args ->
    TestArgs
args {maxDiscardRatio :: Int
maxDiscardRatio = Int
val}
setArgStr String
"noShrinking" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
val TestArgs
args ->
    TestArgs
args {noShrinking :: Bool
noShrinking = Bool
val}
setArgStr String
"shrinking" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
val TestArgs
args ->
    TestArgs
args {noShrinking :: Bool
noShrinking = Bool -> Bool
not Bool
val}
setArgStr String
"maxShrinks" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
val TestArgs
args ->
    TestArgs
args {maxShrinks :: Int
maxShrinks = Int
val}
setArgStr String
"maxSuccess" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
val TestArgs
args ->
    TestArgs
args {maxSuccess :: Int
maxSuccess = Int
val}
setArgStr String
"maxSize" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
val TestArgs
args ->
    TestArgs
args {maxSize :: Int
maxSize = Int
val}
setArgStr String
"sizeScale" String
str =
  forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
val TestArgs
args ->
    TestArgs
args {sizeScale :: Int
sizeScale = Int
val}
setArgStr String
"replay" String
str =
  case String
str of
    String
"" -> forall a. a -> Maybe a
Just \TestArgs
args -> TestArgs
args {replay :: Maybe (QCGen, Int)
replay = forall a. Maybe a
Nothing}
    String
_ ->
      forall a. Read a => String -> Maybe a
readMaybe String
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(QCGen, Int)
val TestArgs
args ->
        TestArgs
args {replay :: Maybe (QCGen, Int)
replay = forall a. a -> Maybe a
Just (QCGen, Int)
val}
setArgStr String
_ String
_ = forall a. Maybe a
Nothing

positiveIntType :: T.OptionType
positiveIntType :: OptionType
positiveIntType =
  T.OptionNumber
    { optionNumberIsInt :: Bool
optionNumberIsInt = Bool
True,
      optionNumberBounds :: (Maybe String, Maybe String)
optionNumberBounds = (forall a. a -> Maybe a
Just String
"1", forall a. Maybe a
Nothing)
    }

getOptionDescrs :: TestArgs -> [T.OptionDescr]
getOptionDescrs :: TestArgs -> [OptionDescr]
getOptionDescrs TestArgs {Bool
Int
Maybe (QCGen, Int)
Verbosity
replay :: Maybe (QCGen, Int)
sizeScale :: Int
maxSize :: Int
maxSuccess :: Int
maxShrinks :: Int
noShrinking :: Bool
maxDiscardRatio :: Int
verboseShrinking :: Bool
verbosity :: Verbosity
replay :: TestArgs -> Maybe (QCGen, Int)
sizeScale :: TestArgs -> Int
maxSize :: TestArgs -> Int
maxSuccess :: TestArgs -> Int
maxShrinks :: TestArgs -> Int
noShrinking :: TestArgs -> Bool
maxDiscardRatio :: TestArgs -> Int
verboseShrinking :: TestArgs -> Bool
verbosity :: TestArgs -> Verbosity
..} =
  [ T.OptionDescr
      { optionName :: String
optionName = String
"silent",
        optionDescription :: String
optionDescription = String
"Suppress QuickCheck output",
        optionType :: OptionType
optionType = OptionType
T.OptionBool,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Verbosity
verbosity forall a. Eq a => a -> a -> Bool
== Verbosity
Silent
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"chatty",
        optionDescription :: String
optionDescription = String
"Print QuickCheck output",
        optionType :: OptionType
optionType = OptionType
T.OptionBool,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Verbosity
verbosity forall a. Ord a => a -> a -> Bool
> Verbosity
Chatty
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"verbose",
        optionDescription :: String
optionDescription = String
"Print checked values",
        optionType :: OptionType
optionType = OptionType
T.OptionBool,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Verbosity
verbosity forall a. Ord a => a -> a -> Bool
> Verbosity
Verbose
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"verboseShrinking",
        optionDescription :: String
optionDescription = String
"Print all checked and shrunk values",
        optionType :: OptionType
optionType = OptionType
T.OptionBool,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Bool
verboseShrinking
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"verbosity",
        optionDescription :: String
optionDescription = String
"Verbosity level",
        optionType :: OptionType
optionType = [String] -> OptionType
T.OptionEnum [String
"Silent", String
"Chatty", String
"Verbose", String
"VerboseShrinking"],
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Verbosity
verbosity
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"maxDiscardRatio",
        optionDescription :: String
optionDescription = String
"Maximum number of discarded tests per successful test before giving up",
        optionType :: OptionType
optionType = OptionType
positiveIntType,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
maxDiscardRatio
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"noShrinking",
        optionDescription :: String
optionDescription = String
"Disable shrinking",
        optionType :: OptionType
optionType = OptionType
T.OptionBool,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Bool
noShrinking
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"shrinking",
        optionDescription :: String
optionDescription = String
"Enable shrinking",
        optionType :: OptionType
optionType = OptionType
T.OptionBool,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
noShrinking
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"maxShrinks",
        optionDescription :: String
optionDescription = String
"Maximum number of shrinks before giving up or zero to disable shrinking",
        optionType :: OptionType
optionType =
          T.OptionNumber
            { optionNumberIsInt :: Bool
optionNumberIsInt = Bool
True,
              optionNumberBounds :: (Maybe String, Maybe String)
optionNumberBounds = (forall a. a -> Maybe a
Just String
"0", forall a. Maybe a
Nothing)
            },
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
maxShrinks
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"maxSuccess",
        optionDescription :: String
optionDescription = String
"Maximum number of successful tests before succeeding",
        optionType :: OptionType
optionType = OptionType
positiveIntType,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
maxSuccess
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"maxSize",
        optionDescription :: String
optionDescription = String
"Size to use for the biggest test cases",
        optionType :: OptionType
optionType = OptionType
positiveIntType,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
maxSize
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"sizeScale",
        optionDescription :: String
optionDescription = String
"Scale all sizes by a number",
        optionType :: OptionType
optionType = OptionType
positiveIntType,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
sizeScale
      },
    T.OptionDescr
      { optionName :: String
optionName = String
"replay",
        optionDescription :: String
optionDescription = String
"Replay a previous test",
        optionType :: OptionType
optionType = Bool -> OptionType
T.OptionString Bool
False,
        optionDefault :: Maybe String
optionDefault = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show @(Maybe (QCGen, Int)) forall a. Maybe a
Nothing
      }
  ]

getModifiers :: QC.Testable a => TestArgs -> a -> QC.Property
getModifiers :: forall a. Testable a => TestArgs -> a -> Property
getModifiers TestArgs {Verbosity
verbosity :: Verbosity
verbosity :: TestArgs -> Verbosity
verbosity, Bool
noShrinking :: Bool
noShrinking :: TestArgs -> Bool
noShrinking, Bool
verboseShrinking :: Bool
verboseShrinking :: TestArgs -> Bool
verboseShrinking, Int
sizeScale :: Int
sizeScale :: TestArgs -> Int
sizeScale} =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$
    forall a b. (a, b) -> b
snd
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter
        forall a b. (a, b) -> a
fst
        [ (Verbosity
verbosity forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose, forall prop. Testable prop => prop -> Property
QC.verbose),
          (Bool
verboseShrinking, forall prop. Testable prop => prop -> Property
QC.verboseShrinking),
          (Bool
noShrinking, forall prop. Testable prop => prop -> Property
QC.noShrinking),
          (Int
sizeScale forall a. Eq a => a -> a -> Bool
/= Int
1, forall prop. Testable prop => (Int -> Int) -> prop -> Property
QC.mapSize (forall a. Num a => a -> a -> a
* Int
sizeScale))
        ]

-- | Property test declaration with metadata
data PropertyTest prop = PropertyTest
  { -- | Name of the test, for Cabal. See See Cabal’s 'T.name'.
    forall prop. PropertyTest prop -> String
name :: String,
    -- | Tags of the test, for Cabal. See Cabal’s 'T.tags'.
    forall prop. PropertyTest prop -> [String]
tags :: [String],
    -- | Property to check. This should usually be or return an instance of 'QC.Testable'.
    forall prop. PropertyTest prop -> prop
property :: prop
  }

qcTestArgs :: QC.Testable a => TestArgs -> a -> IO QC.Result
qcTestArgs :: forall a. Testable a => TestArgs -> a -> IO Result
qcTestArgs TestArgs
args a
property = forall prop. Testable prop => Args -> prop -> IO Result
QC.quickCheckWithResult (TestArgs -> Args
testArgsToArgs TestArgs
args) (forall a. Testable a => TestArgs -> a -> Property
getModifiers TestArgs
args a
property)

-- | Get a Cabal 'T.Test' with custom 'TestArgs' from a 'PropertyTest' that takes the test arguments and returns a 'QC.testable' value
getPropertyTestWithUsing ::
  QC.Testable prop =>
  -- | The arguments for the test
  TestArgs ->
  -- | A property test whose 'property' takes a 'TestArgs' argument
  PropertyTest (TestArgs -> prop) ->
  T.Test
getPropertyTestWithUsing :: forall prop.
Testable prop =>
TestArgs -> PropertyTest (TestArgs -> prop) -> Test
getPropertyTestWithUsing TestArgs
originalArgs PropertyTest {String
[String]
TestArgs -> prop
property :: TestArgs -> prop
tags :: [String]
name :: String
property :: forall prop. PropertyTest prop -> prop
tags :: forall prop. PropertyTest prop -> [String]
name :: forall prop. PropertyTest prop -> String
..} =
  let withArgs :: TestArgs -> TestInstance
withArgs TestArgs
args =
        T.TestInstance
          { run :: IO Progress
run = do
              Result
result <- forall a. Testable a => TestArgs -> a -> IO Result
qcTestArgs TestArgs
args (TestArgs -> prop
property TestArgs
args)
              let resultStr :: String
resultStr = String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Result
result
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Result -> Progress
T.Finished case Result
result of
                QC.Success {} -> Result
T.Pass
                QC.GaveUp {} ->
                  String -> Result
T.Error forall a b. (a -> b) -> a -> b
$ String
"GaveUp: QuickCheck gave up" forall a. [a] -> [a] -> [a]
++ String
resultStr
                QC.Failure {} ->
                  String -> Result
T.Fail forall a b. (a -> b) -> a -> b
$ String
"Failure: A property failed" forall a. [a] -> [a] -> [a]
++ String
resultStr
                QC.NoExpectedFailure {} ->
                  String -> Result
T.Fail forall a b. (a -> b) -> a -> b
$ String
"NoExpectedFailure: A property that should have failed did not" forall a. [a] -> [a] -> [a]
++ String
resultStr,
            String
name :: String
name :: String
name,
            [String]
tags :: [String]
tags :: [String]
tags,
            options :: [OptionDescr]
options = TestArgs -> [OptionDescr]
getOptionDescrs TestArgs
originalArgs,
            setOption :: String -> String -> Either String TestInstance
setOption = \String
opt String
str -> case String -> String -> Maybe (TestArgs -> TestArgs)
setArgStr String
opt String
str of
              Maybe (TestArgs -> TestArgs)
Nothing -> forall a b. a -> Either a b
Left String
"Parse error"
              Just TestArgs -> TestArgs
f -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestArgs -> TestInstance
withArgs forall a b. (a -> b) -> a -> b
$ TestArgs -> TestArgs
f TestArgs
args
          }
   in TestInstance -> Test
T.Test forall a b. (a -> b) -> a -> b
$ TestArgs -> TestInstance
withArgs TestArgs
originalArgs

-- | Get a Cabal 'T.Test' from a 'PropertyTest' that takes the test arguments and returns a 'QC.Testable' value
getPropertyTestUsing ::
  QC.Testable prop =>
  -- | A property test whose 'property' takes a 'TestArgs' argument
  PropertyTest (TestArgs -> prop) ->
  T.Test
getPropertyTestUsing :: forall prop.
Testable prop =>
PropertyTest (TestArgs -> prop) -> Test
getPropertyTestUsing = forall prop.
Testable prop =>
TestArgs -> PropertyTest (TestArgs -> prop) -> Test
getPropertyTestWithUsing TestArgs
stdTestArgs

discardingTestArgs :: PropertyTest prop -> PropertyTest (TestArgs -> prop)
discardingTestArgs :: forall prop. PropertyTest prop -> PropertyTest (TestArgs -> prop)
discardingTestArgs test :: PropertyTest prop
test@PropertyTest {prop
property :: prop
property :: forall prop. PropertyTest prop -> prop
property} = PropertyTest prop
test {property :: TestArgs -> prop
property = forall a b. a -> b -> a
const prop
property}

-- | Get a Cabal 'T.Test' from a 'PropertyTest' with custom 'TestArgs'
getPropertyTestWith ::
  QC.Testable prop =>
  -- | The arguments for the test
  TestArgs ->
  PropertyTest prop ->
  T.Test
getPropertyTestWith :: forall prop. Testable prop => TestArgs -> PropertyTest prop -> Test
getPropertyTestWith TestArgs
args = forall prop.
Testable prop =>
TestArgs -> PropertyTest (TestArgs -> prop) -> Test
getPropertyTestWithUsing TestArgs
args forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. PropertyTest prop -> PropertyTest (TestArgs -> prop)
discardingTestArgs

-- | Get a Cabal 'T.Test' from a 'PropertyTest'
getPropertyTest :: QC.Testable prop => PropertyTest prop -> T.Test
getPropertyTest :: forall prop. Testable prop => PropertyTest prop -> Test
getPropertyTest = forall prop.
Testable prop =>
TestArgs -> PropertyTest (TestArgs -> prop) -> Test
getPropertyTestWithUsing TestArgs
stdTestArgs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. PropertyTest prop -> PropertyTest (TestArgs -> prop)
discardingTestArgs

-- | Get a list of 'T.Test's from a list of 'PropertyTest's
getPropertyTests :: QC.Testable prop => [PropertyTest prop] -> [T.Test]
getPropertyTests :: forall prop. Testable prop => [PropertyTest prop] -> [Test]
getPropertyTests = (forall prop. Testable prop => PropertyTest prop -> Test
getPropertyTest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- | Get a named test group from a list of 'PropertyTest's. These are assumed to be able to run in parallel. See 'T.testGroup' and 'T.Group'.
propertyTestGroup :: QC.Testable prop => String -> [PropertyTest prop] -> T.Test
propertyTestGroup :: forall prop. Testable prop => String -> [PropertyTest prop] -> Test
propertyTestGroup String
name = String -> [Test] -> Test
T.testGroup String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => [PropertyTest prop] -> [Test]
getPropertyTests