{-# OPTIONS_HADDOCK hide #-}
-- | The main test loop.
{-# LANGUAGE CPP #-}
#ifndef NO_TYPEABLE
{-# LANGUAGE DeriveDataTypeable #-}
#endif
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Trustworthy #-}
#endif
module Test.QuickCheck.Test where

--------------------------------------------------------------------------
-- imports

import Control.Applicative
import Test.QuickCheck.Gen
import Test.QuickCheck.Property hiding ( Result( reason, theException, labels, classes, tables ), (.&.) )
import qualified Test.QuickCheck.Property as P
import Test.QuickCheck.Text
import Test.QuickCheck.State hiding (labels, classes, tables, requiredCoverage)
import qualified Test.QuickCheck.State as S
import Test.QuickCheck.Exception
import Test.QuickCheck.Random
import System.Random(split)
#if defined(MIN_VERSION_containers)
#if MIN_VERSION_containers(0,5,0)
import qualified Data.Map.Strict as Map
#else
import qualified Data.Map as Map
#endif
#else
import qualified Data.Map as Map
#endif
import qualified Data.Set as Set
import Data.Set(Set)
import Data.Map(Map)

import Data.Char
  ( isSpace
  )

import Data.List
  ( sort
  , sortBy
  , group
  , intersperse
  )

import Data.Maybe(fromMaybe, isNothing, catMaybes)
import Data.Ord(comparing)
import Text.Printf(printf)
import Control.Monad
import Data.Bits
import Data.Maybe

#ifndef NO_TYPEABLE
import Data.Typeable (Typeable)
#endif

--------------------------------------------------------------------------
-- quickCheck

-- * Running tests

-- | Args specifies arguments to the QuickCheck driver
data Args
  = Args
  { Args -> Maybe (QCGen, Int)
replay          :: Maybe (QCGen,Int)
    -- ^ Should we replay a previous test?
    -- Note: saving a seed from one version of QuickCheck and
    -- replaying it in another is not supported.
    -- If you want to store a test case permanently you should save
    -- the test case itself.
  , Args -> Int
maxSuccess      :: Int
    -- ^ Maximum number of successful tests before succeeding. Testing stops
    -- at the first failure. If all tests are passing and you want to run more tests,
    -- increase this number.
  , Args -> Int
maxDiscardRatio :: Int
    -- ^ Maximum number of discarded tests per successful test before giving up
  , Args -> Int
maxSize         :: Int
    -- ^ Size to use for the biggest test cases
  , Args -> Bool
chatty          :: Bool
    -- ^ Whether to print anything
  , Args -> Int
maxShrinks      :: Int
    -- ^ Maximum number of shrinks to do before giving up. Setting this to zero
    --   turns shrinking off.
  }
 deriving ( Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args -> ShowS
showsPrec :: Int -> Args -> ShowS
$cshow :: Args -> String
show :: Args -> String
$cshowList :: [Args] -> ShowS
showList :: [Args] -> ShowS
Show, ReadPrec [Args]
ReadPrec Args
Int -> ReadS Args
ReadS [Args]
(Int -> ReadS Args)
-> ReadS [Args] -> ReadPrec Args -> ReadPrec [Args] -> Read Args
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Args
readsPrec :: Int -> ReadS Args
$creadList :: ReadS [Args]
readList :: ReadS [Args]
$creadPrec :: ReadPrec Args
readPrec :: ReadPrec Args
$creadListPrec :: ReadPrec [Args]
readListPrec :: ReadPrec [Args]
Read
#ifndef NO_TYPEABLE
  , Typeable
#endif
  )

-- | Result represents the test result
data Result
  -- | A successful test run
  = Success
    { Result -> Int
numTests     :: Int
      -- ^ Number of tests performed
    , Result -> Int
numDiscarded :: Int
      -- ^ Number of tests skipped
    , Result -> Map [String] Int
labels       :: !(Map [String] Int)
      -- ^ The number of test cases having each combination of labels (see 'label')
    , Result -> Map String Int
classes      :: !(Map String Int)
      -- ^ The number of test cases having each class (see 'classify')
    , Result -> Map String (Map String Int)
tables       :: !(Map String (Map String Int))
      -- ^ Data collected by 'tabulate'
    , Result -> String
output       :: String
      -- ^ Printed output
    }
  -- | Given up
  | GaveUp
    { numTests     :: Int
    , numDiscarded :: Int
      -- ^ Number of tests skipped
    , labels       :: !(Map [String] Int)
    , classes      :: !(Map String Int)
    , tables       :: !(Map String (Map String Int))
    , output       :: String
    }
  -- | A failed test run
  | Failure
    { numTests        :: Int
    , numDiscarded    :: Int
      -- ^ Number of tests skipped
    , Result -> Int
numShrinks      :: Int
      -- ^ Number of successful shrinking steps performed
    , Result -> Int
numShrinkTries  :: Int
      -- ^ Number of unsuccessful shrinking steps performed
    , Result -> Int
numShrinkFinal  :: Int
      -- ^ Number of unsuccessful shrinking steps performed since last successful shrink
    , Result -> QCGen
usedSeed        :: QCGen
      -- ^ What seed was used
    , Result -> Int
usedSize        :: Int
      -- ^ What was the test size
    , Result -> String
reason          :: String
      -- ^ Why did the property fail
    , Result -> Maybe AnException
theException    :: Maybe AnException
      -- ^ The exception the property threw, if any
    , output          :: String
    , Result -> [String]
failingTestCase :: [String]
      -- ^ The test case which provoked the failure
    , Result -> [String]
failingLabels   :: [String]
      -- ^ The test case's labels (see 'label')
    , Result -> Set String
failingClasses  :: Set String
      -- ^ The test case's classes (see 'classify')
#ifndef NO_TYPEABLE
    , Result -> [Witness]
witnesses :: [Witness]
      -- ^ The existentially quantified witnesses provided by 'witness'
#endif
    }
  -- | A property that should have failed did not
  | NoExpectedFailure
    { numTests     :: Int
    , numDiscarded :: Int
      -- ^ Number of tests skipped
    , labels       :: !(Map [String] Int)
    , classes      :: !(Map String Int)
    , tables       :: !(Map String (Map String Int))
    , output       :: String
    }
 deriving ( Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> String
show :: Result -> String
$cshowList :: [Result] -> ShowS
showList :: [Result] -> ShowS
Show )

-- | Check if the test run result was a success
isSuccess :: Result -> Bool
isSuccess :: Result -> Bool
isSuccess Success{} = Bool
True
isSuccess Result
_         = Bool
False

-- | The default test arguments
stdArgs :: Args
stdArgs :: Args
stdArgs = Args
  { replay :: Maybe (QCGen, Int)
replay          = Maybe (QCGen, Int)
forall a. Maybe a
Nothing
  , maxSuccess :: Int
maxSuccess      = Int
100
  , maxDiscardRatio :: Int
maxDiscardRatio = Int
10
  , maxSize :: Int
maxSize         = Int
100
  , chatty :: Bool
chatty          = Bool
True
  , maxShrinks :: Int
maxShrinks      = Int
forall a. Bounded a => a
maxBound
  }

-- | Tests a property and prints the results to 'stdout'.
--
-- By default up to 100 tests are performed, which may not be enough
-- to find all bugs. To run more tests, use 'withMaxSuccess'.
--
-- If you want to get the counterexample as a Haskell value,
-- rather than just printing it, try the
-- <http://hackage.haskell.org/package/quickcheck-with-counterexamples quickcheck-with-counterexamples>
-- package.

quickCheck :: Testable prop => prop -> IO ()
quickCheck :: forall prop. Testable prop => prop -> IO ()
quickCheck prop
p = Args -> prop -> IO ()
forall prop. Testable prop => Args -> prop -> IO ()
quickCheckWith Args
stdArgs prop
p

-- | Tests a property, using test arguments, and prints the results to 'stdout'.
quickCheckWith :: Testable prop => Args -> prop -> IO ()
quickCheckWith :: forall prop. Testable prop => Args -> prop -> IO ()
quickCheckWith Args
args prop
p = Args -> prop -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
args prop
p IO Result -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Tests a property, produces a test result, and prints the results to 'stdout'.
quickCheckResult :: Testable prop => prop -> IO Result
quickCheckResult :: forall prop. Testable prop => prop -> IO Result
quickCheckResult prop
p = Args -> prop -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
stdArgs prop
p

-- | Tests a property, using test arguments, produces a test result, and prints the results to 'stdout'.
quickCheckWithResult :: Testable prop => Args -> prop -> IO Result
quickCheckWithResult :: forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
a prop
p =
  Args -> (State -> IO Result) -> IO Result
forall a. Args -> (State -> IO a) -> IO a
withState Args
a (\State
s -> State -> Property -> IO Result
test State
s (prop -> Property
forall prop. Testable prop => prop -> Property
property prop
p))

-- | Re-run a property with the seed and size that failed in a run of 'quickCheckResult'.
recheck :: Testable prop => Result -> prop -> IO ()
recheck :: forall prop. Testable prop => Result -> prop -> IO ()
recheck res :: Result
res@Failure{} = Args -> Property -> IO ()
forall prop. Testable prop => Args -> prop -> IO ()
quickCheckWith Args
stdArgs{ replay = Just (usedSeed res, usedSize res)} (Property -> IO ()) -> (prop -> Property) -> prop -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. prop -> Property
forall prop. Testable prop => prop -> Property
once
recheck Result
_ = String -> prop -> IO ()
forall a. HasCallStack => String -> a
error String
"Can only recheck tests that failed with a counterexample."

withState :: Args -> (State -> IO a) -> IO a
withState :: forall a. Args -> (State -> IO a) -> IO a
withState Args
a State -> IO a
test = (if Args -> Bool
chatty Args
a then (Terminal -> IO a) -> IO a
forall a. (Terminal -> IO a) -> IO a
withStdioTerminal else (Terminal -> IO a) -> IO a
forall a. (Terminal -> IO a) -> IO a
withNullTerminal) ((Terminal -> IO a) -> IO a) -> (Terminal -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Terminal
tm -> do
     QCGen
rnd <- case Args -> Maybe (QCGen, Int)
replay Args
a of
              Maybe (QCGen, Int)
Nothing      -> IO QCGen
newQCGen
              Just (QCGen
rnd,Int
_) -> QCGen -> IO QCGen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return QCGen
rnd
     State -> IO a
test MkState{ terminal :: Terminal
terminal                  = Terminal
tm
                 , maxSuccessTests :: Int
maxSuccessTests           = Args -> Int
maxSuccess Args
a
                 , coverageConfidence :: Maybe Confidence
coverageConfidence        = Maybe Confidence
forall a. Maybe a
Nothing
                 , maxDiscardedRatio :: Int
maxDiscardedRatio         = Args -> Int
maxDiscardRatio Args
a
                 , replayStartSize :: Maybe Int
replayStartSize           = (QCGen, Int) -> Int
forall a b. (a, b) -> b
snd ((QCGen, Int) -> Int) -> Maybe (QCGen, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Args -> Maybe (QCGen, Int)
replay Args
a
                 , maxTestSize :: Int
maxTestSize               = Args -> Int
maxSize Args
a
                 , numTotMaxShrinks :: Int
numTotMaxShrinks          = Args -> Int
maxShrinks Args
a
                 , numSuccessTests :: Int
numSuccessTests           = Int
0
                 , numDiscardedTests :: Int
numDiscardedTests         = Int
0
                 , numRecentlyDiscardedTests :: Int
numRecentlyDiscardedTests = Int
0
                 , labels :: Map [String] Int
S.labels                  = Map [String] Int
forall k a. Map k a
Map.empty
                 , classes :: Map String Int
S.classes                 = Map String Int
forall k a. Map k a
Map.empty
                 , tables :: Map String (Map String Int)
S.tables                  = Map String (Map String Int)
forall k a. Map k a
Map.empty
                 , requiredCoverage :: Map (Maybe String, String) Double
S.requiredCoverage        = Map (Maybe String, String) Double
forall k a. Map k a
Map.empty
                 , expected :: Bool
expected                  = Bool
True
                 , randomSeed :: QCGen
randomSeed                = QCGen
rnd
                 , numSuccessShrinks :: Int
numSuccessShrinks         = Int
0
                 , numTryShrinks :: Int
numTryShrinks             = Int
0
                 , numTotTryShrinks :: Int
numTotTryShrinks          = Int
0
                 }

computeSize :: State -> Int
computeSize :: State -> Int
computeSize MkState{replayStartSize :: State -> Maybe Int
replayStartSize = Just Int
s,numSuccessTests :: State -> Int
numSuccessTests = Int
0,numRecentlyDiscardedTests :: State -> Int
numRecentlyDiscardedTests=Int
0} = Int
s
-- NOTE: Beware that changing this means you also have to change `prop_discardCoverage` as that currently relies
-- on the sequence produced by this function.
computeSize MkState{maxSuccessTests :: State -> Int
maxSuccessTests = Int
ms, maxTestSize :: State -> Int
maxTestSize = Int
mts, maxDiscardedRatio :: State -> Int
maxDiscardedRatio = Int
md,numSuccessTests :: State -> Int
numSuccessTests=Int
n,numRecentlyDiscardedTests :: State -> Int
numRecentlyDiscardedTests=Int
d}
    -- e.g. with maxSuccess = 250, maxSize = 100, goes like this:
    -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98.
    | Int
n Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`roundTo` Int
mts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ms Bool -> Bool -> Bool
||
      Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ms Bool -> Bool -> Bool
||
      Int
ms Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int
mts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
n Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int
mts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`div` Int
dDenom) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
mts
    | Bool
otherwise =
      ((Int
n Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int
mts) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mts Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`div` (Int
ms Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int
mts) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`div` Int
dDenom) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
mts
  where
    -- The inverse of the rate at which we increase size as a function of discarded tests
    -- if the discard ratio is high we can afford this to be slow, but if the discard ratio
    -- is low we risk bowing out too early
    dDenom :: Int
dDenom
      | Int
md Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Int
ms Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
md Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`div` Int
3) Int -> (Int, Int) -> Int
forall a. Ord a => a -> (a, a) -> a
`clamp` (Int
1, Int
10)
      | Bool
otherwise = Int
1 -- Doesn't matter because there will be no discards allowed
    a
n roundTo :: a -> a -> a
`roundTo` a
m = (a
n a -> a -> a
forall {a}. Integral a => a -> a -> a
`div` a
m) a -> a -> a
forall a. Num a => a -> a -> a
* a
m

clamp :: Ord a => a -> (a, a) -> a
clamp :: forall a. Ord a => a -> (a, a) -> a
clamp a
x (a
l, a
h) = a -> a -> a
forall a. Ord a => a -> a -> a
max a
l (a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
h)

-- | Tests a property and prints the results and all test cases generated to 'stdout'.
-- This is just a convenience function that means the same as @'quickCheck' . 'verbose'@.
--
-- Note: for technical reasons, the test case is printed out /after/
-- the property is tested. To debug a property that goes into an
-- infinite loop, use 'within' to add a timeout instead.
verboseCheck :: Testable prop => prop -> IO ()
verboseCheck :: forall prop. Testable prop => prop -> IO ()
verboseCheck prop
p = Property -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck (prop -> Property
forall prop. Testable prop => prop -> Property
verbose prop
p)

-- | Tests a property, using test arguments, and prints the results and all test cases generated to 'stdout'.
-- This is just a convenience function that combines 'quickCheckWith' and 'verbose'.
--
-- Note: for technical reasons, the test case is printed out /after/
-- the property is tested. To debug a property that goes into an
-- infinite loop, use 'within' to add a timeout instead.
verboseCheckWith :: Testable prop => Args -> prop -> IO ()
verboseCheckWith :: forall prop. Testable prop => Args -> prop -> IO ()
verboseCheckWith Args
args prop
p = Args -> Property -> IO ()
forall prop. Testable prop => Args -> prop -> IO ()
quickCheckWith Args
args (prop -> Property
forall prop. Testable prop => prop -> Property
verbose prop
p)

-- | Tests a property, produces a test result, and prints the results and all test cases generated to 'stdout'.
-- This is just a convenience function that combines 'quickCheckResult' and 'verbose'.
--
-- Note: for technical reasons, the test case is printed out /after/
-- the property is tested. To debug a property that goes into an
-- infinite loop, use 'within' to add a timeout instead.
verboseCheckResult :: Testable prop => prop -> IO Result
verboseCheckResult :: forall prop. Testable prop => prop -> IO Result
verboseCheckResult prop
p = Property -> IO Result
forall prop. Testable prop => prop -> IO Result
quickCheckResult (prop -> Property
forall prop. Testable prop => prop -> Property
verbose prop
p)

-- | Tests a property, using test arguments, produces a test result, and prints the results and all test cases generated to 'stdout'.
-- This is just a convenience function that combines 'quickCheckWithResult' and 'verbose'.
--
-- Note: for technical reasons, the test case is printed out /after/
-- the property is tested. To debug a property that goes into an
-- infinite loop, use 'within' to add a timeout instead.
verboseCheckWithResult :: Testable prop => Args -> prop -> IO Result
verboseCheckWithResult :: forall prop. Testable prop => Args -> prop -> IO Result
verboseCheckWithResult Args
a prop
p = Args -> Property -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
a (prop -> Property
forall prop. Testable prop => prop -> Property
verbose prop
p)

--------------------------------------------------------------------------
-- main test loop

test :: State -> Property -> IO Result
test :: State -> Property -> IO Result
test State
st Property
prop
  | State -> Bool
finishedSuccessfully State
st         = State -> Property -> IO Result
doneTesting State
st Property
prop
  | State -> Bool
finishedInsufficientCoverage State
st = State -> Property -> IO Result
failCoverage State
st Property
prop
  | State -> Bool
tooManyDiscards State
st              = State -> Property -> IO Result
giveUp State
st Property
prop
  | Bool
otherwise                       = State -> Property -> IO Result
runATest State
st Property
prop

finishedSuccessfully :: State -> Bool
finishedSuccessfully :: State -> Bool
finishedSuccessfully State
st
  | State -> Bool
checkingCoverage State
st =
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ State -> Bool
timeToCheckCoverage State
st
          , State -> Bool
coverageKnownSufficient State
st
          , State -> Int
numSuccessTests State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= State -> Int
maxSuccessTests State
st
          ]
  | Bool
otherwise = State -> Int
numSuccessTests State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= State -> Int
maxSuccessTests State
st

finishedInsufficientCoverage :: State -> Bool
finishedInsufficientCoverage :: State -> Bool
finishedInsufficientCoverage State
st =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ State -> Bool
checkingCoverage State
st
      , State -> Bool
timeToCheckCoverage State
st
      , State -> Bool
coverageKnownInsufficient State
st
      ]

tooManyDiscards :: State -> Bool
tooManyDiscards :: State -> Bool
tooManyDiscards State
st
  | State -> Int
maxDiscardedRatio State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = State -> Int
numDiscardedTests State
st Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`div` State -> Int
maxDiscardedRatio State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (State -> Int
numSuccessTests State
st) (State -> Int
maxSuccessTests State
st)
  | Bool
otherwise = State -> Int
numDiscardedTests State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

checkingCoverage :: State -> Bool
checkingCoverage :: State -> Bool
checkingCoverage State
st = Maybe Confidence -> Bool
forall a. Maybe a -> Bool
isJust (State -> Maybe Confidence
coverageConfidence State
st)

timeToCheckCoverage :: State -> Bool
timeToCheckCoverage :: State -> Bool
timeToCheckCoverage State
st
 -- This is the time when we would normally finish testing, so lets check
 -- it now to see if we can finish testing already
 | State -> Int
numSuccessTests State
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== State -> Int
maxSuccessTests State
st Bool -> Bool -> Bool
&& State -> Int
numRecentlyDiscardedTests State
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
 -- We are on test 100 * 2^k for k > 0
 | Bool
otherwise =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ State -> Int
numSuccessTests State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        , State -> Int
numSuccessTests State
st Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        , Int -> Bool
forall {a}. (Bits a, Num a) => a -> Bool
powerOfTwo (State -> Int
numSuccessTests State
st Int -> Int -> Int
forall {a}. Integral a => a -> a -> a
`div` Int
100)
        ]
  where powerOfTwo :: a -> Bool
