{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Syd.Output where

import Control.Exception
import Data.Algorithm.Diff
import qualified Data.List as L
import Data.List.Split (splitWhen)
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 Data.Word
import GHC.Stack
import Safe
import Test.QuickCheck.IO ()
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 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Text
LTB.toLazyText (Builder -> Text) -> Builder -> Text
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 =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
    ([Chunk] -> Builder) -> [[Chunk]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\[Chunk]
line -> TerminalCapabilities -> [Chunk] -> Builder
forall (f :: * -> *).
Foldable f =>
TerminalCapabilities -> f Chunk -> Builder
renderChunksBuilder TerminalCapabilities
tc [Chunk]
line Builder -> Builder -> Builder
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
_) =
  [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [[Chunk]]
outputTestsHeader,
      Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Int
0 (ResultForest -> Int
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 (ResultForest -> TestSuiteStats
computeTestSuiteStats (ResultForest -> TestSuiteStats)
-> Timed ResultForest -> Timed TestSuiteStats
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed ResultForest
trf),
      [[Text -> Chunk
chunk Text
""]]
    ]

outputFailuresHeader :: [[Chunk]]
outputFailuresHeader :: [[Chunk]]
outputFailuresHeader = 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
      [[[Chunk]]] -> [[Chunk]]
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 = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
testSuiteStatSumTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
      totalTimeSeconds :: Double
      totalTimeSeconds :: Double
totalTimeSeconds = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
timing Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
   in ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:) ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
        [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ [ Text -> Chunk
chunk Text
"Examples:                     ",
                Colour -> Chunk -> Chunk
fore Colour
green (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
testSuiteStatExamples))
              ]
              | Word
testSuiteStatExamples Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
testSuiteStatSuccesses
            ],
            [ [ Text -> Chunk
chunk Text
"Passed:                       ",
                Colour -> Chunk -> Chunk
fore Colour
green (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
testSuiteStatSuccesses))
              ],
              [ Text -> Chunk
chunk Text
"Failed:                       ",
                ( if Word
testSuiteStatFailures Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0
                    then Colour -> Chunk -> Chunk
fore Colour
red
                    else Colour -> Chunk -> Chunk
fore Colour
green
                )
                  (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
testSuiteStatFailures))
              ]
            ],
            [ [ Text -> Chunk
chunk Text
"Flaky:                        ",
                Colour -> Chunk -> Chunk
fore Colour
red (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
testSuiteStatFlakyTests))
              ]
              | Word
testSuiteStatFlakyTests Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0
            ],
            [ [ Text -> Chunk
chunk Text
"Pending:                      ",
                Colour -> Chunk -> Chunk
fore Colour
magenta (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
testSuiteStatPending))
              ]
              | Word
