-- | Test driver
--
-- Intended for qualified import.
--
-- > import Test.Falsify.Internal.Driver (Success, Failure, falsify)
-- > import qualified Test.Falsify.Internal.Driver as Driver
module Test.Falsify.Internal.Driver (
    -- * Options
    Options(..)
    -- * Results
  , Success(..)
  , Failure(..)
  , TotalDiscarded(..)
    -- * Test driver
  , falsify
    -- * Process results
  , Verbose(..)
  , ExpectFailure(..)
  , RenderedTestResult(..)
  , renderTestResult
  ) where

import Prelude hiding (log)

import Data.Bifunctor
import Data.Default
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Set (Set)
import GHC.Exception
import System.Random.SplitMix
import Text.Printf

import qualified Data.List.NonEmpty as NE
import qualified Data.Map           as Map
import qualified Data.Set           as Set

import Test.Falsify.Internal.Driver.ReplaySeed
import Test.Falsify.Internal.Generator
import Test.Falsify.Internal.Generator.Shrinking
import Test.Falsify.Internal.Property
import Test.Falsify.Internal.SampleTree (SampleTree)

import qualified Test.Falsify.Internal.SampleTree as SampleTree

{-------------------------------------------------------------------------------
  Options
-------------------------------------------------------------------------------}

-- | Options for running a test
data Options = Options {
      -- | Number of test cases to generate
      Options -> Word
tests :: Word

      -- | Number of shrinks allowed before failing a test
    , Options -> Maybe Word
maxShrinks :: Maybe Word

      -- | Random seed to use for replaying a previous test run
    , Options -> Maybe ReplaySeed
replay :: Maybe ReplaySeed

      -- | Maximum number of discarded test per successful test
    , Options -> Word
maxRatio :: Word
    }

instance Default Options where
  def :: Options
def = Options {
        tests :: Word
tests      = Word
100
      , maxShrinks :: Maybe Word
maxShrinks = forall a. Maybe a
Nothing
      , replay :: Maybe ReplaySeed
replay     = forall a. Maybe a
Nothing
      , maxRatio :: Word
maxRatio   = Word
100
      }

{-------------------------------------------------------------------------------
  Driver
-------------------------------------------------------------------------------}

data Success a = Success {
      forall a. Success a -> a
successResult :: a
    , forall a. Success a -> ReplaySeed
successSeed   :: ReplaySeed
    , forall a. Success a -> TestRun
successRun    :: TestRun
    }
  deriving (Int -> Success a -> ShowS
forall a. Show a => Int -> Success a -> ShowS
forall a. Show a => [Success a] -> ShowS
forall a. Show a => Success a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Success a] -> ShowS
$cshowList :: forall a. Show a => [Success a] -> ShowS
show :: Success a -> String
$cshow :: forall a. Show a => Success a -> String
showsPrec :: Int -> Success a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Success a -> ShowS
Show)

data Failure e = Failure {
      forall e. Failure e -> ReplaySeed
failureSeed :: ReplaySeed
    , forall e. Failure e -> ShrinkExplanation (e, TestRun) TestRun
failureRun  :: ShrinkExplanation (e, TestRun) TestRun
    }
  deriving (Int -> Failure e -> ShowS
forall e. Show e => Int -> Failure e -> ShowS
forall e. Show e => [Failure e] -> ShowS
forall e. Show e => Failure e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Failure e] -> ShowS
$cshowList :: forall e. Show e => [Failure e] -> ShowS
show :: Failure e -> String
$cshow :: forall e. Show e => Failure e -> String
showsPrec :: Int -> Failure e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Failure e -> ShowS
Show)

newtype TotalDiscarded = TotalDiscarded Word

-- | Run a test: attempt to falsify the given property
--
-- We return
--
-- * initial replay seed (each test also records its own seed)
-- * successful tests
-- * how many tests we discarded
-- * the failed test (if any).
falsify :: forall e a.
     Options
  -> Property' e a
  -> IO (ReplaySeed, [Success a], TotalDiscarded, Maybe (Failure e))
falsify :: forall e a.
Options
-> Property' e a
-> IO (ReplaySeed, [Success a], TotalDiscarded, Maybe (Failure e))
falsify Options
opts Property' e a
prop = do
    DriverState a
