{-# LANGUAGE CPP #-}
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Safe #-}
#endif
{-# OPTIONS_HADDOCK hide #-}
-- | QuickCheck's internal state. Internal QuickCheck module.
module Test.QuickCheck.State where

import Test.QuickCheck.Text
import Test.QuickCheck.Random
import Data.Map(Map)

--------------------------------------------------------------------------
-- State

-- | State represents QuickCheck's internal state while testing a property.
-- The state is made visible to callback functions.
data State
  = MkState
  -- static
  { State -> Terminal
terminal                  :: Terminal
    -- ^ the current terminal
  , State -> Int
maxSuccessTests           :: Int
    -- ^ maximum number of successful tests needed
  , State -> Int
maxDiscardedRatio         :: Int
    -- ^ maximum number of discarded tests per successful test
  , State -> Maybe Confidence
coverageConfidence        :: Maybe Confidence
    -- ^ how to compute the size of test cases from
    --   #tests and #discarded tests
  , State -> Int
numTotMaxShrinks          :: !Int
    -- ^ How many shrinks to try before giving up
  , State -> Maybe Int
replayStartSize           :: Maybe Int
    -- ^ Size to start at when replaying
  , State -> Int
maxTestSize               :: !Int
    -- ^ Maximum size of test

    -- dynamic
  , State -> Int
numSuccessTests           :: !Int
    -- ^ the current number of tests that have succeeded
  , State -> Int
numDiscardedTests         :: !Int
    -- ^ the current number of discarded tests
  , State -> Int
numRecentlyDiscardedTests :: !Int
    -- ^ the number of discarded tests since the last successful test
  , State -> Map [String] Int
labels                    :: !(Map [String] Int)
    -- ^ counts for each combination of labels (label/collect)
  , State -> Map String Int
classes                   :: !(Map String Int)
    -- ^ counts for each class of test case (classify/cover)
  , State -> Map String (Map String Int)
tables                    :: !(Map String (Map String Int))
    -- ^ tables collected using tabulate
  , State -> Map (Maybe String, String) Double
requiredCoverage          :: !(Map (Maybe String, String) Double)
    -- ^ coverage requirements
  , State -> Bool
expected                  :: !Bool
    -- ^ indicates the expected result of the property
  , State -> QCGen
randomSeed                :: !QCGen
    -- ^ the current random seed

    -- shrinking
  , State -> Int
numSuccessShrinks         :: !Int
    -- ^ number of successful shrinking steps so far
  , State -> Int
numTryShrinks             :: !Int
    -- ^ number of failed shrinking steps since the last successful shrink
  , State -> Int
numTotTryShrinks          :: !Int
    -- ^ total number of failed shrinking steps
  }

-- | The statistical parameters used by 'Test.QuickCheck.checkCoverage'.
data Confidence =
  Confidence {
    Confidence -> Integer
certainty :: Integer,
    -- ^ How certain 'Test.QuickCheck.checkCoverage' must be before the property
    -- fails. If the coverage requirement is met, and the certainty parameter is
    -- @n@, then you should get a false positive at most one in @n@ runs of
    -- QuickCheck. The default value is @10^9@.
    --
    -- Lower values will speed up 'Test.QuickCheck.checkCoverage' at the cost of
    -- false positives.
    --
    -- If you are using 'Test.QuickCheck.checkCoverage' as part of a test suite,
    -- you should be careful not to set @certainty@ too low. If you want, say, a
    -- 1% chance of a false positive during a project's lifetime, then
    -- certainty@ should be set to at least @100 * m * n@, where @m@ is the
    -- number of uses of 'Test.QuickCheck.cover' in the test suite, and @n@ is
    -- the number of times you expect the test suite to be run during the
    -- project's lifetime. The default value is chosen to be big enough for most
    -- projects.
    Confidence -> Double
tolerance :: Double
    -- ^ For statistical reasons, 'Test.QuickCheck.checkCoverage' will not
    -- reject coverage levels that are only slightly below the required levels.
    -- If the required level is @p@ then an actual level of @tolerance * p@
    -- will be accepted. The default value is @0.9@.
    --
    -- Lower values will speed up 'Test.QuickCheck.checkCoverage' at the cost of
    -- not detecting minor coverage violations.
    }
  deriving Int -> Confidence -> ShowS
[Confidence] -> ShowS
Confidence -> String
(Int -> Confidence -> ShowS)
-> (Confidence -> String)
-> ([Confidence] -> ShowS)
-> Show Confidence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Confidence -> ShowS
showsPrec :: Int -> Confidence -> ShowS
$cshow :: Confidence -> String
show :: Confidence -> String
$cshowList :: [Confidence] -> ShowS
showList :: [Confidence] -> ShowS
Show

-- | TestProgress, contains information that might be interesting to external
-- libraries, e.g. Tasty. From this it is possible to install your own callbacks
-- that reports e.g. progress.
data TestProgress
  = TestProgress
  { TestProgress -> Int
currentPassed        :: Int -- ^ Number of tests passed so far
  , TestProgress -> Int
currentDiscarded     :: Int -- ^ Number of discared tests so far
  , TestProgress -> Int
maxTests             :: Int -- ^ Number of tests to execute
  , TestProgress -> Int
currentShrinks       :: Int -- ^ Number of successful shrinking steps
  , TestProgress -> Int
currentFailedShrinks :: Int -- ^ Number of failed shrinking steps since last successful one
  , TestProgress -> Int
currentTotalShrinks  :: Int -- ^ Total number of failed shrinking steps
  } deriving Int -> TestProgress -> ShowS
[TestProgress] -> ShowS
TestProgress -> String
(Int -> TestProgress -> ShowS)
-> (TestProgress -> String)
-> ([TestProgress] -> ShowS)
-> Show TestProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestProgress -> ShowS
showsPrec :: Int -> TestProgress -> ShowS
$cshow :: TestProgress -> String
show :: TestProgress -> String
$cshowList :: [TestProgress] -> ShowS
showList :: [TestProgress] -> ShowS
Show

--------------------------------------------------------------------------
-- the end.