powerOfTwo a
n = a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0

coverageKnownSufficient :: State -> Bool
coverageKnownSufficient :: State -> Bool
coverageKnownSufficient st :: State
st@MkState{coverageConfidence :: State -> Maybe Confidence
coverageConfidence=Just Confidence
confidence} =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Confidence -> Int -> Int -> Double -> Bool
sufficientlyCovered Confidence
confidence Int
tot Int
n Double
p | (Maybe String
_, String
_, Int
tot, Int
n, Double
p) <- State -> [(Maybe String, String, Int, Int, Double)]
allCoverage State
st ]
coverageKnownSufficient State
_ = Bool
True

coverageKnownInsufficient :: State -> Bool
coverageKnownInsufficient :: State -> Bool
coverageKnownInsufficient st :: State
st@MkState{coverageConfidence :: State -> Maybe Confidence
coverageConfidence=Just Confidence
confidence} =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Maybe Integer -> Int -> Int -> Double -> Bool
insufficientlyCovered (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Confidence -> Integer
certainty Confidence
confidence)) Int
tot Int
n Double
p
     | (Maybe String
_, String
_, Int
tot, Int
n, Double
p) <- State -> [(Maybe String, String, Int, Int, Double)]
allCoverage State
st ]
coverageKnownInsufficient State
_ = Bool
False