testSuiteStatPending Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0
            ],
            [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ let longestTimeSeconds :: Double
                    longestTimeSeconds :: Double
longestTimeSeconds = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
longestTestTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
                    longestTimePercentage :: Double
                    longestTimePercentage :: Double
longestTimePercentage = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
longestTimeSeconds Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sumTimeSeconds
                    showLongestTestDetails :: Bool
showLongestTestDetails = Double
longestTimePercentage Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
50
                 in ([Chunk] -> Bool) -> [[Chunk]] -> [[Chunk]]
forall a. (a -> Bool) -> [a] -> [a]
filter
                      (Bool -> Bool
not (Bool -> Bool) -> ([Chunk] -> Bool) -> [Chunk] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                      [ [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                          [ [ Chunk
"Longest test:                 ",
                              Colour -> Chunk -> Chunk
fore Colour
green (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
longestTestName
                            ]
                            | Bool
showLongestTestDetails
                          ],
                        [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                          [ [ Text -> Chunk
chunk Text
"Longest test took:   ",
                              Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%13.2f seconds" Double
longestTimeSeconds)
                            ],
                            [ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
", which is %.0f%% of total runtime" Double
longestTimePercentage)
                              | Bool
showLongestTestDetails
                            ]
                          ]
                      ]
                | (Text
longestTestName, Word64
longestTestTime) <- Maybe (Text, Word64) -> [(Text, Word64)]
forall a. Maybe a -> [a]
maybeToList Maybe (Text, Word64)
testSuiteStatLongestTime
              ],
            [ [ Text -> Chunk
chunk Text
"Sum of test runtimes:",
                Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Double -> String
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 (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%13.2f seconds" Double
totalTimeSeconds)
              ]
            ]
          ]

outputTestsHeader :: [[Chunk]]
outputTestsHeader :: [[Chunk]]
outputTestsHeader = Text -> [[Chunk]]
outputHeader Text
"Tests:"

outputHeader :: Text -> [[Chunk]]
outputHeader :: Text -> [[Chunk]]
outputHeader Text
t =
  [ [Colour -> Chunk -> Chunk
fore Colour
blue (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t],
    [Text -> Chunk
chunk Text
""]
  ]

outputSpecForest :: Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest :: Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Int
level Int
treeWidth = (ResultTree -> [[Chunk]]) -> ResultForest -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree Int
level Int
treeWidth)

outputSpecTree :: Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree :: Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree Int
level Int
treeWidth = \case
  SpecifyNode Text
t TDef (Timed TestRunResult)
td -> Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]
outputSpecifyLines Int
level Int
treeWidth Text
t TDef (Timed TestRunResult)
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 [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:) (Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
treeWidth ResultForest
sf)
  SubForestNode ResultForest
sf -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Int
level Int
treeWidth ResultForest
sf

outputDescribeLine :: Text -> [Chunk]
outputDescribeLine :: Text -> [Chunk]
outputDescribeLine Text
t = [Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t]

outputSpecifyLines :: Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]
outputSpecifyLines :: Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]
outputSpecifyLines Int
level Int
treeWidth Text
specifyText (TDef (Timed TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultFlakinessMessage :: TestRunResult -> Maybe String
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
testRunResultRetries :: TestRunResult -> Maybe Int
testRunResultStatus :: TestRunResult -> TestStatus
testRunResultFlakinessMessage :: Maybe String
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
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..} Word64
executionTime) CallStack
_) =
  let withStatusColour :: Chunk -> Chunk
withStatusColour = Colour -> Chunk -> Chunk
fore (TestStatus -> Colour
statusColour TestStatus
testRunResultStatus)
      pad :: [Chunk] -> [Chunk]