acc <- forall a. Options -> IO (DriverState a)
initDriverState Options
opts
    ([Success a]
successes, Word
discarded, Maybe (Failure e)
mFailure) <- DriverState a -> IO ([Success a], Word, Maybe (Failure e))
go DriverState a
acc
    forall (m :: * -> *) a. Monad m => a -> m a
return (
        SMGen -> ReplaySeed
splitmixReplaySeed (forall a. DriverState a -> SMGen
prng DriverState a
acc)
      , [Success a]
successes
      , Word -> TotalDiscarded
TotalDiscarded Word
discarded
      , Maybe (Failure e)
mFailure
      )
  where
    go :: DriverState a -> IO ([Success a], Word, Maybe (Failure e))
    go :: DriverState a -> IO ([Success a], Word, Maybe (Failure e))
go DriverState a
acc | forall a. DriverState a -> Word
todo DriverState a
acc forall a. Eq a => a -> a -> Bool
== Word
0 = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. DriverState a -> [Success a]
successes DriverState a
acc, forall a. DriverState a -> Word
discardedTotal DriverState a
acc, forall a. Maybe a
Nothing)
    go DriverState a
acc = do
        let now, later :: SMGen
            (SMGen
now, SMGen
later) = SMGen -> (SMGen, SMGen)
splitSMGen (forall a. DriverState a -> SMGen
prng DriverState a
acc)

            st :: SampleTree
            st :: SampleTree
st = SMGen -> SampleTree
SampleTree.fromPRNG SMGen
now

            result :: TestResult e a
            run    :: TestRun
            shrunk :: [SampleTree]
            ((TestResult e a
result, TestRun
run), [SampleTree]
shrunk) = forall a. Gen a -> SampleTree -> (a, [SampleTree])
runGen (forall e a. Property' e a -> Gen (TestResult e a, TestRun)
runProperty Property' e a
prop) SampleTree
st

        case TestResult e a
result of
          -- Test passed
          TestPassed a
x -> do
            let success :: Success a
                success :: Success a
success = Success {
                    successResult :: a
successResult = a
x
                  , successSeed :: ReplaySeed
successSeed   = SMGen -> ReplaySeed
splitmixReplaySeed SMGen
now
                  , successRun :: TestRun
successRun    = TestRun
run
                  }
            if TestRun -> Bool
runDeterministic TestRun
run then
              case (forall a. DriverState a -> [Success a]
successes DriverState a
acc, forall a. DriverState a -> Word
discardedTotal DriverState a
acc) of
                ([], Word
0)    -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Success a
success], Word
0, forall a. Maybe a
Nothing)
                ([Success a], Word)
_otherwise -> forall a. HasCallStack => String -> a
error String
"falsify.go: impossible"
            else
              DriverState a -> IO ([Success a], Word, Maybe (Failure e))
go forall a b. (a -> b) -> a -> b
$ forall a. SMGen -> Success a -> DriverState a -> DriverState a
withSuccess SMGen
later Success a
success DriverState a
acc

          -- Test failed
          --
          -- We ignore the failure message here, because this is the failure
          -- message before shrinking, which we are typically not interested in.
          TestFailed e
e -> do
            let explanation :: ShrinkExplanation (e, TestRun) TestRun
                explanation :: ShrinkExplanation (e, TestRun) TestRun
explanation =
                    forall p n.
Maybe Word -> ShrinkExplanation p n -> ShrinkExplanation p n
limitShrinkSteps (Options -> Maybe Word
maxShrinks Options
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
                      forall a p n.
(a -> IsValidShrink p n)
-> Gen a -> (p, [SampleTree]) -> ShrinkExplanation p n
shrinkFrom
                        forall e a.
(TestResult e a, TestRun)
-> IsValidShrink (e, TestRun) (Maybe a, TestRun)
resultIsValidShrink
                        (forall e a. Property' e a -> Gen (TestResult e a, TestRun)
runProperty Property' e a
prop)
                        ((e
e, TestRun
run), [SampleTree]
shrunk)

                -- We have to be careful here: if the user specifies a seed, we
                -- will first /split/ it to run the test (call to splitSMGen,
                -- above). This means that the seed we should provide for the
                -- test is the seed /before/ splitting.
                failure :: Failure e
                failure :: Failure e
failure = Failure {
                      failureSeed :: ReplaySeed
failureSeed = SMGen -> ReplaySeed
splitmixReplaySeed (forall a. DriverState a -> SMGen
prng DriverState a
acc)
                    , failureRun :: ShrinkExplanation (e, TestRun) TestRun
failureRun  = ShrinkExplanation (e, TestRun) TestRun
explanation
                    }

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. DriverState a -> [Success a]
successes DriverState a
acc, forall a. DriverState a -> Word
discardedTotal DriverState a
acc, forall a. a -> Maybe a
Just Failure e
failure)

          -- Test discarded, but reached maximum already
          TestResult e a
