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

module Test.Syd.Output where

import Control.Arrow (second)
import Control.Exception
import Data.List (sortOn)
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.String (IsString (..))
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 Myers.Diff
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 Timed ResultForest
trf =
  let rf :: ResultForest
rf = Timed ResultForest -> ResultForest
forall a. Timed a -> a
timedValue Timed ResultForest
trf
   in [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [[Chunk]]
outputTestsHeader,
          Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings 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 (Settings -> ResultForest -> TestSuiteStats
computeTestSuiteStats Settings
settings (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
""]],
          if Settings -> Bool
settingProfile Settings
settings
            then Timed ResultForest -> [[Chunk]]
outputProfilingInfo Timed ResultForest
trf
            else []
        ]

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
timed =
  let TestSuiteStats {Word
Word64
testSuiteStatSuccesses :: Word
testSuiteStatExamples :: Word
testSuiteStatFailures :: Word
testSuiteStatFlakyTests :: Word
testSuiteStatPending :: Word
testSuiteStatSumTime :: Word64
testSuiteStatSuccesses :: TestSuiteStats -> Word
testSuiteStatExamples :: TestSuiteStats -> Word
testSuiteStatFailures :: TestSuiteStats -> Word
testSuiteStatFlakyTests :: TestSuiteStats -> Word
testSuiteStatPending :: TestSuiteStats -> Word
testSuiteStatSumTime :: TestSuiteStats -> Word64
..} = Timed TestSuiteStats -> TestSuiteStats
forall a. Timed a -> a
timedValue Timed TestSuiteStats
timed
      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 (Timed TestSuiteStats -> Word64
forall a. Timed a -> Word64
timedTime Timed TestSuiteStats
timed) 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
            ],
            [ [ 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)
              ]
            ]
          ]

outputProfilingInfo :: Timed ResultForest -> [[Chunk]]
outputProfilingInfo :: Timed ResultForest -> [[Chunk]]
outputProfilingInfo Timed {Int
ResultForest
Word64
timedValue :: forall a. Timed a -> a
timedValue :: ResultForest
timedWorker :: Int
timedBegin :: Word64
timedEnd :: Word64
timedWorker :: forall a. Timed a -> Int
timedBegin :: forall a. Timed a -> Word64
timedEnd :: forall a. Timed a -> Word64
..} =
  (([Text], Word64) -> [Chunk]) -> [([Text], Word64)] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map
    ( \([Text]
path, Word64
nanos) ->
        [ Word64 -> Chunk
timeChunkFor Word64
nanos,
          Chunk
" ",
          Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." [Text]
path
        ]
    )
    ( (([Text], Word64) -> Word64)
-> [([Text], Word64)] -> [([Text], Word64)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
        ([Text], Word64) -> Word64
forall a b. (a, b) -> b
snd
        ( (([Text], TDef (Timed TestRunReport)) -> ([Text], Word64))
-> [([Text], TDef (Timed TestRunReport))] -> [([Text], Word64)]
forall a b. (a -> b) -> [a] -> [b]
map
            ((TDef (Timed TestRunReport) -> Word64)
-> ([Text], TDef (Timed TestRunReport)) -> ([Text], Word64)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Timed TestRunReport -> Word64
forall a. Timed a -> Word64
timedTime (Timed TestRunReport -> Word64)
-> (TDef (Timed TestRunReport) -> Timed TestRunReport)
-> TDef (Timed TestRunReport)
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TDef (Timed TestRunReport) -> Timed TestRunReport
forall value. TDef value -> value
testDefVal))
            (ResultForest -> [([Text], TDef (Timed TestRunReport))]
forall a. SpecForest a -> [([Text], a)]
flattenSpecForest ResultForest
timedValue)
        )
    )

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 :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings Int
level Int
treeWidth = (SpecTree (TDef (Timed TestRunReport)) -> [[Chunk]])
-> ResultForest -> [[Chunk]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Settings
-> Int -> Int -> SpecTree (TDef (Timed TestRunReport)) -> [[Chunk]]
outputSpecTree Settings
settings Int
level Int
treeWidth)

outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]
outputSpecTree :: Settings
-> Int -> Int -> SpecTree (TDef (Timed TestRunReport)) -> [[Chunk]]
outputSpecTree Settings
settings Int
level Int
treeWidth = \case
  SpecifyNode Text
t TDef (Timed TestRunReport)
td -> Settings
-> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines Settings
settings Int
level Int
treeWidth Text
t TDef (Timed TestRunReport)
td
  PendingNode Text
t Maybe Text
mr -> Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
  DescribeNode Text