pad = (Text -> Chunk
chunk (String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:)
      timeChunk :: Chunk
timeChunk = Word64 -> Chunk
timeChunkFor Word64
executionTime
   in ([Chunk] -> Bool) -> [[Chunk]] -> [[Chunk]]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (Bool -> Bool
not (Bool -> Bool) -> ([Chunk] -> Bool) -> [Chunk] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
        ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ [ Chunk -> Chunk
withStatusColour (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (TestStatus -> Text
statusCheckMark TestStatus
testRunResultStatus),
                Chunk -> Chunk
withStatusColour (Chunk -> Chunk) -> Chunk -> Chunk
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
              ]
            ],
            ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]
retriesChunks TestStatus
testRunResultStatus Maybe Int
testRunResultRetries Maybe String
testRunResultFlakinessMessage,
            [ [Chunk] -> [Chunk]
pad
                [ Text -> Chunk
chunk Text
"passed for all of ",
                  case Word
w of
                    Word
0 -> Colour -> Chunk -> Chunk
fore Colour
red (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"0"
                    Word
_ -> Colour -> Chunk -> Chunk
fore Colour
green (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack (String -> Word -> String
forall r. PrintfType r => String -> r
printf String
"%d" Word
w)),
                  Chunk
" inputs."
                ]
              | TestStatus
testRunResultStatus TestStatus -> TestStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TestStatus
TestPassed,
                Word
w <- Maybe Word -> [Word]
forall a. Maybe a -> [a]
maybeToList Maybe Word
testRunResultNumTests
            ],
            ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ Word -> Maybe (Map [String] Int) -> [[Chunk]]
labelsChunks (Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
1 Maybe Word
testRunResultNumTests) Maybe (Map [String] Int)
testRunResultLabels,
            ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ Maybe (Map String Int) -> [[Chunk]]
classesChunks Maybe (Map String Int)
testRunResultClasses,
            ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
pad ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
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 ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ GoldenCase -> [Chunk]
outputGoldenCase GoldenCase
gc | GoldenCase
gc <- Maybe GoldenCase -> [GoldenCase]
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 = Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
2 (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Word -> Word
forall a. Enum a => a -> a
succ (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Double -> Word
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word) -> Double -> Word
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word -> Double) Word
total
      formatStr :: String
formatStr = String
"%" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
digits String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"d"
   in Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Word -> String
forall r. PrintfType r => String -> r
printf String
formatStr Word
current

timeChunkFor :: Word64 -> Chunk
timeChunkFor :: Word64 -> Chunk
timeChunkFor Word64
executionTime =
  let t :: Double
t = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
executionTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1_000_000 :: Double -- milliseconds
      executionTimeText :: Text
executionTimeText = String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%10.2f ms" Double
t)
      withTimingColour :: Chunk -> Chunk
withTimingColour =
        if
            | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10 -> Colour -> Chunk -> Chunk
fore Colour
green
            | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
100 -> Colour -> Chunk -> Chunk
fore Colour
yellow
            | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1000 -> Colour -> Chunk -> Chunk
fore Colour
orange
            | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10000 -> Colour -> Chunk -> Chunk
fore Colour
red
            | Bool
otherwise -> Colour -> Chunk -> Chunk
fore Colour
darkRed
   in Chunk -> Chunk
withTimingColour (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
executionTimeText

retriesChunks :: TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]
retriesChunks :: TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]
retriesChunks TestStatus
status Maybe Int
mRetries Maybe String
mMessage = case Maybe Int
mRetries of
  Maybe Int
Nothing -> []
  Just Int
retries -> case TestStatus
status of
    TestStatus
TestPassed ->
      [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
retries)), Colour -> Chunk -> Chunk
fore Colour
red Chunk
" !!! FLAKY !!!"]],
          [[Colour -> Chunk -> Chunk
fore Colour
magenta (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
message] | String
message <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
mMessage]
        ]
    TestStatus
TestFailed -> [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
retries)), Chunk
" (likely not 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)
  | Map [String] Int -> Bool
forall k a. Map k a -> Bool
M.null Map [String] Int
labels = []
  | (([String], Int) -> [String]) -> [([String], Int)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ([String], Int) -> [String]
forall a b. (a, b) -> a
fst (Map [String] Int -> [([String], Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map [String] Int
labels) [[String]] -> [[String]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[]] = []
  | Bool
otherwise =
      [Text -> Chunk
chunk Text
"Labels"] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
:
      (([String], Int) -> [Chunk]) -> [([String], Int)] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map
        ( [Chunk] -> [Chunk]
pad
            ([Chunk] -> [Chunk])
-> (([String], Int) -> [Chunk]) -> ([String], Int) -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \([String]
ss, Int
i) ->
                  [ Text -> Chunk
chunk
                      ( String -> Text
T.pack
                          ( String -> Double -> String -> String
forall r. PrintfType r => String -> r
printf
                              String
"%5.2f%% %s"
                              (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
totalCount :: Double)
                              ([String] -> String
commaList ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ss))
                          )
                      )
                  ]
              )
        )
        (Map [String] Int -> [([String], Int)]
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 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) Chunk -> [Chunk] -> [Chunk]
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)
  | Map String Int -> Bool
forall k a. Map k a -> Bool
M.null Map String Int
classes = []
  | Bool