TestDiscarded | forall a. DriverState a -> Word
discardedForTest DriverState a
acc forall a. Eq a => a -> a -> Bool
== Options -> Word
maxRatio Options
opts ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. DriverState a -> [Success a]
successes DriverState a
acc, forall a. DriverState a -> Word
discardedTotal DriverState a
acc, forall a. Maybe a
Nothing)

          -- Test discarded; continue.
          TestResult e a
TestDiscarded ->
            DriverState a -> IO ([Success a], Word, Maybe (Failure e))
go forall a b. (a -> b) -> a -> b
$ forall a. SMGen -> DriverState a -> DriverState a
withDiscard SMGen
later DriverState a
acc

{-------------------------------------------------------------------------------
  Internal: driver state
-------------------------------------------------------------------------------}

data DriverState a = DriverState {
      -- | State of the PRNG after the previously executed test
      forall a. DriverState a -> SMGen
prng :: SMGen

      -- | Accumulated successful tests
    , forall a. DriverState a -> [Success a]
successes :: [Success a]

      -- | Number of tests still to execute
    , forall a. DriverState a -> Word
todo :: Word

      -- | Number of tests we discarded so far (for this test)
    , forall a. DriverState a -> Word
discardedForTest :: Word

      -- | Number of tests we discarded (in total)
    , forall a. DriverState a -> Word
discardedTotal :: Word
    }
  deriving (Int -> DriverState a -> ShowS
forall a. Show a => Int -> DriverState a -> ShowS
forall a. Show a => [DriverState a] -> ShowS
forall a. Show a => DriverState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DriverState a] -> ShowS
$cshowList :: forall a. Show a => [DriverState a] -> ShowS
show :: DriverState a -> String
$cshow :: forall a. Show a => DriverState a -> String
showsPrec :: Int -> DriverState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DriverState a -> ShowS
Show)

initDriverState :: Options -> IO (DriverState a)
initDriverState :: forall a. Options -> IO (DriverState a)
initDriverState Options
opts = do
    SMGen
prng <- case Options -> Maybe ReplaySeed
replay Options
opts of
              Just (ReplaySplitmix Word64
seed Word64
gamma) ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> SMGen
seedSMGen Word64
seed Word64
gamma
              Maybe ReplaySeed
Nothing ->
                IO SMGen
initSMGen
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DriverState {
        SMGen
prng :: SMGen
prng :: SMGen
prng
      , successes :: [Success a]
successes        = []
      , todo :: Word
todo             = Options -> Word
tests Options
opts
      , discardedForTest :: Word
discardedForTest = Word
0
      , discardedTotal :: Word
discardedTotal   = Word
0
      }

withSuccess :: SMGen -> Success a -> DriverState a -> DriverState a
withSuccess :: forall a. SMGen -> Success a -> DriverState a -> DriverState a
withSuccess SMGen
next Success a
success DriverState a
acc = DriverState {
      prng :: SMGen
prng             = SMGen
next
    , successes :: [Success a]
successes        = Success a
success forall a. a -> [a] -> [a]
: forall a. DriverState a -> [Success a]
successes DriverState a
acc
    , todo :: Word
todo             = forall a. Enum a => a -> a
pred (forall a. DriverState a -> Word
todo DriverState a
acc)
    , discardedForTest :: Word
discardedForTest = Word
0 -- reset for the next test
    , discardedTotal :: Word
discardedTotal   = forall a. DriverState a -> Word
discardedTotal DriverState a
acc
    }

withDiscard :: SMGen -> DriverState a -> DriverState a
withDiscard :: forall a. SMGen -> DriverState a -> DriverState a
withDiscard SMGen
next DriverState a
acc = DriverState {
      prng :: SMGen
prng             = SMGen
next
    , successes :: [Success a]
successes        = forall a. DriverState a -> [Success a]
successes DriverState a
acc
    , todo :: Word
todo             = forall a. DriverState a -> Word
todo DriverState a
acc
    , discardedForTest :: Word
discardedForTest = forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a. DriverState a -> Word
discardedForTest DriverState a
acc
    , discardedTotal :: Word
discardedTotal   = forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a. DriverState a -> Word
discardedTotal DriverState a
acc
    }