failCoverage :: State -> Property -> IO Result
failCoverage :: State -> Property -> IO Result
failCoverage State
st Property
prop =
             -- The last test wasn't actually successful, as the coverage failed
             -- also this prevents an off-by-one error in the printing
    State -> Property -> IO Result
runATest State
st{numSuccessTests = numSuccessTests st - 1}
             (Property -> IO Result) -> Property -> IO Result
forall a b. (a -> b) -> a -> b
$ (String -> Property -> Property)
-> Property -> [String] -> Property
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Result -> Property
forall prop. Testable prop => prop -> Property
property Result
failed{P.reason = "Insufficient coverage"})
                                    ([[String]] -> [String]
paragraphs [[String]
theLabels, [String]
theTables])
    where ([String]
theLabels, [String]
theTables) = State -> ([String], [String])
labelsAndTables State
st

doneTesting :: State -> Property -> IO Result
doneTesting :: State -> Property -> IO Result
doneTesting State
st Property
_f
  | State -> Bool
expected State
st Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False = do
      Terminal -> String -> IO ()
putPart (State -> Terminal
terminal State
st)
        ( ShowS
bold (String
"*** Failed!")
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Passed "
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ State -> String
showTestCount State
st
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (expected failure)"
        )
      (Int
 -> Int
 -> Map [String] Int
 -> Map String Int
 -> Map String (Map String Int)
 -> String
 -> Result)