otherwise =
      [Text -> Chunk
chunk Text
"Classes"] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
:
      ((String, Int) -> [Chunk]) -> [(String, Int)] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map
        ( [Chunk] -> [Chunk]
pad
            ([Chunk] -> [Chunk])
-> ((String, Int) -> [Chunk]) -> (String, Int) -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(String
s, Int
i) ->
                  [ Text -> Chunk
chunk
                      ( String -> Text
T.pack
                          ( String -> Double -> String -> String
forall r. PrintfType r => String -> r
printf String
"%5.2f%% %s" (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total :: Double) String
s
                          )
                      )
                  ]
              )
        )
        (Map String Int -> [(String, Int)]
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 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:)
    total :: Int
total = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd ([(String, Int)] -> [Int]) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map String Int -> [(String, Int)]
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) = ((String, Map String Int) -> [[Chunk]])
-> [(String, Map String Int)] -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> Map String Int -> [[Chunk]])
-> (String, Map String Int) -> [[Chunk]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Map String Int -> [[Chunk]]
goTable) ([(String, Map String Int)] -> [[Chunk]])
-> [(String, Map String Int)] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ Map String (Map String Int) -> [(String, Map String Int)]
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
" "] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
:
      [Text -> Chunk
chunk (String -> Text
T.pack String
tableName)] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
:
      ((String, Int) -> [Chunk]) -> [(String, Int)] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map
        ( [Chunk] -> [Chunk]
pad
            ([Chunk] -> [Chunk])
-> ((String, Int) -> [Chunk]) -> (String, Int) -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(String
s, Int
i) ->
                  [ Text -> Chunk
chunk
                      ( String -> Text
T.pack
                          ( String -> Double -> String -> String
forall r. PrintfType r => String -> r
printf String
"%5.2f%% %s" (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total :: Double) String
s
                          )
                      )
                  ]
              )
        )
        (Map String Int -> [(String, Int)]
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 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
paddingSize Char
' ')) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:)
        total :: Int
total = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd ([(String, Int)] -> [Int]) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map String Int -> [(String, Int)]
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 =
  ([Chunk] -> Bool) -> [[Chunk]] -> [[Chunk]]
forall a. (a -> Bool) -> [a] -> [a]
filter
    (Bool -> Bool
not (Bool -> Bool) -> ([Chunk] -> Bool) -> [Chunk] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    [ [Colour -> Chunk -> Chunk
fore Colour
magenta (Chunk -> Chunk) -> Chunk -> Chunk
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 Map [String] Int -> Map [String] Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int -> Map [String] Int
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 ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ Map [String] Int -> [[String]]
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> 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)
  | Map String Int -> Bool
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 (Map String Int -> [String]
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 (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"Golden output not found"]
  GoldenCase
GoldenStarted -> [Colour -> Chunk -> Chunk
fore Colour
cyan (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"Golden output created"]
  GoldenCase
GoldenReset -> [Colour -> Chunk -> Chunk
fore Colour
cyan (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
"Golden output reset"]

-- The chunk for spacing between the description and the timing
--
-- initial padding | checkmark | description | THIS CHUNK | execution time
spacingChunk :: Int -> Text -> Text -> Int -> Chunk
spacingChunk :: Int -> Text -> Text -> Int -> Chunk
spacingChunk Int
level Text
descriptionText Text
executionTimeText Int
treeWidth = Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
checkmarkWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minimumSpacing Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
actualTimingWidth -- All timings are the same width
          actualMaxWidth :: Int
actualMaxWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
totalNecessaryWidth Int
preferredMaxWidth
       in Int
actualMaxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
paddingSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
actualTimingWidth Int -> Int -> Int
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 TestRunResult))]
failures = (([Text], TDef (Timed TestRunResult)) -> Bool)
-> [([Text], TDef (Timed TestRunResult))]
-> [([Text], TDef (Timed TestRunResult))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Settings -> TestRunResult -> Bool
testFailed Settings
settings (TestRunResult -> Bool)
-> (([Text], TDef (Timed TestRunResult)) -> TestRunResult)
-> ([Text], TDef (Timed TestRunResult))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed TestRunResult -> TestRunResult
forall a. Timed a -> a
timedValue (Timed TestRunResult -> TestRunResult)
-> (([Text], TDef (Timed TestRunResult)) -> Timed TestRunResult)
-> ([Text], TDef (Timed TestRunResult))
-> TestRunResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TDef (Timed TestRunResult) -> Timed TestRunResult
forall value. TDef value -> value
testDefVal (TDef (Timed TestRunResult) -> Timed TestRunResult)
-> (([Text], TDef (Timed TestRunResult))
    -> TDef (Timed TestRunResult))
-> ([Text], TDef (Timed TestRunResult))
-> Timed TestRunResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], TDef (Timed TestRunResult)) -> TDef (Timed TestRunResult)
forall a b. (a, b) -> b
snd) ([([Text], TDef (Timed TestRunResult))]
 -> [([Text], TDef (Timed TestRunResult))])
