module Test.Falsify.Internal.Driver (
Options(..)
, Success(..)
, Failure(..)
, TotalDiscarded(..)
, falsify
, 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
data Options = Options {
Options -> Word
tests :: Word
, Options -> Maybe Word
maxShrinks :: Maybe Word
, Options -> Maybe ReplaySeed
replay :: Maybe ReplaySeed
, 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
}
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
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
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
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)
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)
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)
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
data DriverState a = DriverState {
forall a. DriverState a -> SMGen
prng :: SMGen
, forall a. DriverState a -> [Success a]
successes :: [Success a]
, forall a. DriverState a -> Word
todo :: Word
, forall a. DriverState a -> Word
discardedForTest :: Word
, 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
, 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
}
data Verbose = Verbose | NotVerbose
data ExpectFailure = ExpectFailure | DontExpectFailure
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
(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
]
]
}
(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
]
}
(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"
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
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
allLabels :: Set String
allLabels :: Set String
allLabels = forall k a. Map k a -> Set k
Map.keysSet Map String (Set String)
allValues
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
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
]
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