{-------------------------------------------------------------------------------
  Process results
-------------------------------------------------------------------------------}

-- | Verbose output
--
-- Note that if a test fails (and we were not expecting failure) we show the
-- logs independent of verbosity.
data Verbose = Verbose | NotVerbose

-- | Do we expect the property to fail?
--
-- If 'ExpectFailure', the test will fail if the property does /not/ fail.
-- Note that if we expect failure for a property, then we can stop at the first
-- failed test; the number of tests to run for the property becomes a maximum
-- rather than a goal.
data ExpectFailure = ExpectFailure | DontExpectFailure

-- | Test result as it should be shown to the user
data RenderedTestResult = RenderedTestResult {
      RenderedTestResult -> Bool
testPassed :: Bool
    , RenderedTestResult -> String
testOutput :: String
    }

renderTestResult ::
     Verbose
  -> ExpectFailure
  -> (ReplaySeed, [Success ()], TotalDiscarded, Maybe (Failure String))
  -> RenderedTestResult
renderTestResult :: Verbose
-> ExpectFailure
-> (ReplaySeed, [Success ()], TotalDiscarded,
    Maybe (Failure String))
-> RenderedTestResult
renderTestResult
      Verbose
verbose
      ExpectFailure
expectFailure
      (ReplaySeed
initSeed, [Success ()]
successes, TotalDiscarded Word
discarded, Maybe (Failure String)
mFailure) =
    case (Verbose
verbose, ExpectFailure
expectFailure, Maybe (Failure String)
mFailure) of

      --
      -- All tests discarded
      --
      -- TODO: Verbose mode here does nothing currently (we get no logs for
      -- discarded tests).
      --

      (Verbose
_, ExpectFailure
DontExpectFailure, Maybe (Failure String)
Nothing) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Success ()]
successes -> RenderedTestResult {
            testPassed :: Bool
testPassed = Bool
False
          , testOutput :: String
testOutput = [String] -> String
unlines [
                forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                    String
"All tests discarded"
                  , String
countDiscarded
                  ]
              ]
          }

      --
      -- Test succeeded
      --
      -- This may still be a failure, if we were expecting the test not to
      -- succeed.
      --

      (Verbose
NotVerbose, ExpectFailure
DontExpectFailure, Maybe (Failure String)
Nothing) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
True
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                     String
countSuccess
                   , String
countDiscarded
                   ]
               , String
showLabels
               ]
           }

      (Verbose
Verbose, ExpectFailure
DontExpectFailure, Maybe (Failure String)
Nothing) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
True
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                     String
countSuccess
                   , String
countDiscarded
                   ]
               , String
""
               , String
"Logs for each test run below."
               , String
""
               , [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int, Success ()) -> String
renderSuccess (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Success ()]
successes)
               ]
           }

      (Verbose
NotVerbose, ExpectFailure
ExpectFailure, Maybe (Failure String)
Nothing) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
False
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 String
"Expected failure, but " forall a. [a] -> [a] -> [a]
++ String
countAll forall a. [a] -> [a] -> [a]
++ String
" passed"
               , ReplaySeed -> String
showSeed ReplaySeed
initSeed
               ]
           }

      (Verbose
Verbose, ExpectFailure
ExpectFailure, Maybe (Failure String)
Nothing) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
False
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 String
"Expected failure, but " forall a. [a] -> [a] -> [a]
++ String
countAll forall a. [a] -> [a] -> [a]
++ String
" passed"
               , String
""
               , String
"Logs for each test run below."
               , String
""
               , forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int, Success ()) -> String
renderSuccess (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Success ()]
successes)
               , ReplaySeed -> String
showSeed ReplaySeed
initSeed
               ]
           }

      --
      -- Test failed
      --
      -- This might still mean the test passed, if we /expected/ failure.
      --
      -- If the test failed and we were not expecting failure, we show the
      -- logs independent of verbosity.
      --

      (Verbose
NotVerbose, ExpectFailure
ExpectFailure, Just Failure String
e) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
True
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                     String
"expected failure after "
                   , NonEmpty (String, TestRun) -> String
countHistory NonEmpty (String, TestRun)
history
                   , String