-> [([Text], TDef (Timed TestRunResult))]
-> [([Text], TDef (Timed TestRunResult))]
forall a b. (a -> b) -> a -> b
$ ResultForest -> [([Text], TDef (Timed TestRunResult))]
forall a. SpecForest a -> [([Text], a)]
flattenSpecForest ResultForest
rf
      nbDigitsInFailureCount :: Int
      nbDigitsInFailureCount :: Int
nbDigitsInFailureCount = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 ([([Text], TDef (Timed TestRunResult))] -> Double
forall i a. Num i => [a] -> i
L.genericLength [([Text], TDef (Timed TestRunResult))]
failures) :: Double)
      padFailureDetails :: [Chunk] -> [Chunk]
padFailureDetails = (Text -> Chunk
chunk (String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nbDigitsInFailureCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Char
' ')) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:)
   in ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:) ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
        ([Chunk] -> Bool) -> [[Chunk]] -> [[Chunk]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Chunk] -> Bool) -> [Chunk] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
          [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Chunk]]] -> [[Chunk]]) -> [[[Chunk]]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
            [([Text], TDef (Timed TestRunResult))]
-> (Word -> ([Text], TDef (Timed TestRunResult)) -> [[Chunk]])
-> [[[Chunk]]]
forall a b. [a] -> (Word -> a -> b) -> [b]
indexed [([Text], TDef (Timed TestRunResult))]
failures ((Word -> ([Text], TDef (Timed TestRunResult)) -> [[Chunk]])
 -> [[[Chunk]]])
-> (Word -> ([Text], TDef (Timed TestRunResult)) -> [[Chunk]])
-> [[[Chunk]]]
forall a b. (a -> b) -> a -> b
$ \Word
w ([Text]
ts, TDef (Timed TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultFlakinessMessage :: Maybe String
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
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: TestRunResult -> Maybe String
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
testRunResultRetries :: TestRunResult -> Maybe Int
testRunResultStatus :: TestRunResult -> TestStatus
..} Word64
_) CallStack
cs) ->
              [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [ [ Colour -> Chunk -> Chunk
fore Colour
cyan (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$
                        Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$
                          String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                            Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
2 Char
' '
                              String -> String -> String
forall a. [a] -> [a] -> [a]
++ case [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
headMay ([(String, SrcLoc)] -> Maybe (String, SrcLoc))
-> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
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
srcLocPackage :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocFile :: SrcLoc -> String
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..}) ->
                                  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                                    [ String
srcLocFile,
                                      String
":",
                                      Int -> String
forall a. Show a => a -> String
show Int
srcLocStartLine
                                    ]
                    ],
                    (Chunk -> Chunk) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map
                      (Colour -> Chunk -> Chunk
fore (TestStatus -> Colour
statusColour TestStatus
testRunResultStatus))
                      [ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ TestStatus -> Text
statusCheckMark TestStatus
testRunResultStatus,
                        Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Word -> String
forall r. PrintfType r => String -> r
printf (String
"%" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nbDigitsInFailureCount String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"d ") Word
w),
                        Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." [Text]
ts
                      ]
                  ],
                  ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]