t ResultForest
sf -> Text -> [Chunk]
outputDescribeLine Text
t [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]
:) (Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
treeWidth ResultForest
sf)
  SubForestNode ResultForest
sf -> Settings -> Int -> Int -> ResultForest -> [[Chunk]]
outputSpecForest Settings
settings Int
level Int
treeWidth ResultForest
sf

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

outputSpecifyLines :: Settings -> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines :: Settings
-> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines Settings
settings Int
level Int
treeWidth Text
specifyText (TDef Timed TestRunReport
timed CallStack
_) =
  let testRunReport :: TestRunReport
testRunReport = Timed TestRunReport -> TestRunReport
forall a. Timed a -> a
timedValue Timed TestRunReport
timed
      executionTime :: Word64
executionTime = Timed TestRunReport -> Word64
forall a. Timed a -> Word64
timedTime Timed TestRunReport
timed
      status :: TestStatus
status = Settings -> TestRunReport -> TestStatus
testRunReportStatus Settings
settings TestRunReport
testRunReport
      TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
testRunResultStatus :: TestRunResult -> TestStatus
testRunResultException :: TestRunResult -> Maybe SomeException
testRunResultNumTests :: TestRunResult -> Maybe Word
testRunResultNumShrinks :: TestRunResult -> Maybe Word
testRunResultFailingInputs :: TestRunResult -> [String]
testRunResultLabels :: TestRunResult -> Maybe (Map [String] Int)
testRunResultClasses :: TestRunResult -> Maybe (Map String Int)
testRunResultTables :: TestRunResult -> Maybe (Map String (Map String Int))
testRunResultGoldenCase :: TestRunResult -> Maybe GoldenCase
testRunResultExtraInfo :: TestRunResult -> Maybe String
..} = TestRunReport -> TestRunResult
testRunReportReportedRun TestRunReport
testRunReport
      withStatusColour :: Chunk -> Chunk
withStatusColour = Colour -> Chunk -> Chunk
fore (TestStatus -> Colour
statusColour TestStatus
status)
      pad :: [Chunk] -> [Chunk]
pad = (Text -> Chunk
chunk (String -> Text
T.pack (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 a. [a] -> 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
status),
                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
$ TestRunReport -> [[Chunk]]
retriesChunks TestRunReport
testRunReport,
            [ [Chunk] -> [Chunk]
pad
                [ Text -> Chunk
chunk Text
"passed for all of ",
                  case Word
w of
                    Word
0 -> Colour -> Chunk -> Chunk
fore Colour
red (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
status 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 b. Integral b => Double -> b
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
1_000 -> Colour -> Chunk -> Chunk
fore Colour
orange
          | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10_000 -> Colour -> Chunk -> Chunk
fore Colour
red
          | Bool
otherwise -> Colour -> Chunk -> Chunk
fore Colour
darkRed
   in Chunk -> Chunk
withTimingColour (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
executionTimeText

retriesChunks :: TestRunReport -> [[Chunk]]
retriesChunks :: TestRunReport -> [[Chunk]]
retriesChunks TestRunReport
testRunReport =
  case TestRunReport -> Maybe Word
testRunReportRetries TestRunReport
testRunReport of
    Maybe Word
Nothing -> []
    Just Word
retries ->
      let flaky :: Bool
flaky = TestRunReport -> Bool
testRunReportWasFlaky TestRunReport
testRunReport
          mMessage :: Maybe String
mMessage = case TestRunReport -> FlakinessMode
testRunReportFlakinessMode TestRunReport
testRunReport of
            MayBeFlaky Maybe String
mmesg -> Maybe String
mmesg
            FlakinessMode
MayNotBeFlaky -> Maybe String
forall a. Maybe a
Nothing
       in if Bool
flaky
            then
              [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
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]
                ]
            else [[Chunk
"Retries: ", Text -> Chunk
chunk (String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
retries)), Chunk
" (does not look flaky)"]]

labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]
labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]
labelsChunks Word
_ Maybe (Map [String] Int)
Nothing = []
labelsChunks Word
totalCount (Just Map [String] Int
labels)
  | 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 a. Num a => [a] -> a
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 a. Num a => [a] -> a
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 a. [a] -> 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 TestRunReport))]
failures = (([Text], TDef (Timed TestRunReport)) -> Bool)
-> [([Text], TDef (Timed TestRunReport))]
-> [([Text], TDef (Timed TestRunReport))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Settings -> TestRunReport -> Bool
testRunReportFailed Settings
settings (TestRunReport -> Bool)
-> (([Text], TDef (Timed TestRunReport)) -> TestRunReport)
-> ([Text], TDef (Timed TestRunReport))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed TestRunReport -> TestRunReport
forall a. Timed a -> a
timedValue (Timed TestRunReport -> TestRunReport)
-> (([Text], TDef (Timed TestRunReport)) -> Timed TestRunReport)
-> ([Text], TDef (Timed TestRunReport))
-> TestRunReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TDef (Timed TestRunReport) -> Timed TestRunReport
forall value. TDef value -> value
testDefVal (TDef (Timed TestRunReport) -> Timed TestRunReport)
-> (([Text], TDef (Timed TestRunReport))
    -> TDef (Timed TestRunReport))
-> ([Text], TDef (Timed TestRunReport))
-> Timed TestRunReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], TDef (Timed TestRunReport)) -> TDef (Timed TestRunReport)
forall a b. (a, b) -> b
snd) ([([Text], TDef (Timed TestRunReport))]
 -> [([Text], TDef (Timed TestRunReport))])
