{-# 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 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,
      Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest 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 (ResultForest -> TestSuiteStats
computeTestSuiteStats 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
      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]]
outputTestsHeader :: [[Chunk]]
outputTestsHeader = Text -> [[Chunk]]
outputHeader Text
"Tests:"

outputHeader :: Text -> [[Chunk]]
outputHeader :: Text -> [[Chunk]]
outputHeader 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 :: Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest :: Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Int
level Int
treeWidth = 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 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Chunk
padding forall a. a -> [a] -> [a]
:) (Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest (Int
level 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 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 (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
testRunResultStatus),
                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
$ 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 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
testRunResultStatus 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 -- milliseconds
      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
1000 -> Colour -> Chunk -> Chunk
fore Colour
orange
            | Double
t 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 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 ->
      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 Int
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]
        ]
    TestStatus
TestFailed -> [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (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)
  | 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"]

-- 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 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 -- All timings are the same width
          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 TestRunResult))]
failures = forall a. (a -> Bool) -> [a] -> [a]
filter (Settings -> TestRunResult -> Bool
testFailed 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 TestRunResult))]
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 TestRunResult))]
failures 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) ->
              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
testRunResultStatus))
                      [ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ TestStatus -> Text
statusCheckMark TestStatus
testRunResultStatus,
                        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
$ TestStatus -> Maybe Int -> Maybe String -> [[Chunk]]
retriesChunks TestStatus
testRunResultStatus Maybe Int
testRunResultRetries Maybe String
testRunResultFlakinessMessage,
                  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

outputEqualityAssertionFailed :: String -> String -> [[Chunk]]
outputEqualityAssertionFailed :: String -> String -> [[Chunk]]
outputEqualityAssertionFailed String
actual String
expected =
  let diff :: [Diff Char]
diff = 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 = forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen ((forall a. Eq a => a -> a -> Bool
== Text
"\n") 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 forall a. a -> [a] -> [a]
: [Chunk]
cs]
        [[Chunk]]
cs -> [Chunk
header] forall a. a -> [a] -> [a]
: [[Chunk]]
cs
      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]]
splitLines 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 Char]
diff forall a b. (a -> b) -> a -> b
$ \case
            First Char
a -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Colour -> Chunk -> Chunk
fore Colour
red forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
            Second Char
_ -> forall a. Maybe a
Nothing
            Both Char
a Char
_ -> forall a. a -> Maybe a
Just 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: ") forall a b. (a -> b) -> a -> b
$
        [Chunk] -> [[Chunk]]
splitLines 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 Char]
diff forall a b. (a -> b) -> a -> b
$ \case
            First Char
_ -> forall a. Maybe a
Nothing
            Second Char
a -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Colour -> Chunk -> Chunk
fore Colour
green forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
            Both Char
a Char
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (Char -> Text
T.singleton Char
a)
      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]]
splitLines 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 Char]
diff forall a b. (a -> b) -> a -> b
$ \case
                First Char
a -> Colour -> Chunk -> Chunk
fore Colour
red 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 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 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 -- 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 =
  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

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 -> forall a. Maybe a
Nothing
  TestStatus
TestFailed -> 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 :: 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
      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

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