retriesChunks TestStatus
testRunResultStatus Maybe Int
testRunResultRetries Maybe String
testRunResultFlakinessMessage,
                  (String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map ([Chunk] -> [Chunk]
padFailureDetails ([Chunk] -> [Chunk]) -> (String -> [Chunk]) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: []) (Chunk -> [Chunk]) -> (String -> Chunk) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> (String -> Text) -> String -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) ([String] -> [[Chunk]]) -> [String] -> [[Chunk]]
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) -> [String -> Word -> String
forall r. PrintfType r => String -> r
printf String
"Failed after %d tests" Word
numTests]
                      (Just Word
numTests, Just Word
0) -> [String -> Word -> String
forall r. PrintfType r => String -> r
printf String
"Failed after %d tests" Word
numTests]
                      (Just Word
numTests, Just Word
numShrinks) -> [String -> Word -> Word -> String
forall r. PrintfType r => String -> r
printf String
"Failed after %d tests and %d shrinks" Word
numTests Word
numShrinks],
                  (String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map ([Chunk] -> [Chunk]
padFailureDetails ([Chunk] -> [Chunk]) -> (String -> [Chunk]) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Chunk
c -> [Text -> Chunk
chunk Text
"Generated: ", Chunk
c]) (Chunk -> [Chunk]) -> (String -> Chunk) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour -> Chunk -> Chunk
fore Colour
yellow (Chunk -> Chunk) -> (String -> Chunk) -> String -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> (String -> Text) -> String -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
testRunResultFailingInputs,
                  ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ Maybe (Map [String] Int) -> [[Chunk]]
outputFailureLabels Maybe (Map [String] Int)
testRunResultLabels,
                  ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ Maybe (Map String Int) -> [[Chunk]]
outputFailureClasses Maybe (Map String Int)
testRunResultClasses,
                  ([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ [[Chunk]]
-> (SomeException -> [[Chunk]]) -> Maybe SomeException -> [[Chunk]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SomeException -> [[Chunk]]
outputSomeException Maybe SomeException
testRunResultException,
                  [[Chunk] -> [Chunk]
padFailureDetails ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ GoldenCase -> [Chunk]
outputGoldenCase GoldenCase
gc | GoldenCase
gc <- Maybe GoldenCase -> [GoldenCase]
forall a. Maybe a -> [a]
maybeToList Maybe GoldenCase
testRunResultGoldenCase],
                  [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Chunk] -> [Chunk]
padFailureDetails ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ String -> [[Chunk]]
stringChunks String
ei | String
ei <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
testRunResultExtraInfo],
                  [[Text -> Chunk
chunk Text
""]]
                ]

outputSomeException :: SomeException -> [[Chunk]]
outputSomeException :: SomeException -> [[Chunk]]
outputSomeException SomeException
outerException =
  case SomeException -> Maybe Contextual
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
outerException :: Maybe Contextual of
    Just (Contextual e
innerException String
s) -> SomeException -> [[Chunk]]
outputSomeException (e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
innerException) [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ String -> [[Chunk]]
stringChunks String
s
    Maybe Contextual
Nothing ->
      case SomeException -> Maybe Assertion
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 (String -> [[Chunk]]) -> String -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$ SomeException -> String
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' [[Chunk]] -> [[Chunk]] -> [[Chunk]]
forall a. [a] -> [a] -> [a]
++ String -> [[Chunk]]
stringChunks String
context

outputEqualityAssertionFailed :: String -> String -> [[Chunk]]
outputEqualityAssertionFailed :: String -> String -> [[Chunk]]
outputEqualityAssertionFailed String
actual String
expected =
  let diff :: [Diff Char]
diff = String -> String -> [Diff Char]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff String
actual String
expected -- TODO use 'getGroupedDiff' instead, but then we need to fix the 'splitWhen' below
      splitLines :: [Chunk] -> [[Chunk]]
splitLines = (Chunk -> Bool) -> [Chunk] -> [[Chunk]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\n") (Text -> Bool) -> (Chunk -> Text) -> Chunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkText)
      chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]
      chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader Chunk
header = \case
        [[Chunk]
cs] -> [Chunk
header Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
cs]
        [[Chunk]]
cs -> [Chunk
header] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]]
cs
      actualChunks :: [[Chunk]]
      actualChunks :: [[Chunk]]
actualChunks = Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Actual:   ") ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
        [Chunk] -> [[Chunk]]
splitLines ([Chunk] -> [[Chunk]]) -> [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
          ((Diff Char -> Maybe Chunk) -> [Diff Char] -> [Chunk])
-> [Diff Char] -> (Diff Char -> Maybe Chunk) -> [Chunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff Char -> Maybe Chunk) -> [Diff Char] -> [Chunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff Char]
diff ((Diff Char -> Maybe Chunk) -> [Chunk])
-> (Diff Char -> Maybe Chunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \case
            First Char
a -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Colour -> Chunk -> Chunk
fore Colour
red (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
            Second Char
_ -> Maybe Chunk
forall a. Maybe a
Nothing
            Both Char
a Char
_ -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
      expectedChunks :: [[Chunk]]
      expectedChunks :: [[Chunk]]
expectedChunks = Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Expected: ") ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
        [Chunk] -> [[Chunk]]
splitLines ([Chunk] -> [[Chunk]]) -> [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
          ((Diff Char -> Maybe Chunk) -> [Diff Char] -> [Chunk])
-> [Diff Char] -> (Diff Char -> Maybe Chunk) -> [Chunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff Char -> Maybe Chunk) -> [Diff Char] -> [Chunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff Char]
diff ((Diff Char -> Maybe Chunk) -> [Chunk])
-> (Diff Char -> Maybe Chunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \case
            First Char
_ -> Maybe Chunk
forall a. Maybe a
Nothing
            Second Char
a -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Colour -> Chunk -> Chunk
fore Colour
green (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
            Both Char
a Char
_ -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
      inlineDiffChunks :: [[Chunk]]
      inlineDiffChunks :: [[Chunk]]
inlineDiffChunks =
        if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
actual) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
expected) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
          then []
          else Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Inline diff: ") ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
            [Chunk] -> [[Chunk]]
splitLines ([Chunk] -> [[Chunk]]) -> [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
              ((Diff Char -> Chunk) -> [Diff Char] -> [Chunk])
-> [Diff Char] -> (Diff Char -> Chunk) -> [Chunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff Char -> Chunk) -> [Diff Char] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Diff Char]
diff ((Diff Char -> Chunk) -> [Chunk])
-> (Diff Char -> Chunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \case
                First Char
a -> Colour -> Chunk -> Chunk
fore Colour
red (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
                Second Char
a -> Colour -> Chunk -> Chunk
fore Colour
green (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
                Both Char
a Char
_ -> Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
   in [[[Chunk]]] -> [[Chunk]]
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
notExpected -- String equality
    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 =
  [[[Chunk]]] -> [[Chunk]]
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)]
      ],
      [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Chunk
chunk Text
"Predicate: " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:) (String -> [[Chunk]]
stringChunks String
name) | String
name <- Maybe String -> [String]
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 =
  [[[Chunk]]] -> [[Chunk]]
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)]
      ],
      [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [([Chunk] -> [Chunk]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Chunk
chunk Text
"Predicate: " Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:) (String -> [[Chunk]]
stringChunks String
name) | String
name <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
mName]
    ]

mContextChunks :: Maybe String -> [[Chunk]]
mContextChunks :: Maybe String -> [[Chunk]]
mContextChunks = [[Chunk]] -> (String -> [[Chunk]]) -> Maybe String -> [[Chunk]]
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 (String -> [Chunk]) -> [String] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map ((Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: []) (Chunk -> [Chunk]) -> (String -> Chunk) -> String -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk (Text -> Chunk) -> (String -> Text) -> String -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
ls

indexed :: [a] -> (Word -> a -> b) -> [b]
indexed :: [a] -> (Word -> a -> b) -> [b]
indexed [a]
ls Word -> a -> b
func = (Word -> a -> b) -> [Word] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word -> a -> b
func [Word
1 ..] [a]
ls

outputFailure :: TestRunResult -> Maybe [[Chunk]]
outputFailure :: TestRunResult -> Maybe [[Chunk]]
outputFailure TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultFlakinessMessage :: Maybe String
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
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: TestRunResult -> Maybe String
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
testRunResultRetries :: TestRunResult -> Maybe Int
testRunResultStatus :: TestRunResult -> TestStatus
..} = case TestStatus
testRunResultStatus of
  TestStatus
TestPassed -> Maybe [[Chunk]]
forall a. Maybe a
Nothing
  TestStatus
TestFailed -> [[Chunk]] -> Maybe [[Chunk]]
forall a. a -> Maybe a
Just [[Text -> Chunk
chunk Text
"Failure"]]

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 :: SpecForest a -> Int
resultForestWidth = Int -> SpecForest a -> Int
forall a. Int -> SpecForest a -> Int
goF Int
0
  where
    goF :: Int -> SpecForest a -> Int
    goF :: Int -> SpecForest a -> Int
goF Int
level = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (SpecForest a -> [Int]) -> SpecForest a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpecTree a -> Int) -> SpecForest a -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> SpecTree a -> Int
forall a. Int -> SpecTree a -> Int
goT Int
level)
    goT :: Int -> SpecTree a -> Int
    goT :: Int -> SpecTree a -> Int