-> [([Text], TDef (Timed TestRunReport))]
-> [([Text], TDef (Timed TestRunReport))]
forall a b. (a -> b) -> a -> b
$ ResultForest -> [([Text], TDef (Timed TestRunReport))]
forall a. SpecForest a -> [([Text], a)]
flattenSpecForest ResultForest
rf
      nbDigitsInFailureCount :: Int
      nbDigitsInFailureCount :: Int
nbDigitsInFailureCount = Double -> Int
forall b. Integral b => Double -> b
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 TestRunReport))] -> Double
forall i a. Num i => [a] -> i
L.genericLength [([Text], TDef (Timed TestRunReport))]
failures) :: Double)
      padFailureDetails :: [Chunk] -> [Chunk]
padFailureDetails = (Text -> Chunk
chunk (String -> Text
T.pack (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 a. [a] -> 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 TestRunReport))]
-> (Word -> ([Text], TDef (Timed TestRunReport)) -> [[Chunk]])
-> [[[Chunk]]]
forall a b. [a] -> (Word -> a -> b) -> [b]
indexed [([Text], TDef (Timed TestRunReport))]
failures ((Word -> ([Text], TDef (Timed TestRunReport)) -> [[Chunk]])
 -> [[[Chunk]]])
-> (Word -> ([Text], TDef (Timed TestRunReport)) -> [[Chunk]])
-> [[[Chunk]]]
forall a b. (a -> b) -> a -> b
$ \Word
w ([Text]
ts, TDef Timed TestRunReport
timed CallStack
cs) ->
              let testRunReport :: TestRunReport
testRunReport = Timed TestRunReport -> TestRunReport
forall a. Timed a -> a
timedValue Timed TestRunReport
timed
                  status :: TestStatus
status = Settings -> TestRunReport -> TestStatus
testRunReportStatus Settings
settings TestRunReport
testRunReport
                  TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultStatus :: TestRunResult -> TestStatus