-> IO Result
forall {b}.
(Int
 -> Int
 -> Map [String] Int
 -> Map String Int
 -> Map String (Map String Int)
 -> String
 -> b)
-> IO b
finished Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> String
-> Result
NoExpectedFailure
  | Bool
otherwise = do
      Terminal -> String -> IO ()
putPart (State -> Terminal
terminal State
st)
        ( String
"+++ OK, passed "
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ State -> String
showTestCount State
st
        )
      (Int
 -> Int
 -> Map [String] Int
 -> Map String Int
 -> Map String (Map String Int)
 -> String
 -> Result)
-> IO Result
forall {b}.
(Int
 -> Int
 -> Map [String] Int
 -> Map String Int
 -> Map String (Map String Int)
 -> String
 -> b)
-> IO b
finished Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> String
-> Result
Success
  where
    finished :: (Int
 -> Int
 -> Map [String] Int
 -> Map String Int
 -> Map String (Map String Int)
 -> String
 -> b)
-> IO b
finished Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> String
-> b
k = do
      State -> IO ()
success State
st
      String
theOutput <- Terminal -> IO String
terminalOutput (State -> Terminal
terminal State
st)
      b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
-> Int
-> Map [String] Int
-> Map String Int
-> Map String (Map String Int)
-> String
-> b
k (State -> Int
numSuccessTests State
st) (State -> Int
numDiscardedTests State
st) (State -> Map [String] Int
S.labels State
st) (State -> Map String Int
S.classes State
st) (State -> Map String (Map String Int)
S.tables State
st) String
theOutput)

giveUp :: State -> Property -> IO Result
giveUp :: State -> Property -> IO Result
giveUp State
st Property
_f =
  do -- CALLBACK gave_up?
     Terminal -> String -> IO ()
putPart (State -> Terminal
terminal State
st)
       ( ShowS
bold (String
"*** Gave up!")
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Passed only "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ State -> String
showTestCount State
st
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" tests"
       )
     State -> IO ()
success State
st
     String
theOutput <- Terminal -> IO String
terminalOutput (State -> Terminal
terminal State
st)
     Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GaveUp{ numTests :: Int
numTests     = State -> Int
numSuccessTests State
st
                  , numDiscarded :: Int
numDiscarded = State -> Int
numDiscardedTests State
st
                  , labels :: Map [String] Int
labels       = State -> Map [String] Int
S.labels State
st
                  , classes :: Map String Int
classes      = State -> Map String Int
S.classes State
st
                  , tables :: Map String (Map String Int)
tables       = State -> Map String (Map String Int)
S.tables State
st
                  , output :: String
output       = String
theOutput
                  }

showTestCount :: State -> String
showTestCount :: State -> String
showTestCount State
st = Int -> Int -> String
formatTestCount (State -> Int
numSuccessTests State
st) (State -> Int
numDiscardedTests State
st)

formatTestCount :: Int -> Int -> String
formatTestCount :: Int -> Int -> String
formatTestCount Int
succeeded Int
discarded =
     Int -> ShowS
number Int
succeeded String
"test"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
discarded String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" discarded"
            | Int
discarded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            ]

runATest :: State -> Property -> IO Result
runATest :: State -> Property -> IO Result
runATest State
st Property
prop =
  do -- CALLBACK before_test
     Terminal -> String -> IO ()
putTemp (State -> Terminal
terminal State
st)
        ( String
"("
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ State -> String
showTestCount State
st
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        )

     let size :: Int
size = State -> Int
computeSize State
st

     MkRose Result
res [Rose Result]
ts <- IO (Rose Result) -> IO (Rose Result)
protectRose (Rose Result -> IO (Rose Result)
reduceRose (Prop -> Rose Result
unProp (Gen Prop -> QCGen -> Int -> Prop
forall a. Gen a -> QCGen -> Int -> a
unGen (Property -> Gen Prop
unProperty Property
prop) QCGen
rnd1 Int
size)))
     Result
res <- State -> Result -> IO Result
callbackPostTest State
st Result
res

     let continue :: (State -> Property -> IO Result) -> State -> Property -> IO Result
