{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Syd.Output where
import Control.Exception
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as LTB
import qualified Data.Text.Lazy.Builder as Text
import qualified Data.Text.Lazy.IO as LTIO
import qualified Data.Vector as V
import Data.Word
import GHC.Stack
import Safe
import Test.QuickCheck.IO ()
import Test.Syd.Diff
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour
import Text.Printf
printOutputSpecForest :: Settings -> Timed ResultForest -> IO ()
printOutputSpecForest :: Settings -> Timed ResultForest -> IO ()
printOutputSpecForest Settings
settings Timed ResultForest
results = do
TerminalCapabilities
tc <- Settings -> IO TerminalCapabilities
deriveTerminalCapababilities Settings
settings
Text -> IO ()
LTIO.putStr forall a b. (a -> b) -> a -> b
$ Builder -> Text
LTB.toLazyText forall a b. (a -> b) -> a -> b
$ Settings -> TerminalCapabilities -> Timed ResultForest -> Builder
renderResultReport Settings
settings TerminalCapabilities
tc Timed ResultForest
results
renderResultReport :: Settings -> TerminalCapabilities -> Timed ResultForest -> Text.Builder
renderResultReport :: Settings -> TerminalCapabilities -> Timed ResultForest -> Builder
renderResultReport Settings
settings TerminalCapabilities
tc Timed ResultForest
rf =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\[Chunk]
line -> forall (f :: * -> *).
Foldable f =>
TerminalCapabilities -> f Chunk -> Builder
renderChunksBuilder TerminalCapabilities
tc [Chunk]
line forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Settings -> Timed ResultForest -> [[Chunk]]
outputResultReport Settings
settings Timed ResultForest
rf)
outputResultReport :: Settings -> Timed ResultForest -> [[Chunk]]
outputResultReport :: Settings -> Timed ResultForest -> [[Chunk]]
outputResultReport Settings
settings trf :: Timed ResultForest
trf@(Timed ResultForest
rf Word64
_) =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[Chunk]]
outputTestsHeader,
Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings Int
0 (forall a. SpecForest a -> Int
resultForestWidth ResultForest
rf) ResultForest
rf,
[ [Text -> Chunk
chunk Text
""],
[Text -> Chunk
chunk Text
""]
],
Settings -> ResultForest -> [[Chunk]]
outputFailuresWithHeading Settings
settings ResultForest
rf,
[[Text -> Chunk
chunk Text
""]],
Timed TestSuiteStats -> [[Chunk]]
outputStats (Settings -> ResultForest -> TestSuiteStats
computeTestSuiteStats Settings
settings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed ResultForest
trf),
[[Text -> Chunk
chunk Text
""]]
]
outputFailuresHeader :: [[Chunk]]
= Text -> [[Chunk]]
outputHeader Text
"Failures:"
outputFailuresWithHeading :: Settings -> ResultForest -> [[Chunk]]
outputFailuresWithHeading :: Settings -> ResultForest -> [[Chunk]]
outputFailuresWithHeading Settings
settings ResultForest
rf =
if Settings -> ResultForest -> Bool
shouldExitFail Settings
settings ResultForest
rf
then
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[Chunk]]
outputFailuresHeader,
Settings -> ResultForest -> [[Chunk]]
outputFailures Settings
settings ResultForest
rf
]
else []
outputStats :: Timed TestSuiteStats -> [[Chunk]]
outputStats :: Timed TestSuiteStats -> [[Chunk]]
outputStats (Timed TestSuiteStats {Maybe (Text, Word64)
Word
Word64
testSuiteStatLongestTime :: TestSuiteStats -> Maybe (Text, Word64)
testSuiteStatSumTime :: TestSuiteStats -> Word64
testSuiteStatPending :: TestSuiteStats -> Word
testSuiteStatFlakyTests :: TestSuiteStats -> Word
testSuiteStatFailures :: TestSuiteStats -> Word
testSuiteStatExamples :: TestSuiteStats -> Word
testSuiteStatSuccesses :: TestSuiteStats -> Word
testSuiteStatLongestTime :: Maybe (Text, Word64)
testSuiteStatSumTime :: Word64
testSuiteStatPending :: Word
testSuiteStatFlakyTests :: Word
testSuiteStatFailures :: Word
testSuiteStatExamples :: Word
testSuiteStatSuccesses :: Word
..} Word64
timing) =
let sumTimeSeconds :: Double
sumTimeSeconds :: Double
sumTimeSeconds = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
testSuiteStatSumTime forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
totalTimeSeconds :: Double
totalTimeSeconds :: Double
totalTimeSeconds = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
timing forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
in forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [ Text -> Chunk
chunk Text
"Examples: ",
Colour -> Chunk -> Chunk
fore Colour
green forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
testSuiteStatExamples))
]
| Word
testSuiteStatExamples forall a. Eq a => a -> a -> Bool
/= Word
testSuiteStatSuccesses
],
[ [ Text -> Chunk
chunk Text
"Passed: ",
Colour -> Chunk -> Chunk
fore Colour
green forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
testSuiteStatSuccesses))
],
[ Text -> Chunk
chunk Text
"Failed: ",
( if Word
testSuiteStatFailures forall a. Ord a => a -> a -> Bool
> Word
0
then Colour -> Chunk -> Chunk
fore Colour
red
else Colour -> Chunk -> Chunk
fore Colour
green
)
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
testSuiteStatFailures))
]
],
[ [ Text -> Chunk
chunk Text
"Flaky: ",
Colour -> Chunk -> Chunk
fore Colour
red forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
testSuiteStatFlakyTests))
]
| Word
testSuiteStatFlakyTests forall a. Ord a => a -> a -> Bool
> Word
0
],
[ [ Text -> Chunk
chunk Text
"Pending: ",
Colour -> Chunk -> Chunk
fore Colour
magenta forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
testSuiteStatPending))
]
| Word
testSuiteStatPending forall a. Ord a => a -> a -> Bool
> Word
0
],
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ let longestTimeSeconds :: Double
longestTimeSeconds :: Double
longestTimeSeconds = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
longestTestTime forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
longestTimePercentage :: Double
longestTimePercentage :: Double
longestTimePercentage = Double
100 forall a. Num a => a -> a -> a
* Double
longestTimeSeconds forall a. Fractional a => a -> a -> a
/ Double
sumTimeSeconds
showLongestTestDetails :: Bool
showLongestTestDetails = Double
longestTimePercentage forall a. Ord a => a -> a -> Bool
> Double
50
in forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
[ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ Chunk
"Longest test: ",
Colour -> Chunk -> Chunk
fore Colour
green forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
longestTestName
]
| Bool
showLongestTestDetails
],
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ Text -> Chunk
chunk Text
"Longest test took: ",
Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%13.2f seconds" Double
longestTimeSeconds)
],
[ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
", which is %.0f%% of total runtime" Double
longestTimePercentage)
| Bool
showLongestTestDetails
]
]
]
| (Text
longestTestName, Word64
longestTestTime) <- forall a. Maybe a -> [a]
maybeToList Maybe (Text, Word64)
testSuiteStatLongestTime
],
[ [ Text -> Chunk
chunk Text
"Sum of test runtimes:",
Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%13.2f seconds" Double
sumTimeSeconds)
],
[ Text -> Chunk
chunk Text
"Test suite took: ",
Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%13.2f seconds" Double
totalTimeSeconds)
]
]
]
outputTestsHeader :: [[Chunk]]
= Text -> [[Chunk]]
outputHeader Text
"Tests:"
outputHeader :: Text -> [[Chunk]]
Text
t =
[ [Colour -> Chunk -> Chunk
fore Colour
blue forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t],
[Text -> Chunk
chunk Text
""]
]
outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings Int
level Int
treeWidth = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Settings -> Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree Settings
settings Int
level Int
treeWidth)
outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree Settings
settings Int
level Int
treeWidth = \case
SpecifyNode Text
t TDef (Timed TestRunReport)
td -> Settings
-> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines Settings
settings Int
level Int
treeWidth Text
t TDef (Timed TestRunReport)
td
PendingNode Text
t Maybe Text
mr -> Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
DescribeNode Text
t ResultForest
sf -> Text -> [Chunk]
outputDescribeLine Text
t forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding forall a. a -> [a] -> [a]
:) (Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings (Int
level forall a. Num a => a -> a -> a
+ Int
1) Int
treeWidth ResultForest
sf)
SubForestNode ResultForest
sf -> Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings Int
level Int
treeWidth ResultForest
sf
outputDescribeLine :: Text -> [Chunk]
outputDescribeLine :: Text -> [Chunk]
outputDescribeLine Text
t = [Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t]
outputSpecifyLines :: Settings -> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines :: Settings
-> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines Settings
settings Int
level Int
treeWidth Text
specifyText (TDef (Timed TestRunReport
testRunReport Word64
executionTime) CallStack
_) =
let status :: TestStatus
status = Settings -> TestRunReport -> TestStatus
testRunReportStatus Settings
settings TestRunReport
testRunReport
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultExtraInfo :: TestRunResult -> Maybe String
testRunResultGoldenCase :: TestRunResult -> Maybe GoldenCase
testRunResultTables :: TestRunResult -> Maybe (Map String (Map String Int))
testRunResultClasses :: TestRunResult -> Maybe (Map String Int)
testRunResultLabels :: TestRunResult -> Maybe (Map [String] Int)
testRunResultFailingInputs :: TestRunResult -> [String]
testRunResultNumShrinks :: TestRunResult -> Maybe Word
testRunResultNumTests :: TestRunResult -> Maybe Word
testRunResultException :: TestRunResult -> Maybe SomeException
testRunResultStatus :: TestRunResult -> TestStatus
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultStatus :: TestStatus
..} = TestRunReport -> TestRunResult
testRunReportReportedRun TestRunReport
testRunReport
withStatusColour :: Chunk -> Chunk
withStatusColour = Colour -> Chunk -> Chunk
fore (TestStatus -> Colour
statusColour TestStatus
status)
pad :: [Chunk] -> [Chunk]
pad = (Text -> Chunk
chunk (String -> Text
T.pack (forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) forall a. a -> [a] -> [a]
:)
timeChunk :: Chunk
timeChunk = Word64 -> Chunk
timeChunkFor Word64
executionTime
in forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [ Chunk -> Chunk
withStatusColour forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (TestStatus -> Text
statusCheckMark TestStatus
status),
Chunk -> Chunk
withStatusColour forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
specifyText,
Int -> Text -> Text -> Int -> Chunk
spacingChunk Int
level Text
specifyText (Chunk -> Text
chunkText Chunk
timeChunk) Int
treeWidth,
Chunk
timeChunk
]
],
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad forall a b. (a -> b) -> a -> b
$ TestRunReport -> [[Chunk]]
retriesChunks TestRunReport
testRunReport,
[ [Chunk] -> [Chunk]
pad
[ Text -> Chunk
chunk Text
"passed for all of ",
case Word
w of
Word
0 -> Colour -> Chunk -> Chunk
fore Colour
red forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"0"
Word
_ -> Colour -> Chunk -> Chunk
fore Colour
green forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%d" Word
w)),
Chunk
" inputs."
]
| TestStatus
status forall a. Eq a => a -> a -> Bool
== TestStatus
TestPassed,
Word
w <- forall a. Maybe a -> [a]
maybeToList Maybe Word
testRunResultNumTests
],
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad forall a b. (a -> b) -> a -> b
$ Word -> Maybe (Map [String] Int) -> [[Chunk]]
labelsChunks (forall a. a -> Maybe a -> a
fromMaybe Word
1 Maybe Word
testRunResultNumTests) Maybe (Map [String] Int)
testRunResultLabels,
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad forall a b. (a -> b) -> a -> b
$ Maybe (Map String Int) -> [[Chunk]]
classesChunks Maybe (Map String Int)
testRunResultClasses,
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad forall a b. (a -> b) -> a -> b
$ Maybe (Map String (Map String Int)) -> [[Chunk]]
tablesChunks Maybe (Map String (Map String Int))
testRunResultTables,
[[Chunk] -> [Chunk]
pad forall a b. (a -> b) -> a -> b
$ GoldenCase -> [Chunk]
outputGoldenCase GoldenCase
gc | GoldenCase
gc <- forall a. Maybe a -> [a]
maybeToList Maybe GoldenCase
testRunResultGoldenCase]
]
exampleNrChunk :: Word -> Word -> Chunk
exampleNrChunk :: Word -> Word -> Chunk
exampleNrChunk Word
total Word
current =
let digits :: Word
digits :: Word
digits = forall a. Ord a => a -> a -> a
max Word
2 forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase Double
10 forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Double) Word
total
formatStr :: String
formatStr = String
"%" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
digits forall a. Semigroup a => a -> a -> a
<> String
"d"
in Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
formatStr Word
current
timeChunkFor :: Word64 -> Chunk
timeChunkFor :: Word64 -> Chunk
timeChunkFor Word64
executionTime =
let t :: Double
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
executionTime forall a. Fractional a => a -> a -> a
/ Double
1_000_000 :: Double
executionTimeText :: Text
executionTimeText = String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%10.2f ms" Double
t)
withTimingColour :: Chunk -> Chunk
withTimingColour =
if
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10 -> Colour -> Chunk -> Chunk
fore Colour
green
| Double
t forall a. Ord a => a -> a -> Bool
< Double
100 -> Colour -> Chunk -> Chunk
fore Colour
yellow
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1_000 -> Colour -> Chunk -> Chunk
fore Colour
orange
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10_000 -> Colour -> Chunk -> Chunk
fore Colour
red
| Bool
otherwise -> Colour -> Chunk -> Chunk
fore Colour
darkRed
in Chunk -> Chunk
withTimingColour forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
executionTimeText
retriesChunks :: TestRunReport -> [[Chunk]]
retriesChunks :: TestRunReport -> [[Chunk]]
retriesChunks TestRunReport
testRunReport =
case TestRunReport -> Maybe Word
testRunReportRetries TestRunReport
testRunReport of
Maybe Word
Nothing -> []
Just Word
retries ->
let flaky :: Bool
flaky = TestRunReport -> Bool
testRunReportWasFlaky TestRunReport
testRunReport
mMessage :: Maybe String
mMessage = case TestRunReport -> FlakinessMode
testRunReportFlakinessMode TestRunReport
testRunReport of
MayBeFlaky Maybe String
mmesg -> Maybe String
mmesg
FlakinessMode
MayNotBeFlaky -> forall a. Maybe a
Nothing
in if Bool
flaky
then
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
retries)), Colour -> Chunk -> Chunk
fore Colour
red Chunk
" !!! FLAKY !!!"]],
[[Colour -> Chunk -> Chunk
fore Colour
magenta forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
message] | String
message <- forall a. Maybe a -> [a]
maybeToList Maybe String
mMessage]
]
else [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (forall a. Show a => a -> String
show Word
retries)), Chunk
" (does not look flaky)"]]
labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]
labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]
labelsChunks Word
_ Maybe (Map [String] Int)
Nothing = []
labelsChunks Word
totalCount (Just Map [String] Int
labels)
| forall k a. Map k a -> Bool
M.null Map [String] Int
labels = []
| forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall k a. Map k a -> [(k, a)]
M.toList Map [String] Int
labels) forall a. Eq a => a -> a -> Bool
== [[]] = []
| Bool
otherwise =
[Text -> Chunk
chunk Text
"Labels"] forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map
( [Chunk] -> [Chunk]
pad
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \([String]
ss, Int
i) ->
[ Text -> Chunk
chunk
( String -> Text
T.pack
( forall r. PrintfType r => String -> r
printf
String
"%5.2f%% %s"
(Double
100 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
totalCount :: Double)
([String] -> String
commaList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ss))
)
)
]
)
)
(forall k a. Map k a -> [(k, a)]
M.toList Map [String] Int
labels)
where
pad :: [Chunk] -> [Chunk]
pad = (Text -> Chunk
chunk (String -> Text
T.pack (forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) forall a. a -> [a] -> [a]
:)
classesChunks :: Maybe (Map String Int) -> [[Chunk]]
classesChunks :: Maybe (Map String Int) -> [[Chunk]]
classesChunks Maybe (Map String Int)
Nothing = []
classesChunks (Just Map String Int
classes)
| forall k a. Map k a -> Bool
M.null Map String Int
classes = []
| Bool
otherwise =
[Text -> Chunk
chunk Text
"Classes"] forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map
( [Chunk] -> [Chunk]
pad
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(String
s, Int
i) ->
[ Text -> Chunk
chunk
( String -> Text
T.pack
( forall r. PrintfType r => String -> r
printf String
"%5.2f%% %s" (Double
100 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total :: Double) String
s
)
)
]
)
)
(forall k a. Map k a -> [(k, a)]
M.toList Map String Int
classes)
where
pad :: [Chunk] -> [Chunk]
pad = (Text -> Chunk
chunk (String -> Text
T.pack (forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) forall a. a -> [a] -> [a]
:)
total :: Int
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String Int
classes
tablesChunks :: Maybe (Map String (Map String Int)) -> [[Chunk]]
tablesChunks :: Maybe (Map String (Map String Int)) -> [[Chunk]]
tablesChunks Maybe (Map String (Map String Int))
Nothing = []
tablesChunks (Just Map String (Map String Int)
tables) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Map String Int -> [[Chunk]]
goTable) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String (Map String Int)
tables
where
goTable :: String -> Map String Int -> [[Chunk]]
goTable :: String -> Map String Int -> [[Chunk]]
goTable String
tableName Map String Int
percentages =
[Text -> Chunk
chunk Text
" "] forall a. a -> [a] -> [a]
:
[Text -> Chunk
chunk (String -> Text
T.pack String
tableName)] forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map
( [Chunk] -> [Chunk]
pad
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(String
s, Int
i) ->
[ Text -> Chunk
chunk
( String -> Text
T.pack
( forall r. PrintfType r => String -> r
printf String
"%5.2f%% %s" (Double
100 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total :: Double) String
s
)
)
]
)
)
(forall k a. Map k a -> [(k, a)]
M.toList Map String Int
percentages)
where
pad :: [Chunk] -> [Chunk]
pad = (Text -> Chunk
chunk (String -> Text
T.pack (forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) forall a. a -> [a] -> [a]
:)
total :: Int
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String Int
percentages
outputPendingLines :: Text -> Maybe Text -> [[Chunk]]
outputPendingLines :: Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
specifyText Maybe Text
mReason =
forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
[ [Colour -> Chunk -> Chunk
fore Colour
magenta forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
specifyText],
case Maybe Text
mReason of
Maybe Text
Nothing -> []
Just Text
reason -> [Chunk
padding, Text -> Chunk
chunk Text
reason]
]
outputFailureLabels :: Maybe (Map [String] Int) -> [[Chunk]]
outputFailureLabels :: Maybe (Map [String] Int) -> [[Chunk]]
outputFailureLabels Maybe (Map [String] Int)
Nothing = []
outputFailureLabels (Just Map [String] Int
labels)
| Map [String] Int
labels forall a. Eq a => a -> a -> Bool
== forall k a. k -> a -> Map k a
M.singleton [] Int
1 = []
| Bool
otherwise = [[Chunk
"Labels: ", Text -> Chunk
chunk (String -> Text
T.pack ([String] -> String
commaList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map [String] Int
labels))))]]
commaList :: [String] -> String
commaList :: [String] -> String
commaList [] = []
commaList [String
s] = String
s
commaList (String
s1 : [String]
rest) = String
s1 forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ [String] -> String
commaList [String]
rest
outputFailureClasses :: Maybe (Map String Int) -> [[Chunk]]
outputFailureClasses :: Maybe (Map String Int) -> [[Chunk]]
outputFailureClasses Maybe (Map String Int)
Nothing = []
outputFailureClasses (Just Map String Int
classes)
| forall k a. Map k a -> Bool
M.null Map String Int
classes = []
| Bool
otherwise = [[Chunk
"Class: ", Text -> Chunk
chunk (String -> Text
T.pack ([String] -> String
commaList (forall k a. Map k a -> [k]
M.keys Map String Int
classes)))]]
outputGoldenCase :: GoldenCase -> [Chunk]
outputGoldenCase :: GoldenCase -> [Chunk]
outputGoldenCase = \case
GoldenCase
GoldenNotFound -> [Colour -> Chunk -> Chunk
fore Colour
red forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"Golden output not found"]
GoldenCase
GoldenStarted -> [Colour -> Chunk -> Chunk
fore Colour
cyan forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"Golden output created"]
GoldenCase
GoldenReset -> [Colour -> Chunk -> Chunk
fore Colour
cyan forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"Golden output reset"]
spacingChunk :: Int -> Text -> Text -> Int -> Chunk
spacingChunk :: Int -> Text -> Text -> Int -> Chunk
spacingChunk Int
level Text
descriptionText Text
executionTimeText Int
treeWidth = Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
paddingWidth Char
' '
where
paddingWidth :: Int
paddingWidth =
let preferredMaxWidth :: Int
preferredMaxWidth = Int
80
checkmarkWidth :: Int
checkmarkWidth = Int
2
minimumSpacing :: Int
minimumSpacing = Int
1
actualDescriptionWidth :: Int
actualDescriptionWidth = Text -> Int
T.length Text
descriptionText
actualTimingWidth :: Int
actualTimingWidth = Text -> Int
T.length Text
executionTimeText
totalNecessaryWidth :: Int
totalNecessaryWidth = Int
treeWidth forall a. Num a => a -> a -> a
+ Int
checkmarkWidth forall a. Num a => a -> a -> a
+ Int
minimumSpacing forall a. Num a => a -> a -> a
+ Int
actualTimingWidth
actualMaxWidth :: Int
actualMaxWidth = forall a. Ord a => a -> a -> a
max Int
totalNecessaryWidth Int
preferredMaxWidth
in Int
actualMaxWidth forall a. Num a => a -> a -> a
- Int
paddingSize forall a. Num a => a -> a -> a
* Int
level forall a. Num a => a -> a -> a
- Int
actualTimingWidth forall a. Num a => a -> a -> a
- Int
actualDescriptionWidth
outputFailures :: Settings -> ResultForest -> [[Chunk]]
outputFailures :: Settings -> ResultForest -> [[Chunk]]
outputFailures Settings
settings ResultForest
rf =
let failures :: [([Text], TDef (Timed TestRunReport))]
failures = forall a. (a -> Bool) -> [a] -> [a]
filter (Settings -> TestRunReport -> Bool
testRunReportFailed Settings
settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
timedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall value. TDef value -> value
testDefVal 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. SpecForest a -> [([Text], a)]
flattenSpecForest ResultForest
rf
nbDigitsInFailureCount :: Int
nbDigitsInFailureCount :: Int
nbDigitsInFailureCount = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Floating a => a -> a -> a
logBase Double
10 (forall i a. Num i => [a] -> i
L.genericLength [([Text], TDef (Timed TestRunReport))]
failures) :: Double)
padFailureDetails :: [Chunk] -> [Chunk]
padFailureDetails = (Text -> Chunk
chunk (String -> Text
T.pack (forall a. Int -> a -> [a]
replicate (Int
nbDigitsInFailureCount forall a. Num a => a -> a -> a
+ Int
4) Char
' ')) forall a. a -> [a] -> [a]
:)
in forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> (Word -> a -> b) -> [b]
indexed [([Text], TDef (Timed TestRunReport))]
failures forall a b. (a -> b) -> a -> b
$ \Word
w ([Text]
ts, TDef (Timed TestRunReport
testRunReport Word64
_) CallStack
cs) ->
let status :: TestStatus
status = Settings -> TestRunReport -> TestStatus
testRunReportStatus Settings
settings TestRunReport
testRunReport
TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultStatus :: TestStatus
testRunResultExtraInfo :: TestRunResult -> Maybe String
testRunResultGoldenCase :: TestRunResult -> Maybe GoldenCase
testRunResultTables :: TestRunResult -> Maybe (Map String (Map String Int))
testRunResultClasses :: TestRunResult -> Maybe (Map String Int)
testRunResultLabels :: TestRunResult -> Maybe (Map [String] Int)
testRunResultFailingInputs :: TestRunResult -> [String]
testRunResultNumShrinks :: TestRunResult -> Maybe Word
testRunResultNumTests :: TestRunResult -> Maybe Word
testRunResultException :: TestRunResult -> Maybe SomeException
testRunResultStatus :: TestRunResult -> TestStatus
..} = TestRunReport -> TestRunResult
testRunReportReportedRun TestRunReport
testRunReport
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [ Colour -> Chunk -> Chunk
fore Colour
cyan forall a b. (a -> b) -> a -> b
$
Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$
String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
forall a. Int -> a -> [a]
replicate Int
2 Char
' '
forall a. [a] -> [a] -> [a]
++ case forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
Maybe (String, SrcLoc)
Nothing -> String
"Unknown location"
Just (String
_, SrcLoc {Int
String
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..}) ->
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
srcLocFile,
String
":",
forall a. Show a => a -> String
show Int
srcLocStartLine
]
],
forall a b. (a -> b) -> [a] -> [b]
map
(Colour -> Chunk -> Chunk
fore (TestStatus -> Colour
statusColour TestStatus
status))
[ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ TestStatus -> Text
statusCheckMark TestStatus
status,
Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall r. PrintfType r => String -> r
printf (String
"%" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nbDigitsInFailureCount forall a. [a] -> [a] -> [a]
++ String
"d ") Word
w),
Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." [Text]
ts
]
],
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails forall a b. (a -> b) -> a -> b
$ TestRunReport -> [[Chunk]]
retriesChunks TestRunReport
testRunReport,
forall a b. (a -> b) -> [a] -> [b]
map ([Chunk] -> [Chunk]
padFailureDetails forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall a b. (a -> b) -> a -> b
$
case (Maybe Word
testRunResultNumTests, Maybe Word
testRunResultNumShrinks) of
(Maybe Word
Nothing, Maybe Word
_) -> []
(Just Word
numTests, Maybe Word
Nothing) -> [forall r. PrintfType r => String -> r
printf String
"Failed after %d tests" Word
numTests]
(Just Word
numTests, Just Word
0) -> [forall r. PrintfType r => String -> r
printf String
"Failed after %d tests" Word
numTests]
(Just Word
numTests, Just Word
numShrinks) -> [forall r. PrintfType r => String -> r
printf String
"Failed after %d tests and %d shrinks" Word
numTests Word
numShrinks],
forall a b. (a -> b) -> [a] -> [b]
map ([Chunk] -> [Chunk]
padFailureDetails forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Chunk
c -> [Text -> Chunk
chunk Text
"Generated: ", Chunk
c]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour -> Chunk -> Chunk
fore Colour
yellow forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
testRunResultFailingInputs,
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails forall a b. (a -> b) -> a -> b
$ Maybe (Map [String] Int) -> [[Chunk]]
outputFailureLabels Maybe (Map [String] Int)
testRunResultLabels,
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails forall a b. (a -> b) -> a -> b
$ Maybe (Map String Int) -> [[Chunk]]
outputFailureClasses Maybe (Map String Int)
testRunResultClasses,
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SomeException -> [[Chunk]]
outputSomeException Maybe SomeException
testRunResultException,
[[Chunk] -> [Chunk]
padFailureDetails forall a b. (a -> b) -> a -> b
$ GoldenCase -> [Chunk]
outputGoldenCase GoldenCase
gc | GoldenCase
gc <- forall a. Maybe a -> [a]
maybeToList Maybe GoldenCase
testRunResultGoldenCase],
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails forall a b. (a -> b) -> a -> b
$ String -> [[Chunk]]
stringChunks String
ei | String
ei <- forall a. Maybe a -> [a]
maybeToList Maybe String
testRunResultExtraInfo],
[[Text -> Chunk
chunk Text
""]]
]
outputSomeException :: SomeException -> [[Chunk]]
outputSomeException :: SomeException -> [[Chunk]]
outputSomeException SomeException
outerException =
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
outerException :: Maybe Contextual of
Just (Contextual e
innerException String
s) -> SomeException -> [[Chunk]]
outputSomeException (forall e. Exception e => e -> SomeException
SomeException e
innerException) forall a. [a] -> [a] -> [a]
++ String -> [[Chunk]]
stringChunks String
s
Maybe Contextual
Nothing ->
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
outerException :: Maybe Assertion of
Just Assertion
a -> Assertion -> [[Chunk]]
outputAssertion Assertion
a
Maybe Assertion
Nothing -> String -> [[Chunk]]
stringChunks forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> String
displayException SomeException
outerException
outputAssertion :: Assertion -> [[Chunk]]
outputAssertion :: Assertion -> [[Chunk]]
outputAssertion = \case
NotEqualButShouldHaveBeenEqual String
actual String
expected -> String -> String -> [[Chunk]]
outputEqualityAssertionFailed String
actual String
expected
EqualButShouldNotHaveBeenEqual String
actual String
notExpected -> String -> String -> [[Chunk]]
outputNotEqualAssertionFailed String
actual String
notExpected
PredicateFailedButShouldHaveSucceeded String
actual Maybe String
mName -> String -> Maybe String -> [[Chunk]]
outputPredicateSuccessAssertionFailed String
actual Maybe String
mName
PredicateSucceededButShouldHaveFailed String
actual Maybe String
mName -> String -> Maybe String -> [[Chunk]]
outputPredicateFailAssertionFailed String
actual Maybe String
mName
ExpectationFailed String
s -> String -> [[Chunk]]
stringChunks String
s
Context Assertion
a' String
context -> Assertion -> [[Chunk]]
outputAssertion Assertion
a' forall a. [a] -> [a] -> [a]
++ String -> [[Chunk]]
stringChunks String
context
splitChunksIntoLines :: [Chunk] -> [[Chunk]]
splitChunksIntoLines :: [Chunk] -> [[Chunk]]
splitChunksIntoLines =
NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go ([] forall a. a -> [a] -> NonEmpty a
:| [])
where
go :: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go :: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go NonEmpty [Chunk]
cls [Chunk]
cs = case forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty [Chunk]
cls of
([Chunk]
currentLine, Maybe (NonEmpty [Chunk])
mRest) -> case Maybe (NonEmpty [Chunk])
mRest of
Maybe (NonEmpty [Chunk])
Nothing -> case [Chunk]
cs of
[] -> [[Chunk]
currentLine]
(Chunk
c : [Chunk]
rest) -> case Text -> Text -> [Text]
T.splitOn Text
"\n" (Chunk -> Text
chunkText Chunk
c) of
[] -> NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go NonEmpty [Chunk]
cls [Chunk]
rest
(Text
l : [Text]
ls) -> case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
ls of
Maybe (NonEmpty Text)
Nothing -> NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go (([Chunk]
currentLine forall a. Semigroup a => a -> a -> a
<> [Chunk
c {chunkText :: Text
chunkText = Text
l}]) forall a. a -> [a] -> NonEmpty a
:| []) [Chunk]
rest
Just NonEmpty Text
ne -> ([Chunk]
currentLine forall a. Semigroup a => a -> a -> a
<> [Chunk
c {chunkText :: Text
chunkText = Text
l}]) forall a. a -> [a] -> [a]
: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\Text
l' -> [Chunk
c {chunkText :: Text
chunkText = Text
l'}]) NonEmpty Text
ne) [Chunk]
rest
Just NonEmpty [Chunk]
ne -> [Chunk]
currentLine forall a. a -> [a] -> [a]
: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go NonEmpty [Chunk]
ne [Chunk]
cs
outputEqualityAssertionFailed :: String -> String -> [[Chunk]]
outputEqualityAssertionFailed :: String -> String -> [[Chunk]]
outputEqualityAssertionFailed String
actual String
expected =
let diff :: [Diff Text]
diff = forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ Text -> Text -> Vector (Diff Text)
getTextDiff (String -> Text
T.pack String
actual) (String -> Text
T.pack String
expected)
chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader Chunk
header = \case
[[Chunk]
cs] -> [Chunk
header forall a. a -> [a] -> [a]
: [Chunk]
cs]
[[Chunk]]
cs -> [Chunk
header] forall a. a -> [a] -> [a]
: [[Chunk]]
cs
foreOrBack :: Colour -> Text -> Chunk
foreOrBack :: Colour -> Text -> Chunk
foreOrBack Colour
c Text
t =
(if Text -> Bool
T.null (Text -> Text
T.strip Text
t) then Colour -> Chunk -> Chunk
back Colour
c else Colour -> Chunk -> Chunk
fore Colour
c)
(Text -> Chunk
chunk Text
t)
actualChunks :: [[Chunk]]
actualChunks :: [[Chunk]]
actualChunks = Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Actual: ") forall a b. (a -> b) -> a -> b
$
[Chunk] -> [[Chunk]]
splitChunksIntoLines forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff Text]
diff forall a b. (a -> b) -> a -> b
$ \case
First Text
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Colour -> Text -> Chunk
foreOrBack Colour
red Text
t
Second Text
_ -> forall a. Maybe a
Nothing
Both Text
t Text
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t
expectedChunks :: [[Chunk]]
expectedChunks :: [[Chunk]]
expectedChunks = Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Expected: ") forall a b. (a -> b) -> a -> b
$
[Chunk] -> [[Chunk]]
splitChunksIntoLines forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff Text]
diff forall a b. (a -> b) -> a -> b
$ \case
First Text
_ -> forall a. Maybe a
Nothing
Second Text
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Colour -> Text -> Chunk
foreOrBack Colour
green Text
t
Both Text
t Text
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t
inlineDiffChunks :: [[Chunk]]
inlineDiffChunks :: [[Chunk]]
inlineDiffChunks =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
actual) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
expected) forall a. Eq a => a -> a -> Bool
== Int
1
then []
else Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Inline diff: ") forall a b. (a -> b) -> a -> b
$
[Chunk] -> [[Chunk]]
splitChunksIntoLines forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Diff Text]
diff forall a b. (a -> b) -> a -> b
$ \case
First Text
t -> Colour -> Text -> Chunk
foreOrBack Colour
red Text
t
Second Text
t -> Colour -> Text -> Chunk
foreOrBack Colour
green Text
t
Both Text
t Text
_ -> Text -> Chunk
chunk Text
t
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[Text -> Chunk
chunk Text
"Expected these values to be equal:"]],
[[Chunk]]
actualChunks,
[[Chunk]]
expectedChunks,
[[Chunk]]
inlineDiffChunks
]
outputNotEqualAssertionFailed :: String -> String -> [[Chunk]]
outputNotEqualAssertionFailed :: String -> String -> [[Chunk]]
outputNotEqualAssertionFailed String
actual String
notExpected =
if String
actual forall a. Eq a => a -> a -> Bool
== String
notExpected
then
[ [Text -> Chunk
chunk Text
"Did not expect equality of the values but both were:"],
[Text -> Chunk
chunk (String -> Text
T.pack String
actual)]
]
else
[ [Text -> Chunk
chunk Text
"These two values were considered equal but should not have been equal:"],
[Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Actual : ", Text -> Chunk
chunk (String -> Text
T.pack String
actual)],
[Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Not Expected: ", Text -> Chunk
chunk (String -> Text
T.pack String
notExpected)]
]
outputPredicateSuccessAssertionFailed :: String -> Maybe String -> [[Chunk]]
outputPredicateSuccessAssertionFailed :: String -> Maybe String -> [[Chunk]]
outputPredicateSuccessAssertionFailed String
actual Maybe String
mName =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [Text -> Chunk
chunk Text
"Predicate failed, but should have succeeded, on this value:"],
[Text -> Chunk
chunk (String -> Text
T.pack String
actual)]
],
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map (Text -> Chunk
chunk Text
"Predicate: " forall a. a -> [a] -> [a]
:) (String -> [[Chunk]]
stringChunks String
name) | String
name <- forall a. Maybe a -> [a]
maybeToList Maybe String
mName]
]
outputPredicateFailAssertionFailed :: String -> Maybe String -> [[Chunk]]
outputPredicateFailAssertionFailed :: String -> Maybe String -> [[Chunk]]
outputPredicateFailAssertionFailed String
actual Maybe String
mName =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [Text -> Chunk
chunk Text
"Predicate succeeded, but should have failed, on this value:"],
[Text -> Chunk
chunk (String -> Text
T.pack String
actual)]
],
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map (Text -> Chunk
chunk Text
"Predicate: " forall a. a -> [a] -> [a]
:) (String -> [[Chunk]]
stringChunks String
name) | String
name <- forall a. Maybe a -> [a]
maybeToList Maybe String
mName]
]
mContextChunks :: Maybe String -> [[Chunk]]
mContextChunks :: Maybe String -> [[Chunk]]
mContextChunks = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [[Chunk]]
stringChunks
stringChunks :: String -> [[Chunk]]
stringChunks :: String -> [[Chunk]]
stringChunks String
s =
let ls :: [String]
ls = String -> [String]
lines String
s
in forall a b. (a -> b) -> [a] -> [b]
map ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
ls
indexed :: [a] -> (Word -> a -> b) -> [b]
indexed :: forall a b. [a] -> (Word -> a -> b) -> [b]
indexed [a]
ls Word -> a -> b
func = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word -> a -> b
func [Word
1 ..] [a]
ls
statusColour :: TestStatus -> Colour
statusColour :: TestStatus -> Colour
statusColour = \case
TestStatus
TestPassed -> Colour
green
TestStatus
TestFailed -> Colour
red
statusCheckMark :: TestStatus -> Text
statusCheckMark :: TestStatus -> Text
statusCheckMark = \case
TestStatus
TestPassed -> Text
"\10003 "
TestStatus
TestFailed -> Text
"\10007 "
resultForestWidth :: SpecForest a -> Int
resultForestWidth :: forall a. SpecForest a -> Int
resultForestWidth = forall a. Int -> SpecForest a -> Int
goF Int
0
where
goF :: Int -> SpecForest a -> Int
goF :: forall a. Int -> SpecForest a -> Int
goF Int
level = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> SpecTree a -> Int
goT Int
level)
goT :: Int -> SpecTree a -> Int
goT :: forall a. Int -> SpecTree a -> Int
goT Int
level = \case
SpecifyNode Text
t a
_ -> Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
level forall a. Num a => a -> a -> a
* Int
paddingSize
PendingNode Text
t Maybe Text
_ -> Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
level forall a. Num a => a -> a -> a
* Int
paddingSize
DescribeNode Text
_ SpecForest a
sdf -> forall a. Int -> SpecForest a -> Int
goF (forall a. Enum a => a -> a
succ Int
level) SpecForest a
sdf
SubForestNode SpecForest a
sdf -> forall a. Int -> SpecForest a -> Int
goF Int
level SpecForest a
sdf
specForestWidth :: SpecDefForest a b c -> Int
specForestWidth :: forall (a :: [*]) b c. SpecDefForest a b c -> Int
specForestWidth = forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
0
where
goF :: Int -> SpecDefForest a b c -> Int
goF :: forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level = \case
[] -> Int
0
SpecDefForest a b c
ts -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: [*]) b c. Int -> SpecDefTree a b c -> Int
goT Int
level) SpecDefForest a b c
ts
goT :: Int -> SpecDefTree a b c -> Int
goT :: forall (a :: [*]) b c. Int -> SpecDefTree a b c -> Int
goT Int
level = \case
DefSpecifyNode Text
t TDef
(ProgressReporter
-> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
_ c
_ -> Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
level forall a. Num a => a -> a -> a
* Int
paddingSize
DefPendingNode Text
t Maybe Text
_ -> Text -> Int
T.length Text
t forall a. Num a => a -> a -> a
+ Int
level forall a. Num a => a -> a -> a
* Int
paddingSize
DefDescribeNode Text
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF (forall a. Enum a => a -> a
succ Int
level) SpecDefForest a b c
sdf
DefWrapNode IO () -> IO ()
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
DefBeforeAllNode IO outer
_ SpecDefForest (outer : a) b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest (outer : a) b c
sdf
DefAroundAllNode (outer -> IO ()) -> IO ()
_ SpecDefForest (outer : a) b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest (outer : a) b c
sdf
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
_ SpecDefForest (newOuter : oldOuter : otherOuters) b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest (newOuter : oldOuter : otherOuters) b c
sdf
DefAfterAllNode HList a -> IO ()
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
DefParallelismNode Parallelism
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
DefRetriesNode Word -> Word
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
DefFlakinessNode FlakinessMode
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
DefExpectationNode ExpectationMode
_ SpecDefForest a b c
sdf -> forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level SpecDefForest a b c
sdf
padding :: Chunk
padding :: Chunk
padding = Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
paddingSize Text
" "
paddingSize :: Int
paddingSize :: Int
paddingSize = Int
2
orange :: Colour
orange :: Colour
orange = Word8 -> Colour
colour256 Word8
166
darkRed :: Colour
darkRed :: Colour
darkRed = Word8 -> Colour
colour256 Word8
160