testRunResultException :: TestRunResult -> Maybe SomeException
testRunResultNumTests :: TestRunResult -> Maybe Word
testRunResultNumShrinks :: TestRunResult -> Maybe Word
testRunResultFailingInputs :: TestRunResult -> [String]
testRunResultLabels :: TestRunResult -> Maybe (Map [String] Int)
testRunResultClasses :: TestRunResult -> Maybe (Map String Int)
testRunResultTables :: TestRunResult -> Maybe (Map String (Map String Int))
testRunResultGoldenCase :: TestRunResult -> Maybe GoldenCase
testRunResultExtraInfo :: TestRunResult -> Maybe String
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
..} = TestRunReport -> TestRunResult
testRunReportReportedRun TestRunReport
testRunReport
               in [[[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 :: String
srcLocModule :: String
srcLocFile :: String
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocPackage :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocFile :: SrcLoc -> String
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
..}) ->
                                      [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
status))
                          [ Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ TestStatus -> Text
statusCheckMark TestStatus
status,
                            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
$ TestRunReport -> [[Chunk]]
retriesChunks TestRunReport
testRunReport,
                      (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
  NotEqualButShouldHaveBeenEqualWithDiff String
actual String
expected Maybe [Diff Text]
diffM -> String -> String -> Maybe [Diff Text] -> [[Chunk]]
outputEqualityAssertionFailed String
actual String
expected Maybe [Diff Text]
diffM
  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

-- | Split a list of 'Chunk's into lines of [Chunks].
--
-- This is rather complicated because chunks may contain newlines, in which
-- case they need to be split into two chunks on separate lines but with the
-- same colour information.
-- However, separate chunks are not necessarily on separate lines because there
-- may not be a newline inbetween.
splitChunksIntoLines :: [Chunk] -> [[Chunk]]
splitChunksIntoLines :: [Chunk] -> [[Chunk]]
splitChunksIntoLines =
  -- We maintain a list of 'currently traversing lines'.
  -- These are already split into newlines and therefore definitely belong on separate lines.
  -- We still need to keep the last of the current line though, because it
  -- does not end in a newline and should therefore not necessarily belong on
  -- a separate line by itself.
  NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go ([] [Chunk] -> [[Chunk]] -> NonEmpty [Chunk]
forall a. a -> [a] -> NonEmpty a
:| []) -- Start with an empty current line.
  where
    -- CurrentlyTraversingLines -> ChunksToStillSplit -> SplitChunks
    go :: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
    go :: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go NonEmpty [Chunk]
cls [Chunk]
cs = case NonEmpty [Chunk] -> ([Chunk], Maybe (NonEmpty [Chunk]))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty [Chunk]
cls of
      ([Chunk]
currentLine, Maybe (NonEmpty [Chunk])
mRest) -> case Maybe (NonEmpty [Chunk])
mRest of
        -- If there's only one current line, that's the last one of the currently traversing lines.
        -- We split the next chunk into lines and append the first line of that to the current line.
        Maybe (NonEmpty [Chunk])
Nothing -> case [Chunk]
cs of
          -- If there is only one current line, and no more chunks, it's the last line.
          [] -> [[Chunk]
currentLine]
          -- If there are chunks left, split the first one into lines.
          (Chunk
c : [Chunk]
rest) -> case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n" (Chunk -> Text
chunkText Chunk
c) of
            -- Should not happen, but would be fine, just skip this chunk
            [] -> NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go NonEmpty [Chunk]
cls [Chunk]
rest
            -- If the chunk had more than one lines
            (Text
l : [Text]
ls) -> case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
ls of
              -- If there was only one line in the chunk, we continue with the
              -- same current line onto the rest of the chunks
              Maybe (NonEmpty Text)
Nothing -> NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go (([Chunk]
currentLine [Chunk] -> [Chunk] -> [Chunk]
forall a. Semigroup a => a -> a -> a
<> [Chunk
c {chunkText = l}]) [Chunk] -> [[Chunk]] -> NonEmpty [Chunk]
forall a. a -> [a] -> NonEmpty a
:| []) [Chunk]
rest
              -- If there was more than one line in that chunk, that line is now considered finished.
              -- We then make all the lines of this new chunk the new current lines, one chunk per line.
              Just NonEmpty Text
ne -> ([Chunk]
currentLine [Chunk] -> [Chunk] -> [Chunk]
forall a. Semigroup a => a -> a -> a
<> [Chunk
c {chunkText = l}]) [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go ((Text -> [Chunk]) -> NonEmpty Text -> NonEmpty [Chunk]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\Text
l' -> [Chunk
c {chunkText = l'}]) NonEmpty Text
ne) [Chunk]
rest
        -- If there is more than one current line, all but the last one are considered finished.
        -- We skip them one by one.
        Just NonEmpty [Chunk]
ne -> [Chunk]
currentLine [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]
go NonEmpty [Chunk]
ne [Chunk]
cs

outputEqualityAssertionFailed :: String -> String -> Maybe [PolyDiff Text Text] -> [[Chunk]]
outputEqualityAssertionFailed :: String -> String -> Maybe [Diff Text] -> [[Chunk]]
outputEqualityAssertionFailed String
actual String
expected Maybe [Diff Text]
diffM =
  case Maybe [Diff Text]
diffM of
    Just [Diff Text]
diff -> String -> String -> [Diff Text] -> [[Chunk]]
formatDiff String
actual String
expected [Diff Text]
diff
    Maybe [Diff Text]
Nothing ->
      [[[Chunk]]] -> [[Chunk]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [[Text -> Chunk
chunk Text
"Expected these values to be equal:"]],
          [[Text -> Chunk
chunk Text
"Diff computation took too long and was canceled"]],
          [[String -> Chunk
forall a. IsString a => String -> a
fromString String
actual]],
          [[String -> Chunk
forall a. IsString a => String -> a
fromString String
expected]]
        ]

formatDiff :: String -> String -> [PolyDiff Text Text] -> [[Chunk]]
formatDiff :: String -> String -> [Diff Text] -> [[Chunk]]
formatDiff String
actual String
expected [Diff Text]
diff =
  let -- Add a header to a list of lines of chunks
      chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]
      chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader Chunk
header = \case
        -- If there is only one line, put the header on that line.
        [[Chunk]
cs] -> [Chunk
header Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
cs]
        -- If there is more than one line, put the header on a separate line before
        [[Chunk]]
cs -> [Chunk
header] [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]]
cs

      -- If it's only whitespace, change the background, otherwise change the foreground
      foreOrBack :: Colour -> Text -> Chunk
      foreOrBack :: Colour -> Text -> Chunk
foreOrBack Colour
c Text
t =
        (if Text -> Bool
T.null (Text -> Text
T.strip Text
t) then Colour -> Chunk -> Chunk
back Colour
c else Colour -> Chunk -> Chunk
fore Colour
c)
          (Text -> Chunk
chunk Text
t)
      actualChunks :: [[Chunk]]
      actualChunks :: [[Chunk]]
actualChunks = Chunk -> [[Chunk]] -> [[Chunk]]
chunksLinesWithHeader (Colour -> Chunk -> Chunk
fore Colour
blue Chunk
"Actual:   ") ([[Chunk]] -> [[Chunk]]) -> [[Chunk]] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
        [Chunk] -> [[Chunk]]
splitChunksIntoLines ([Chunk] -> [[Chunk]]) -> [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
          ((Diff Text -> Maybe Chunk) -> [Diff Text] -> [Chunk])
-> [Diff Text] -> (Diff Text -> Maybe Chunk) -> [Chunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff Text -> Maybe Chunk) -> [Diff Text] -> [Chunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff Text]
diff ((Diff Text -> Maybe Chunk) -> [Chunk])
-> (Diff Text -> Maybe Chunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \case
            First Text
t -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Colour -> Text -> Chunk
foreOrBack Colour
red Text
t
            Second Text
_ -> Maybe Chunk
forall a. Maybe a
Nothing
            Both Text
t Text
_ -> 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 Text
t
      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]]
splitChunksIntoLines ([Chunk] -> [[Chunk]]) -> [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
          ((Diff Text -> Maybe Chunk) -> [Diff Text] -> [Chunk])
-> [Diff Text] -> (Diff Text -> Maybe Chunk) -> [Chunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff Text -> Maybe Chunk) -> [Diff Text] -> [Chunk]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Diff Text]
diff ((Diff Text -> Maybe Chunk) -> [Chunk])
-> (Diff Text -> Maybe Chunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \case
            First Text
_ -> Maybe Chunk
forall a. Maybe a
Nothing
            Second Text
t -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just (Chunk -> Maybe Chunk) -> Chunk -> Maybe Chunk
forall a b. (a -> b) -> a -> b
$ Colour -> Text -> Chunk
foreOrBack Colour
green Text
t
            Both Text
t Text
_ -> 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 Text
t
      inlineDiffChunks :: [[Chunk]]
      inlineDiffChunks :: [[Chunk]]
inlineDiffChunks =
        if [String] -> Int
forall a. [a] -> 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 a. [a] -> 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]]
splitChunksIntoLines ([Chunk] -> [[Chunk]]) -> [Chunk] -> [[Chunk]]
forall a b. (a -> b) -> a -> b
$
              ((Diff Text -> Chunk) -> [Diff Text] -> [Chunk])