continue State -> Property -> IO Result
break State
st'
           | Result -> Bool
abort Result
res = State -> Property -> IO Result
break (State -> Property -> IO Result) -> State -> Property -> IO Result
forall a b. (a -> b) -> a -> b
$ State -> State
updateState State
st'
           | Bool
otherwise = State -> Property -> IO Result
test (State -> Property -> IO Result) -> State -> Property -> IO Result
forall a b. (a -> b) -> a -> b
$ State -> State
updateState State
st'

         updateState :: State -> State
updateState State
st0 = State -> State
addNewOptions (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ State
st0{ randomSeed = rnd2 }

         addNewOptions :: State -> State
addNewOptions State
st0 = State
st0{ maxSuccessTests   = fromMaybe (maxSuccessTests st0) (maybeNumTests res)
                                , maxDiscardedRatio = fromMaybe (maxDiscardedRatio st0) (maybeDiscardedRatio res)
                                , numTotMaxShrinks  = fromMaybe (numTotMaxShrinks st0) (maybeMaxShrinks res)
                                , maxTestSize       = fromMaybe (maxTestSize st0) (maybeMaxTestSize res)
                                , expected          = expect res
                                }

         addCoverageInfo :: State -> State
addCoverageInfo State
st0 =
           State
st0{ coverageConfidence = maybeCheckCoverage res `mplus` coverageConfidence st0
              , S.labels = Map.insertWith (+) (P.labels res) 1 (S.labels st0)
              , S.classes = Map.unionWith (+) (S.classes st0)
                                              (Map.fromList [ (s, if b then 1 else 0) | (s, b) <- P.classes res ])
              , S.tables =
                foldr (\(String
tab, String
x) -> (Map String Int -> Map String Int -> Map String Int)
-> String
-> Map String Int
-> Map String (Map String Int)
-> Map String (Map String Int)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((Int -> Int -> Int)
-> Map String Int -> Map String Int -> Map String Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)) String
tab (String -> Int -> Map String Int
forall k a. k -> a -> Map k a
Map.singleton String
x Int
1))
                  (S.tables st0) (P.tables res)
              , S.requiredCoverage =
                foldr (\(Maybe String
key, String
value, Double
p) -> (Double -> Double -> Double)
-> (Maybe String, String)
-> Double
-> Map (Maybe String, String) Double
-> Map (Maybe String, String) Double
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Maybe String
key, String
value) Double
p)
                  (S.requiredCoverage st0) (P.requiredCoverage res)
              }

         stC :: State
stC = State -> State
addCoverageInfo State
st

     case Result
res of
       MkResult{ok :: Result -> Maybe Bool
ok = Just Bool
True} -> -- successful test
         do (State -> Property -> IO Result) -> State -> Property -> IO Result
continue State -> Property -> IO Result
doneTesting
              State
stC{ numSuccessTests           = numSuccessTests st + 1
                 , numRecentlyDiscardedTests = 0
                 } Property
prop

       MkResult{ok :: Result -> Maybe Bool
ok = Maybe Bool
Nothing} -> -- discarded test
         do (State -> Property -> IO Result) -> State -> Property -> IO Result
continue State -> Property -> IO Result
giveUp
              -- Don't add coverage info from this test
              State
st{ numDiscardedTests         = numDiscardedTests st + 1
                , numRecentlyDiscardedTests = numRecentlyDiscardedTests st + 1
                } Property
prop

       MkResult{ok :: Result -> Maybe Bool
ok = Just Bool
False} -> -- failed test
         do (Int
numShrinks, Int
totFailed, Int
lastFailed, Result
res) <- State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
foundFailure (State -> State
addNewOptions State
stC) Result
res [Rose Result]
ts
            String
theOutput <- Terminal -> IO String
terminalOutput (State -> Terminal
terminal State
stC)
            if Bool -> Bool
not (Result -> Bool
expect Result
res) then
              Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Success{ labels :: Map [String] Int
labels = State -> Map [String] Int
S.labels State
stC,
                              classes :: Map String Int
classes = State -> Map String Int
S.classes State
stC,
                              tables :: Map String (Map String Int)
tables = State -> Map String (Map String Int)
S.tables State
stC,
                              numTests :: Int
numTests = State -> Int
numSuccessTests State
stCInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,
                              numDiscarded :: Int
numDiscarded = State -> Int
numDiscardedTests State
stC,
                              output :: String
output = String
theOutput }
             else do
              [String]
testCase <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO String
showCounterexample (Result -> [String]
P.testCase Result
res)
              Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Failure{ usedSeed :: QCGen
usedSeed        = State -> QCGen
randomSeed State
stC -- correct! (this will be split first)
                            , usedSize :: Int
usedSize        = Int
size
                            , numTests :: Int
numTests        = State -> Int
numSuccessTests State
stC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                            , numDiscarded :: Int
numDiscarded    = State -> Int
numDiscardedTests State
stC
                            , numShrinks :: Int
numShrinks      = Int
numShrinks
                            , numShrinkTries :: Int
numShrinkTries  = Int
totFailed
                            , numShrinkFinal :: Int
numShrinkFinal  = Int
lastFailed
                            , output :: String
output          = String
theOutput
                            , reason :: String
reason          = Result -> String
P.reason Result
res
                            , theException :: Maybe AnException
theException    = Result -> Maybe AnException
P.theException Result
res
                            , failingTestCase :: [String]
failingTestCase = [String]
testCase
                            , failingLabels :: [String]
failingLabels   = Result -> [String]
P.labels Result
res
                            , failingClasses :: Set String
failingClasses  = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList (((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst ([(String, Bool)] -> [String]) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)] -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$ Result -> [(String, Bool)]
P.classes Result
res)
#ifndef NO_TYPEABLE
                            , witnesses :: [Witness]
witnesses = Result -> [Witness]
theWitnesses Result
res
#endif
                            }
 where
  (QCGen
rnd1,QCGen
rnd2) = QCGen -> (QCGen, QCGen)
forall g. RandomGen g => g -> (g, g)
split (State -> QCGen
randomSeed State
st)

failureSummary :: State -> P.Result -> String
failureSummary :: State -> Result -> String
failureSummary State
st Result
res = (String, [String]) -> String
forall a b. (a, b) -> a
fst (State -> Result -> (String, [String])
failureSummaryAndReason State
st Result
res)

failureReason :: State -> P.Result -> [String]
failureReason :: State -> Result -> [String]
failureReason State
st Result
res = (String, [String]) -> [String]
forall a b. (a, b) -> b
snd (State -> Result -> (String, [String])
failureSummaryAndReason State
st Result
res)

failureSummaryAndReason :: State -> P.Result -> (String, [String])
failureSummaryAndReason :: State -> Result -> (String, [String])
failureSummaryAndReason State
st Result
res = (String
summary, [String]
full)
  where
    summary :: String