countDiscarded
                   ]
               , forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.last NonEmpty (String, TestRun)
history
               ]
           }
         where
           history :: NonEmpty (String, TestRun)
history = forall p n. ShrinkExplanation p n -> NonEmpty p
shrinkHistory (forall e. Failure e -> ShrinkExplanation (e, TestRun) TestRun
failureRun Failure String
e)

      (Verbose
Verbose, ExpectFailure
ExpectFailure, Just Failure String
e) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
True
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                     String
"expected failure after "
                   , NonEmpty (String, TestRun) -> String
countHistory NonEmpty (String, TestRun)
history
                   , String
countDiscarded
                   ]
               , forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.last NonEmpty (String, TestRun)
history
               , String
"Logs for failed test run:"
               , Log -> String
renderLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> Log
runLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.last NonEmpty (String, TestRun)
history
               ]
           }
         where
           history :: NonEmpty (String, TestRun)
history = forall p n. ShrinkExplanation p n -> NonEmpty p
shrinkHistory (forall e. Failure e -> ShrinkExplanation (e, TestRun) TestRun
failureRun Failure String
e)

      (Verbose
NotVerbose, ExpectFailure
DontExpectFailure, Just Failure String
e) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
False
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 String
"failed after " forall a. [a] -> [a] -> [a]
++ NonEmpty (String, TestRun) -> String
countHistory NonEmpty (String, TestRun)
history
               , forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.last NonEmpty (String, TestRun)
history
               , String
"Logs for failed test run:"
               , Log -> String
renderLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> Log
runLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.last NonEmpty (String, TestRun)
history
               , ReplaySeed -> String
showSeed forall a b. (a -> b) -> a -> b
$ forall e. Failure e -> ReplaySeed
failureSeed Failure String
e
               ]
           }
         where
           history :: NonEmpty (String, TestRun)
history = forall p n. ShrinkExplanation p n -> NonEmpty p
shrinkHistory (forall e. Failure e -> ShrinkExplanation (e, TestRun) TestRun
failureRun Failure String
e)

      (Verbose
Verbose, ExpectFailure
DontExpectFailure, Just Failure String
e) -> RenderedTestResult {
             testPassed :: Bool
testPassed = Bool
False
           , testOutput :: String
testOutput = [String] -> String
unlines [
                 String
"failed after " forall a. [a] -> [a] -> [a]
++ NonEmpty (String, TestRun) -> String
countHistory NonEmpty (String, TestRun)
history
               , forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.last NonEmpty (String, TestRun)
history
               , String
""
               , String
"Logs for complete shrink history:"
               , String
""
               , forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [
                     forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [
                         String
"Step " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Word
step :: Word)
                       , Log -> String
renderLog (TestRun -> Log
runLog TestRun
run)
                       ]
                   | (Word
step, (String
_result, TestRun
run)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Word
1..] (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (String, TestRun)
history)
                   ]
               , ReplaySeed -> String
showSeed forall a b. (a -> b) -> a -> b
$ forall e. Failure e -> ReplaySeed
failureSeed Failure String
e
               ]
           }
         where
           history :: NonEmpty (String, TestRun)
history = forall p n. ShrinkExplanation p n -> NonEmpty p
shrinkHistory (forall e. Failure e -> ShrinkExplanation (e, TestRun) TestRun
failureRun Failure String
e)
  where
    countSuccess, countDiscarded, countAll :: String
    countSuccess :: String
countSuccess
      | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Success ()]
successes forall a. Eq a => a -> a -> Bool
== Int
1 = String
"1 successful test"
      | Bool
otherwise             = forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Success ()]
successes) forall a. [a] -> [a] -> [a]
++ String
" successful tests"
    countDiscarded :: String
countDiscarded
      | Word
discarded forall a. Eq a => a -> a -> Bool
== Word
0        = String
""
      | Bool
otherwise             = String
" (discarded " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
discarded forall a. [a] -> [a] -> [a]
++ String
")"
    countAll :: String
countAll
      | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Success ()]
successes forall a. Eq a => a -> a -> Bool
== Int
1 = String
"the test"
      | Bool
otherwise             = String
"all " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Success ()]
successes) forall a. [a] -> [a] -> [a]
++ String
" tests"

    -- The history includes the original value, so the number of shrink steps
    -- is the length of the history minus 1.
    countHistory :: NonEmpty (String, TestRun) -> [Char]
    countHistory :: NonEmpty (String, TestRun) -> String