-> [Diff Text] -> (Diff Text -> Chunk) -> [Chunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Diff Text -> Chunk) -> [Diff Text] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map [Diff Text]
diff ((Diff Text -> Chunk) -> [Chunk])
-> (Diff Text -> Chunk) -> [Chunk]
forall a b. (a -> b) -> a -> b
$ \case
                First Text
t -> Colour -> Text -> Chunk
foreOrBack Colour
red Text
t
                Second Text
t -> Colour -> Text -> Chunk
foreOrBack Colour
green Text
t
                Both Text
t Text
_ -> Text -> Chunk
chunk Text
t
   in [[[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 :: forall a b. [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

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 = Int -> SpecForest a -> Int
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 = [Int] -> Int
forall a. Ord a => [a] -> a
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 :: forall a. 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 :: forall (a :: [*]) b c. 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 :: forall (a :: [*]) b c. Int -> SpecDefForest a b c -> Int
goF Int
level = \case
      [] -> Int
0
      SpecDefForest a b c
ts -> [Int] -> Int
forall a. Ord a => [a] -> a
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 :: 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 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
      DefSetupNode 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
      DefBeforeAllWithNode oldOuter -> IO newOuter
_ 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
      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
      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
      DefRetriesNode Word -> Word
_ 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
      DefExpectationNode ExpectationMode
_ 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