summary =
      String
header String -> ShowS
forall a. [a] -> [a] -> [a]
++
      Int -> ShowS
short Int
26 (ShowS
oneLine String
theReason String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ") String -> ShowS
forall a. [a] -> [a] -> [a]
++
      Bool -> String
count Bool
True String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..."

    full :: [String]
full =
      (String
header String -> ShowS
forall a. [a] -> [a] -> [a]
++
       (if String -> Bool
isOneLine String
theReason then String
theReason String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++
       Bool -> String
count Bool
False String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":")String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
      if String -> Bool
isOneLine String
theReason then [] else String -> [String]
lines String
theReason

    theReason :: String
theReason = Result -> String
P.reason Result
res

    header :: String
header =
      if Result -> Bool
expect Result
res then
        ShowS
bold String
"*** Failed! "
      else String
"+++ OK, failed as expected. "

    count :: Bool -> String
count Bool
full =
      String
"(after " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
number (State -> Int
numSuccessTests State
stInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
"test" String -> ShowS
forall a. [a] -> [a] -> [a]
++
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        Int -> String
forall a. Show a => a -> String
show (State -> Int
numSuccessShrinks State
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (State -> Int
numTryShrinks State
st) | Bool
showNumTryShrinks ] String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
" shrink" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        (if State -> Int
numSuccessShrinks State
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
showNumTryShrinks then String
"" else String
"s")
        | State -> Int
numSuccessShrinks State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Bool
showNumTryShrinks ] String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
")"
      where
        showNumTryShrinks :: Bool
showNumTryShrinks = Bool
full Bool -> Bool -> Bool
&& State -> Int
numTryShrinks State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

success :: State -> IO ()
success :: State -> IO ()
success State
st = do
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Terminal -> String -> IO ()
putLine (Terminal -> String -> IO ()) -> Terminal -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ State -> Terminal
terminal State
st) ([[String]] -> [String]
paragraphs [[String]
short, [String]
long])
  where
    ([String]
short, [String]
long) =
      case State -> ([String], [String])
labelsAndTables State
st of
        ([String
msg], [String]
long) ->
          ([String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")."], [String]
long)
        ([], [String]
long) ->
          ([String
"."], [String]
long)
        ([String]
short, [String]
long) ->
          (String
":"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
short, [String]
long)

labelsAndTables :: State -> ([String], [String])
labelsAndTables :: State -> ([String], [String])
labelsAndTables State
st = ([String]
theLabels, [String]
theTables)
  where
    theLabels :: [String]
    theLabels :: [String]
theLabels =
      [[String]] -> [String]
paragraphs ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$
        [ Int -> Maybe String -> Map String Int -> [String]
showTable (State -> Int
numSuccessTests State
st) Maybe String
forall a. Maybe a
Nothing Map String Int
m
        | Map String Int
m <- State -> Map String Int
S.classes State
stMap String Int -> [Map String Int] -> [Map String Int]
forall a. a -> [a] -> [a]
:Map Int (Map String Int) -> [Map String Int]
forall k a. Map k a -> [a]
Map.elems Map Int (Map String Int)
numberedLabels ]

    numberedLabels :: Map Int (Map String Int)
    numberedLabels :: Map Int (Map String Int)
numberedLabels =
      (Map String Int -> Map String Int -> Map String Int)
-> [(Int, Map String Int)] -> Map Int (Map String Int)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Int -> Int -> Int)
-> Map String Int -> Map String Int -> Map String Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)) ([(Int, Map String Int)] -> Map Int (Map String Int))
-> [(Int, Map String Int)] -> Map Int (Map String Int)
forall a b. (a -> b) -> a -> b
$
        [ (Int
i, String -> Int -> Map String Int
forall k a. k -> a -> Map k a
Map.singleton String
l Int
n)
        | ([String]
labels, Int
n) <- Map [String] Int -> [([String], Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (State -> Map [String] Int
S.labels State
st),
          (Int
i, String
l) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
labels ]

    theTables :: [String]
    theTables :: [String]
theTables =
      [[String]] -> [String]
paragraphs ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$
        [ Int -> Maybe String -> Map String Int -> [String]
showTable ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Map String Int -> [Int]
forall k a. Map k a -> [a]
Map.elems Map String Int
m)) (String -> Maybe String
forall a. a -> Maybe a
Just String
table) Map String Int
m
        | (String
table, Map String Int
m) <- Map String (Map String Int) -> [(String, Map String Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (State -> Map String (Map String Int)
S.tables State
st) ] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
        [[ (case Maybe String
mtable of Maybe String
Nothing -> String
"Only "; Just String
table -> String
"Table '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
table String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' had only ")
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String
forall a b. (Integral a, Integral b) => a -> b -> String
lpercent Int
n Int
tot String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> Int -> String
forall a. Integral a => Double -> a -> String
lpercentage Double
p Int
tot
         | (Maybe String
mtable, String
label, Int
tot, Int
n, Double
p) <- State -> [(Maybe String, String, Int, Int, Double)]
allCoverage State
st,
           Maybe Integer -> Int -> Int -> Double -> Bool
insufficientlyCovered ((Confidence -> Integer) -> Maybe Confidence -> Maybe Integer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Confidence -> Integer
certainty (State -> Maybe Confidence
coverageConfidence State
st)) Int
tot Int
n Double
p ]]

showTable :: Int -> Maybe String -> Map String Int -> [String]
showTable :: Int -> Maybe String -> Map String Int -> [String]
showTable Int
k Maybe String
mtable Map String Int
m =
  [String
table String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
total String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" | Just String
table <- [Maybe String
mtable]] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  (((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
forall {a}. Integral a => (String, a) -> String
format ([(String, Int)] -> [String])
-> ([(String, Int)] -> [(String, Int)])
-> [(String, Int)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   -- Descending order of occurrences
   [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a]
reverse ([(String, Int)] -> [(String, Int)])
-> ([(String, Int)] -> [(String, Int)])
-> [(String, Int)]
-> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> (String, Int) -> Ordering)
-> [(String, Int)] -> [(String, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, Int) -> Int)
-> (String, Int) -> (String, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String, Int) -> Int
forall a b. (a, b) -> b
snd) ([(String, Int)] -> [(String, Int)])
-> ([(String, Int)] -> [(String, Int)])
-> [(String, Int)]
-> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   -- If #occurences the same, sort in increasing order of key
   -- (note: works because sortBy is stable)
   [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a]
reverse ([(String, Int)] -> [(String, Int)])
-> ([(String, Int)] -> [(String, Int)])
-> [(String, Int)]
-> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> (String, Int) -> Ordering)
-> [(String, Int)] -> [(String, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, Int) -> String)
-> (String, Int) -> (String, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String, Int) -> String
forall a b. (a, b) -> a
fst) ([(String, Int)] -> [String]) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> a -> b
$ Map String Int -> [(String, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String Int
m)
  where
    format :: (String, a) -> String
format (String
key, a
v) =
      a -> Int -> String
forall a b. (Integral a, Integral b) => a -> b -> String
rpercent a
v Int
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key

    total :: String
total = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"(%d in total)" Int
k

--------------------------------------------------------------------------
-- main shrinking loop

foundFailure :: State -> P.Result -> [Rose P.Result] -> IO (Int, Int, Int, P.Result)
foundFailure :: State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
foundFailure State
st Result
res [Rose Result]
ts =
  do State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
localMin State
st{ numTryShrinks = 0 } Result
res [Rose Result]
ts

localMin :: State -> P.Result -> [Rose P.Result] -> IO (Int, Int, Int, P.Result)
-- Don't try to shrink for too long
localMin :: State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
localMin State
st Result
res [Rose Result]
ts
  | State -> Int
numSuccessShrinks State
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ State -> Int
numTotTryShrinks State
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= State -> Int
numTotMaxShrinks State
st =
    State -> Result -> IO (Int, Int, Int, Result)
localMinFound State
st Result
res
localMin State
st Result
res [Rose Result]
ts = do
  Either AnException ()
r <- IO () -> IO (Either AnException ())
forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (IO () -> IO (Either AnException ()))
-> IO () -> IO (Either AnException ())
forall a b. (a -> b) -> a -> b
$
    Terminal -> String -> IO ()
putTemp (State -> Terminal
terminal State
st) (State -> Result -> String
failureSummary State
st Result
res)
  case Either AnException ()
r of
    Left AnException
err ->
      State -> Result -> IO (Int, Int, Int, Result)
localMinFound State
st (String -> AnException -> Result
exception String
"Exception while printing status message" AnException
err) { callbacks = callbacks res }
    Right () -> do
      Either AnException [Rose Result]
r <- [Rose Result] -> IO (Either AnException [Rose Result])
forall a. a -> IO (Either AnException a)
tryEvaluate [Rose Result]
ts
      case Either AnException [Rose Result]
r of
        Left AnException
err
          | AnException -> Bool
isDiscard AnException
err -> State -> Result -> IO (Int, Int, Int, Result)
localMinFound State
st Result
res
          | Bool
otherwise ->
          State -> Result -> IO (Int, Int, Int, Result)
localMinFound State
st
            (String -> AnException -> Result
exception String
"Exception while generating shrink-list" AnException
err) { callbacks = callbacks res }
        Right [Rose Result]
ts' -> State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
localMin' State
st Result
res [Rose Result]
ts'

localMin' :: State -> P.Result -> [Rose P.Result] -> IO (Int, Int, Int, P.Result)
localMin' :: State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
localMin' State
st Result
res [] = State -> Result -> IO (Int, Int, Int, Result)
localMinFound State
st Result
res
localMin' State
st Result
res (Rose Result
t:[Rose Result]
ts) =
  do -- CALLBACK before_test
    MkRose Result
res' [Rose Result]
ts' <- IO (Rose Result) -> IO (Rose Result)
protectRose (Rose Result -> IO (Rose Result)
reduceRose Rose Result
t)
    Result
res' <- State -> Result -> IO Result
callbackPostTest State
st Result
res'
    if Result -> Maybe Bool
ok Result
res' Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
      then State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
localMin State
st{ numSuccessShrinks = numSuccessShrinks st + 1,
                        numTryShrinks     = 0 } Result
res' [Rose Result]
ts'
      else State -> Result -> [Rose Result] -> IO (Int, Int, Int, Result)
localMin State
st{ numTryShrinks    = numTryShrinks st + 1,
                        numTotTryShrinks = numTotTryShrinks st + 1 } Result
res [Rose Result]
ts

localMinFound :: State -> P.Result -> IO (Int, Int, Int, P.Result)
localMinFound :: State -> Result -> IO (Int, Int, Int, Result)
localMinFound State
st Result
res =
  do [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
msg | String
msg <- State -> Result -> [String]
failureReason State
st Result
res ]
     State -> Result -> IO ()
callbackPostFinalFailure State
st Result
res
     -- NB no need to check if callbacks threw an exception because
     -- we are about to return to the user anyway
     (Int, Int, Int, Result) -> IO (Int, Int, Int, Result)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> Int
numSuccessShrinks State
st, State -> Int
numTotTryShrinks State
st Int -> Int -> Int
forall a. Num a => a -> a -> a
- State -> Int
numTryShrinks State
st, State -> Int
numTryShrinks State
st, Result
res)

--------------------------------------------------------------------------
-- callbacks

callbackPostTest :: State -> P.Result -> IO P.Result
callbackPostTest :: State -> Result -> IO Result
callbackPostTest State
st Result
res = (AnException -> Result) -> IO Result -> IO Result
forall a. (AnException -> a) -> IO a -> IO a
protect (String -> AnException -> Result
exception String
"Exception running callback") (IO Result -> IO Result) -> IO Result -> IO Result
forall a b. (a -> b) -> a -> b
$ do
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ State -> Result -> IO ()
f State
st Result
res | PostTest CallbackKind
_ State -> Result -> IO ()
f <- Result -> [Callback]
callbacks Result
res ]
  Result -> IO Result
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
res

callbackPostFinalFailure :: State -> P.Result -> IO ()
callbackPostFinalFailure :: State -> Result -> IO ()
callbackPostFinalFailure State
st Result
res = do
  Either AnException ()
x <- IO () -> IO (Either AnException ())
forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (IO () -> IO (Either AnException ()))
-> IO () -> IO (Either AnException ())
forall a b. (a -> b) -> a -> b
$ [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ State -> Result -> IO ()
f State
st Result
res | PostFinalFailure CallbackKind
_ State -> Result -> IO ()
f <- Result -> [Callback]
callbacks Result
res ]
  case Either AnException ()
x of
    Left AnException
err -> do
      Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
"*** Exception running callback: "
      IO () -> IO (Either AnException ())
forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (IO () -> IO (Either AnException ()))
-> IO () -> IO (Either AnException ())
forall a b. (a -> b) -> a -> b
$ Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) (AnException -> String
forall a. Show a => a -> String
show AnException
err)
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Right () -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

----------------------------------------------------------------------
-- computing coverage

sufficientlyCovered :: Confidence -> Int -> Int -> Double -> Bool
sufficientlyCovered :: Confidence -> Int -> Int -> Double -> Bool
sufficientlyCovered Confidence
confidence Int
n Int
k Double
p =
  -- Accept the coverage if, with high confidence, the actual probability is
  -- at least 0.9 times the required one.
  Integer -> Integer -> Double -> Double
wilsonLow (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
err) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
tol Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p
  where
    err :: Integer
err = Confidence -> Integer
certainty Confidence
confidence
    tol :: Double
tol = Confidence -> Double
tolerance Confidence
confidence

insufficientlyCovered :: Maybe Integer -> Int -> Int -> Double -> Bool
insufficientlyCovered :: Maybe Integer -> Int -> Int -> Double -> Bool
insufficientlyCovered Maybe Integer
Nothing Int
n Int
k Double
p =
  Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
insufficientlyCovered (Just Integer
err) Int
n Int
k Double
p =
  Integer -> Integer -> Double -> Double
wilsonHigh (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
err) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p

-- https://en.wikipedia.org/wiki/Binomial_proportion_confidence_interval#Wilson_score_interval
-- Note:
-- https://www.ncss.com/wp-content/themes/ncss/pdf/Procedures/PASS/Confidence_Intervals_for_One_Proportion.pdf
-- suggests we should use a instead of a/2 for a one-sided test. Look
-- into this.
wilson :: Integer -> Integer -> Double -> Double
wilson :: Integer -> Integer -> Double -> Double
wilson Integer
k Integer
n Double
z =
  (Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
zDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
nf) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
sqrt (Double
pDouble -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
p)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
nf Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
zDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
4Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
nfDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
nf)))Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
zDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
nf)
  where
    nf :: Double