countHistory NonEmpty (String, TestRun)
history = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
          if | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Success ()]
successes forall a. Eq a => a -> a -> Bool
== Int
0 -> String
""
             | Bool
otherwise             -> String
countSuccess forall a. [a] -> [a] -> [a]
++ String
" and "
        , if | forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (String, TestRun)
history   forall a. Eq a => a -> a -> Bool
== Int
2 -> String
"1 shrink"
             | Bool
otherwise             -> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (String, TestRun)
history forall a. Num a => a -> a -> a
- Int
1) forall a. [a] -> [a] -> [a]
++ String
" shrinks"
        ]

    showSeed :: ReplaySeed -> String
    showSeed :: ReplaySeed -> String
showSeed ReplaySeed
seed = String
"Use --falsify-replay=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ReplaySeed
seed forall a. [a] -> [a] -> [a]
++ String
" to replay."

    showLabels :: String
    showLabels :: String
showLabels = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [
          forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ (String
"\nLabel " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
l forall a. [a] -> [a] -> [a]
++ String
":") forall a. a -> [a] -> [a]
: [
              Int -> String
asPct Int
n forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
v
            | String
v <- forall a. Set a -> [a]
Set.toList (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty String
l Map String (Set String)
allValues)
            , let n :: Int
n = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0         String
v
                    forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall k a. Map k a
Map.empty String
l
                    forall a b. (a -> b) -> a -> b
$ Map String (Map String Int)
perTest
            ]
        | String
l <- forall a. Set a -> [a]
Set.toList Set String
allLabels
        ]
      where
        -- Absolute number of tests as a percentage of total successes
        asPct :: Int -> String
        asPct :: Int -> String
asPct Int
n =
           forall r. PrintfType r => String -> r
printf String
"  %8.4f%%" Double
pct
          where
            pct :: Double
            pct :: Double
pct = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Success ()]
successes) forall a. Num a => a -> a -> a
* Double
100

        -- All labels across all tests
        allLabels :: Set String
        allLabels :: Set String
allLabels = forall k a. Map k a -> Set k
Map.keysSet Map String (Set String)
allValues

        -- For each label, all values reported across all tests
        allValues :: Map String (Set String)
        allValues :: Map String (Set String)
allValues =
            forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a b. (a -> b) -> a -> b
$
              forall a b. (a -> b) -> [a] -> [b]
map (TestRun -> Map String (Set String)
runLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Success a -> TestRun
successRun) [Success ()]
successes

        -- For each label and each value, the corresponding number of tests
        perTest :: Map String (Map String Int)
        perTest :: Map String (Map String Int)
perTest =
            forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
                (String
l, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
                    (String
v, forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Success () -> Bool
labelHasValue String
l String
v) [Success ()]
successes)
                  | String
v <- forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$
                             forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty String
l Map String (Set String)
allValues
                  ])
              | String
l <- forall a. Set a -> [a]
Set.toList Set String
allLabels
              ]

        -- Check if in particular test run label @l@ has value @v@
        labelHasValue :: String -> String -> Success () -> Bool
        labelHasValue :: String -> String -> Success () -> Bool
labelHasValue String
l String
v =
              forall a. Ord a => a -> Set a -> Bool
Set.member String
v
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty String
l
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> Map String (Set String)
runLabels
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Success a -> TestRun
successRun

renderSuccess :: (Int, Success ()) -> String
renderSuccess :: (Int, Success ()) -> String
renderSuccess (Int
ix, Success{TestRun
successRun :: TestRun
successRun :: forall a. Success a -> TestRun
successRun}) =
    forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [
        [String
"Test " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
ix]
      , [Log -> String
renderLog forall a b. (a -> b) -> a -> b
$ TestRun -> Log
runLog TestRun
successRun]
      ]

renderLog :: Log -> String
renderLog :: Log -> String
renderLog (Log [LogEntry]
log) = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LogEntry -> String
renderLogEntry (forall a. [a] -> [a]
reverse [LogEntry]
log)

renderLogEntry :: LogEntry -> String
renderLogEntry :: LogEntry -> String
renderLogEntry = \case
    Generated CallStack
stack String
x -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"generated "
      , String
x
      , String
" at "
      , CallStack -> String
prettyCallStack CallStack
stack
      ]
    Info String
x -> String
x