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

module Test.Syd.Output.Common where

import Control.Exception
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (cast)
import Data.Word
import Myers.Diff
import Test.Syd.Run
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour
import Text.Printf

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

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 "

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

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

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

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

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) ->
      -- Check if innerException is already a SomeException to avoid double-wrapping
      let innerSE :: SomeException
innerSE = case e -> Maybe SomeException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
innerException of
            Just SomeException
se -> SomeException
se :: SomeException
            Maybe SomeException
Nothing -> e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
innerException
       in SomeException -> [[Chunk]]
outputSomeException SomeException
innerSE [[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]
    ]

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 ()) -> HList (oldOuter : otherOuters) -> 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
      DefTimeoutNode Timeout -> Timeout
_ 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