nf = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
    p :: Double
p = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n

wilsonLow :: Integer -> Integer -> Double -> Double
wilsonLow :: Integer -> Integer -> Double -> Double
wilsonLow Integer
k Integer
n Double
a = Integer -> Integer -> Double -> Double
wilson Integer
k Integer
n (Double -> Double
invnormcdf (Double
aDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2))

wilsonHigh :: Integer -> Integer -> Double -> Double
wilsonHigh :: Integer -> Integer -> Double -> Double
wilsonHigh Integer
k Integer
n Double
a = Integer -> Integer -> Double -> Double
wilson Integer
k Integer
n (Double -> Double
invnormcdf (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
aDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2))

-- Algorithm taken from
-- https://web.archive.org/web/20151110174102/http://home.online.no/~pjacklam/notes/invnorm/
-- Accurate to about one part in 10^9.
--
-- The 'erf' package uses the same algorithm, but with an extra step
-- to get a fully accurate result, which we skip because it requires
-- the 'erfc' function.
invnormcdf :: Double -> Double
invnormcdf :: Double -> Double
invnormcdf Double
p
  | Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0  = Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
  | Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1  = Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
  | Double
p Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = -Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
  | Double
p Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1 = Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
  | Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p_low =
    let
      q :: Double
q = Double -> Double
forall a. Floating a => a -> a
sqrt(-Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
log(Double
p))
    in
      (((((Double
c1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c2)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c3)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c4)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c5)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c6) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/
      ((((Double
d1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
d2)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
d3)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
d4)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1)
  | Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