goT Int
level = \case
      SpecifyNode Text
t a
_ -> Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
paddingSize
      PendingNode Text
t Maybe Text
_ -> Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
paddingSize
      DescribeNode Text
_ SpecForest a
sdf -> Int -> SpecForest a -> Int
forall a. Int -> SpecForest a -> Int
goF (Int -> Int
forall a. Enum a => a -> a
succ Int
level) SpecForest a
sdf
      SubForestNode SpecForest a
sdf -> Int -> SpecForest a -> Int
forall a. Int -> SpecForest a -> Int
goF Int
level SpecForest a
sdf

specForestWidth :: SpecDefForest a b c -> Int
specForestWidth :: SpecDefForest a b c -> Int
specForestWidth = Int -> SpecDefForest a b c -> Int
forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
0
  where
    goF :: Int -> SpecDefForest a b c -> Int
    goF :: Int -> SpecDefForest a b c -> Int
goF Int
level = \case
      [] -> Int
0
      SpecDefForest a b c
ts -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (SpecDefTree a b c -> Int) -> SpecDefForest a b c -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> SpecDefTree a b c -> Int
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 :: 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
paddingSize
      DefPendingNode Text
t Maybe Text
_ -> Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
paddingSize
      DefDescribeNode Text
_ SpecDefForest a b c
sdf -> Int -> SpecDefForest a b c -> Int
forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF (Int -> Int
forall a. Enum a => a -> a
succ Int
level) SpecDefForest a b c
sdf
      DefWrapNode IO () -> IO ()
_ SpecDefForest a b c
sdf -> Int -> SpecDefForest a b c -> Int
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 -> Int -> SpecDefForest (outer : a) b c -> Int
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 -> Int -> SpecDefForest (outer : a) b c -> Int
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 -> Int -> SpecDefForest (newOuter : oldOuter : otherOuters) b c -> Int
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 -> Int -> SpecDefForest a b c -> Int
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 -> Int -> SpecDefForest a b c -> Int
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 -> Int -> SpecDefForest a b c -> Int
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 -> Int -> SpecDefForest a b c -> Int
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 (Text -> Chunk) -> Text -> 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