p_high =
    let
      q :: Double
q = Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5
      r :: Double
r = Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
q
    in
      (((((Double
a1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
a2)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
a3)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
a4)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
a5)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
a6)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
q Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/
      (((((Double
b1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b2)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b3)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b4)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b5)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1)
  | Bool
otherwise =
    let
      q :: Double
q = Double -> Double
forall a. Floating a => a -> a
sqrt(-Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
log(Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
p))
    in
      -(((((Double
c1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c2)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c3)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c4)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c5)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c6) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/
       ((((Double
d1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
d2)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
d3)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
d4)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
qDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1)
  where
    a1 :: Double
a1 = -Double
3.969683028665376e+01
    a2 :: Double
a2 =  Double
2.209460984245205e+02
    a3 :: Double
a3 = -Double
2.759285104469687e+02
    a4 :: Double
a4 =  Double
1.383577518672690e+02
    a5 :: Double
a5 = -Double
3.066479806614716e+01
    a6 :: Double
a6 =  Double
2.506628277459239e+00

    b1 :: Double
b1 = -Double
5.447609879822406e+01
    b2 :: Double
b2 =  Double
1.615858368580409e+02
    b3 :: Double
b3 = -Double
1.556989798598866e+02
    b4 :: Double
b4 =  Double
6.680131188771972e+01
    b5 :: Double
b5 = -Double
1.328068155288572e+01

    c1 :: Double
c1 = -Double
7.784894002430293e-03
    c2 :: Double
c2 = -Double
3.223964580411365e-01
    c3 :: Double
c3 = -Double
2.400758277161838e+00
    c4 :: Double
c4 = -Double
2.549732539343734e+00
    c5 :: Double
c5 =  Double
4.374664141464968e+00
    c6 :: Double
c6 =  Double
2.938163982698783e+00

    d1 :: Double
d1 =  Double
7.784695709041462e-03
    d2 :: Double
d2 =  Double
3.224671290700398e-01
    d3 :: Double
d3 =  Double
2.445134137142996e+00
    d4 :: Double
d4 =  Double
3.754408661907416e+00

    p_low :: Double
p_low  = Double
0.02425
    p_high :: Double
p_high = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p_low


allCoverage :: State -> [(Maybe String, String, Int, Int, Double)]
allCoverage :: State -> [(Maybe String, String, Int, Int, Double)]
allCoverage State
st =
  [ (Maybe String
key, String
value, Int
tot, Int
n, Double
p)
  | ((Maybe String
key, String
value), Double
p) <- Map (Maybe String, String) Double
-> [((Maybe String, String), Double)]
forall k a. Map k a -> [(k, a)]
Map.toList (State -> Map (Maybe String, String) Double
S.requiredCoverage State
st),
    let tot :: Int
tot =
          case Maybe String
key of
            Just String
key -> Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 String
key Map String Int
totals
            Maybe String
Nothing -> State -> Int
numSuccessTests State
st,
    let n :: Int
n = Int -> String -> Map String Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 String
value (Map String Int
-> Maybe String
-> Map (Maybe String) (Map String Int)
-> Map String Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map String Int
forall k a. Map k a
Map.empty Maybe String
key Map (Maybe String) (Map String Int)
combinedCounts) ]
  where
    combinedCounts :: Map (Maybe String) (Map String Int)
    combinedCounts :: Map (Maybe String) (Map String Int)
combinedCounts =
      Maybe String
-> Map String Int
-> Map (Maybe String) (Map String Int)
-> Map (Maybe String) (Map String Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Maybe String
forall a. Maybe a
Nothing (State -> Map String Int
S.classes State
st)
        ((String -> Maybe String)
-> Map String (Map String Int)
-> Map (Maybe String) (Map String Int)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys String -> Maybe String
forall a. a -> Maybe a
Just (State -> Map String (Map String Int)
S.tables State
st))

    totals :: Map String Int
    totals :: Map String Int
totals = (Map String Int -> Int)
-> Map String (Map String Int) -> Map String Int
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> (Map String Int -> [Int]) -> Map String Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String Int -> [Int]
forall k a. Map k a -> [a]
Map.elems) (State -> Map String (Map String Int)
S.tables State
st)

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