sydtest 0.22.0.0 → 0.23.0.0

raw patch · 12 files changed

+1004/−761 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• src/Test/Syd/OptParse.hs +159/−66
• src/Test/Syd/Output.hs +21/−617
• src/Test/Syd/Output/Common.hs +267/−0
• src/Test/Syd/Output/Pretty.hs +379/−0
• src/Test/Syd/Output/Terse.hs +98/−0
• src/Test/Syd/Run.hs +25/−25
• src/Test/Syd/Runner.hs +2/−22
• src/Test/Syd/Runner/Asynchronous.hs +19/−16
• src/Test/Syd/Runner/Synchronous/Interleaved.hs +4/−3
• src/Test/Syd/Runner/Synchronous/Separate.hs +12/−11
• sydtest.cabal +4/−1

@@ -1,5 +1,19 @@ # Changelog +## [0.23.0.0] - 2026-01-26++### Added++* Terse output format+* AI-executor detection++### Changed++* Simplified outputting code.++This is technically a breaking change, but if you are not using the sydtest+output code directly, it should not break anything for you.+ ## [0.22.0.0] - 2025-09-28  ### Changed

@@ -5,13 +5,19 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Test.Syd.OptParse where  import Autodocodec import Control.Applicative+import Control.Concurrent (getNumCapabilities)+import Control.Monad+import Control.Monad.IO.Class+import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe import Data.Text (Text)+import qualified Data.Text.IO as TIO import GHC.Generics (Generic) import OptEnvConf import Path@@ -22,7 +28,6 @@  #ifdef mingw32_HOST_OS import System.Console.ANSI (hSupportsANSIColor)-import System.IO (stdout) #else import Text.Colour.Capabilities.FromEnv #endif@@ -50,8 +55,8 @@     settingGoldenStart :: !Bool,     -- | Whether to overwrite golden tests instead of having them fail     settingGoldenReset :: !Bool,-    -- | Whether to use colour in the output, 'Nothing' means "detect"-    settingColour :: !(Maybe Bool),+    -- | Whether to use colour in the output+    settingTerminalCapabilities :: !TerminalCapabilities,     -- | The filters to use to select which tests to run     settingFilters :: ![Text],     -- | Whether to stop upon the first test failure@@ -71,18 +76,43 @@     -- | How to report progress     settingReportProgress :: !ReportProgress,     -- | Profiling mode-    settingProfile :: !Bool+    settingProfile :: !Bool,+    -- | Output format+    settingOutputFormat :: !OutputFormat   }   deriving (Show, Eq, Generic) +-- | Output format for test results+data OutputFormat+  = -- | Pretty output with colors, unicode symbols, and detailed formatting+    OutputFormatPretty+  | -- | Terse output optimized for machine/AI consumption+    OutputFormatTerse+  deriving (Show, Eq, Generic, Enum, Bounded)++instance HasCodec OutputFormat where+  codec =+    stringConstCodec $+      (OutputFormatPretty, "pretty")+        :| [(OutputFormatTerse, "terse")]+ instance HasParser Settings where   settingsParser =     subEnv_ "sydtest" $       withConfigurableYamlConfig (runIO $ resolveFile' ".sydtest.yaml") $-        checkMapEither combine settingsParser+        checkMapIO combine settingsParser     where+      combine :: Flags -> IO (Either String Settings)       combine Flags {..} = do-        let d func = func defaultSettings+        let d :: forall a. (Settings -> a) -> a+            d func = func defaultSettings+        terminalCapabilities <- case flagColour of+          Just False -> pure WithoutColours+          Just True -> pure With8BitColours+          Nothing -> case flagAiExecutor of+            Just True -> pure WithoutColours+            _ -> detectTerminalCapabilities+         let threads =               fromMaybe                 ( if flagDebug@@ -90,61 +120,90 @@                     else d settingThreads                 )                 flagThreads-        progress <- case flagReportProgress of+        case threads of+          ByCapabilities -> do+            i <- getNumCapabilities++            when (i == 1) $ do+              let outputLine :: [Chunk] -> IO ()+                  outputLine lineChunks = liftIO $ do+                    putChunksLocaleWith terminalCapabilities lineChunks+                    TIO.putStrLn ""+              mapM_+                ( outputLine+                    . (: [])+                    . fore red+                )+                [ chunk "WARNING: Only one CPU core detected, make sure to compile your test suite with these ghc options:",+                  chunk "         -threaded -rtsopts -with-rtsopts=-N",+                  chunk "         (This is important for correctness as well as speed, as a parallel test suite can find thread safety problems.)"+                ]+          _ -> pure ()+        errOrProgress <- case flagReportProgress of           Nothing ->             pure $-              if threads == Synchronous-                then-                  if flagDebug-                    then ReportProgress-                    else d settingReportProgress-                else d settingReportProgress+              Right $+                if threads == Synchronous+                  then+                    if flagDebug+                      then ReportProgress+                      else d settingReportProgress+                  else d settingReportProgress+          Just ReportNoProgress -> pure $ Right ReportNoProgress           Just ReportProgress ->             if threads /= Synchronous-              then Left "Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."-              else pure ReportProgress-          Just ReportNoProgress -> pure ReportNoProgress-        pure-          Settings-            { settingSeed = flagSeed,-              settingRandomiseExecutionOrder =-                fromMaybe-                  ( if flagDebug-                      then False-                      else d settingRandomiseExecutionOrder-                  )-                  flagRandomiseExecutionOrder,-              settingThreads = threads,-              settingMaxSuccess = flagMaxSuccess,-              settingMaxSize = flagMaxSize,-              settingMaxDiscard = flagMaxDiscard,-              settingMaxShrinks = flagMaxShrinks,-              settingGoldenStart = flagGoldenStart,-              settingGoldenReset = flagGoldenReset,-              settingColour = flagColour,-              settingFilters = flagFilters,-              settingFailFast =-                fromMaybe-                  ( if flagDebug-                      then True-                      else d settingFailFast-                  )-                  flagFailFast,-              settingIterations = flagIterations,-              settingTimeout = flagTimeout,-              settingRetries =-                fromMaybe-                  ( if flagDebug-                      then 0-                      else d settingRetries-                  )-                  flagRetries,-              settingFailOnFlaky = flagFailOnFlaky,-              settingSkipPassed = flagSkipPassed,-              settingReportFile = flagReportFile,-              settingReportProgress = progress,-              settingProfile = flagProfile-            }+              then pure $ Left "Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."+              else pure $ Right ReportProgress+        forM errOrProgress $ \progress -> do+          pure $+            Settings+              { settingSeed = flagSeed,+                settingRandomiseExecutionOrder =+                  fromMaybe+                    ( if flagDebug+                        then False+                        else d settingRandomiseExecutionOrder+                    )+                    flagRandomiseExecutionOrder,+                settingThreads = threads,+                settingMaxSuccess = flagMaxSuccess,+                settingMaxSize = flagMaxSize,+                settingMaxDiscard = flagMaxDiscard,+                settingMaxShrinks = flagMaxShrinks,+                settingGoldenStart = flagGoldenStart,+                settingGoldenReset = flagGoldenReset,+                settingTerminalCapabilities = terminalCapabilities,+                settingFilters = flagFilters,+                settingFailFast =+                  fromMaybe+                    ( if flagDebug+                        then True+                        else d settingFailFast+                    )+                    flagFailFast,+                settingIterations = flagIterations,+                settingTimeout = flagTimeout,+                settingRetries =+                  fromMaybe+                    ( if flagDebug+                        then 0+                        else d settingRetries+                    )+                    flagRetries,+                settingFailOnFlaky = flagFailOnFlaky,+                settingSkipPassed = flagSkipPassed,+                settingReportFile = flagReportFile,+                settingReportProgress = progress,+                settingProfile = flagProfile,+                settingOutputFormat =+                  fromMaybe+                    ( case flagAiExecutor of+                        Nothing -> OutputFormatPretty+                        Just False -> OutputFormatPretty+                        Just True -> OutputFormatTerse+                    )+                    flagOutputFormat+              }  defaultSettings :: Settings defaultSettings =@@ -159,7 +218,7 @@           settingMaxShrinks = d testRunSettingMaxShrinks,           settingGoldenStart = d testRunSettingGoldenStart,           settingGoldenReset = d testRunSettingGoldenReset,-          settingColour = Nothing,+          settingTerminalCapabilities = With8BitColours,           settingFilters = mempty,           settingFailFast = False,           settingIterations = OneIteration,@@ -169,7 +228,8 @@           settingSkipPassed = False,           settingReportProgress = ReportNoProgress,           settingReportFile = Nothing,-          settingProfile = False+          settingProfile = False,+          settingOutputFormat = OutputFormatPretty         }  -- 60 seconds@@ -179,12 +239,6 @@ defaultRetries :: Word defaultRetries = 3 -deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities-deriveTerminalCapababilities settings = case settingColour settings of-  Just False -> pure WithoutColours-  Just True -> pure With8BitColours-  Nothing -> detectTerminalCapabilities- #ifdef mingw32_HOST_OS detectTerminalCapabilities :: IO TerminalCapabilities detectTerminalCapabilities = do@@ -196,6 +250,7 @@ detectTerminalCapabilities :: IO TerminalCapabilities detectTerminalCapabilities = getTerminalCapabilitiesFromEnv #endif+ -- We use an intermediate 'Flags' type so that default values can change based -- on parse settings. For example, the default value for 'flagThreads' depends -- on the value of 'flagDebug'.@@ -220,7 +275,9 @@     flagReportFile :: !(Maybe (Path Abs File)),     flagReportProgress :: !(Maybe ReportProgress),     flagDebug :: !Bool,-    flagProfile :: !Bool+    flagProfile :: !Bool,+    flagAiExecutor :: !(Maybe Bool),+    flagOutputFormat :: !(Maybe OutputFormat)   }   deriving (Show, Eq, Generic) @@ -358,6 +415,42 @@           name "profile",           value $ settingProfile defaultSettings         ]+    flagAiExecutor <-+      optional $+        choice+          [ setting+              [ help "Indicate that an AI is executing tests, sets defaults to 'no colours' and 'terse output'",+                switch True,+                long "ai-executor"+              ],+            setting+              [ help "Turn off ai mode. This lets AIs opt out of ai-executor mode",+                switch False,+                long "no-ai-executor"+              ],+            setting+              [ help "Activate AI executor mode based on env vars",+                reader exists,+                -- Feel free to add env vars here.+                env "CLAUDECODE",+                metavar "ANY"+              ]+          ]++    flagOutputFormat <-+      optional $+        choice+          [ setting+              [ help "Use terse output (compact, no colors, failures only)",+                switch OutputFormatTerse,+                long "terse"+              ],+            setting+              [ help "Use pretty output (colors, unicode, detailed formatting)",+                switch OutputFormatPretty,+                long "pretty"+              ]+          ]     pure Flags {..}  data Timeout

@@ -1,625 +1,29 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}+module Test.Syd.Output+  ( -- * Main dispatch function+    printOutputSpecForest, -module Test.Syd.Output where+    -- * Re-exports+    module Test.Syd.Output.Common,+    module Test.Syd.Output.Pretty,+    module Test.Syd.Output.Terse,+  )+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.Output.Common+import Test.Syd.Output.Pretty+import Test.Syd.Output.Terse+import Test.Syd.Run (Timed) import Test.Syd.SpecDef-import Test.Syd.SpecForest-import Text.Colour-import Text.Printf  printOutputSpecForest :: Settings -> Timed ResultForest -> IO ()-printOutputSpecForest settings results = do-  tc <- deriveTerminalCapababilities settings-  LTIO.putStr $ LTB.toLazyText $ renderResultReport settings tc results--renderResultReport :: Settings -> TerminalCapabilities -> Timed ResultForest -> Text.Builder-renderResultReport settings tc rf =-  mconcat $-    map-      (\line -> renderChunksBuilder tc line <> "\n")-      (outputResultReport settings rf)--outputResultReport :: Settings -> Timed ResultForest -> [[Chunk]]-outputResultReport settings trf =-  let rf = timedValue trf-   in concat-        [ outputTestsHeader,-          outputSpecForest settings 0 (resultForestWidth rf) rf,-          [ [chunk ""],-            [chunk ""]-          ],-          outputFailuresWithHeading settings rf,-          [[chunk ""]],-          outputStats (computeTestSuiteStats settings <$> trf),-          [[chunk ""]],-          if settingProfile settings-            then outputProfilingInfo trf-            else []-        ]--outputFailuresHeader :: [[Chunk]]-outputFailuresHeader = outputHeader "Failures:"--outputFailuresWithHeading :: Settings -> ResultForest -> [[Chunk]]-outputFailuresWithHeading settings rf =-  if anyFailedTests settings rf-    then-      concat-        [ outputFailuresHeader,-          outputFailures settings rf-        ]-    else []--outputStats :: Timed TestSuiteStats -> [[Chunk]]-outputStats timed =-  let TestSuiteStats {..} = timedValue timed-      sumTimeSeconds :: Double-      sumTimeSeconds = fromIntegral testSuiteStatSumTime / 1_000_000_000-      totalTimeSeconds :: Double-      totalTimeSeconds = fromIntegral (timedTime timed) / 1_000_000_000-   in map (padding :) $-        concat-          [ [ [ chunk "Examples:                     ",-                fore green $ chunk (T.pack (show testSuiteStatExamples))-              ]-              | testSuiteStatExamples /= testSuiteStatSuccesses-            ],-            [ [ chunk "Passed:                       ",-                ( if testSuiteStatSuccesses <= 0-                    then fore red-                    else fore green-                )-                  $ chunk (T.pack (show testSuiteStatSuccesses))-              ],-              [ chunk "Failed:                       ",-                ( if testSuiteStatFailures > 0-                    then fore red-                    else fore green-                )-                  $ chunk (T.pack (show testSuiteStatFailures))-              ]-            ],-            [ [ chunk "Flaky:                        ",-                fore red $ chunk (T.pack (show testSuiteStatFlakyTests))-              ]-              | testSuiteStatFlakyTests > 0-            ],-            [ [ chunk "Pending:                      ",-                fore magenta $ chunk (T.pack (show testSuiteStatPending))-              ]-              | testSuiteStatPending > 0-            ],-            [ [ chunk "Sum of test runtimes:",-                fore yellow $ chunk $ T.pack (printf "%13.2f seconds" sumTimeSeconds)-              ],-              [ chunk "Test suite took:     ",-                fore yellow $ chunk $ T.pack (printf "%13.2f seconds" totalTimeSeconds)-              ]-            ]-          ]--outputProfilingInfo :: Timed ResultForest -> [[Chunk]]-outputProfilingInfo Timed {..} =-  map-    ( \(path, nanos) ->-        [ timeChunkFor nanos,-          " ",-          chunk $ T.intercalate "." path-        ]-    )-    ( sortOn-        snd-        ( map-            (second (timedTime . testDefVal))-            (flattenSpecForest timedValue)-        )-    )--outputTestsHeader :: [[Chunk]]-outputTestsHeader = outputHeader "Tests:"--outputHeader :: Text -> [[Chunk]]-outputHeader t =-  [ [fore blue $ chunk t],-    [chunk ""]-  ]--outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]-outputSpecForest settings level treeWidth = concatMap (outputSpecTree settings level treeWidth)--outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]-outputSpecTree settings level treeWidth = \case-  SpecifyNode t td -> outputSpecifyLines settings level treeWidth t td-  PendingNode t mr -> outputPendingLines t mr-  DescribeNode t sf -> outputDescribeLine t : map (padding :) (outputSpecForest settings (level + 1) treeWidth sf)-  SubForestNode sf -> outputSpecForest settings level treeWidth sf--outputDescribeLine :: Text -> [Chunk]-outputDescribeLine t = [fore yellow $ chunk t]--outputSpecifyLines :: Settings -> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]-outputSpecifyLines settings level treeWidth specifyText (TDef timed _) =-  let testRunReport = timedValue timed-      executionTime = timedTime timed-      status = testRunReportStatus settings testRunReport-      TestRunResult {..} = testRunReportReportedRun testRunReport-      withStatusColour = fore (statusColour status)-      pad = (chunk (T.pack (replicate paddingSize ' ')) :)-      timeChunk = timeChunkFor executionTime-   in concatMap-        (filter (not . null))-        [ [ [ withStatusColour $ chunk (statusCheckMark status),-              withStatusColour $ chunk specifyText,-              spacingChunk level specifyText (chunkText timeChunk) treeWidth,-              timeChunk-            ]-          ],-          map pad $ retriesChunks testRunReport,-          [ pad-              [ chunk "passed for all of ",-                case w of-                  0 -> fore red $ chunk "0"-                  _ -> fore green $ chunk (T.pack (printf "%d" w)),-                " inputs."-              ]-            | status == TestPassed,-              w <- maybeToList testRunResultNumTests-          ],-          map pad $ labelsChunks (fromMaybe 1 testRunResultNumTests) testRunResultLabels,-          map pad $ classesChunks testRunResultClasses,-          map pad $ tablesChunks testRunResultTables,-          [pad $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase]-        ]--exampleNrChunk :: Word -> Word -> Chunk-exampleNrChunk total current =-  let digits :: Word-      digits = max 2 $ succ $ floor $ logBase 10 $ (fromIntegral :: Word -> Double) total-      formatStr = "%" <> show digits <> "d"-   in chunk $ T.pack $ printf formatStr current--timeChunkFor :: Word64 -> Chunk-timeChunkFor executionTime =-  let t = fromIntegral executionTime / 1_000_000 :: Double -- milliseconds-      executionTimeText = T.pack (printf "%10.2f ms" t)-      withTimingColour =-        if-          | t < 10 -> fore green-          | t < 100 -> fore yellow-          | t < 1_000 -> fore orange-          | t < 10_000 -> fore red-          | otherwise -> fore darkRed-   in withTimingColour $ chunk executionTimeText--retriesChunks :: TestRunReport -> [[Chunk]]-retriesChunks testRunReport =-  case testRunReportRetries testRunReport of-    Nothing -> []-    Just retries ->-      let flaky = testRunReportWasFlaky testRunReport-          mMessage = case testRunReportFlakinessMode testRunReport of-            MayBeFlaky mmesg -> mmesg-            MayNotBeFlaky -> Nothing-       in if flaky-            then-              concat-                [ [["Retries: ", chunk (T.pack (show retries)), fore red " !!! FLAKY !!!"]],-                  [[fore magenta $ chunk $ T.pack message] | message <- maybeToList mMessage]-                ]-            else [["Retries: ", chunk (T.pack (show retries)), " (does not look flaky)"]]--labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]-labelsChunks _ Nothing = []-labelsChunks totalCount (Just labels)-  | M.null labels = []-  | map fst (M.toList labels) == [[]] = []-  | otherwise =-      [chunk "Labels"]-        : map-          ( pad-              . ( \(ss, i) ->-                    [ chunk-                        ( T.pack-                            ( printf-                                "%5.2f%% %s"-                                (100 * fromIntegral i / fromIntegral totalCount :: Double)-                                (commaList (map show ss))-                            )-                        )-                    ]-                )-          )-          (M.toList labels)-  where-    pad = (chunk (T.pack (replicate paddingSize ' ')) :)--classesChunks :: Maybe (Map String Int) -> [[Chunk]]-classesChunks Nothing = []-classesChunks (Just classes)-  | M.null classes = []-  | otherwise =-      [chunk "Classes"]-        : map-          ( pad-              . ( \(s, i) ->-                    [ chunk-                        ( T.pack-                            ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) s-                            )-                        )-                    ]-                )-          )-          (M.toList classes)-  where-    pad = (chunk (T.pack (replicate paddingSize ' ')) :)-    total = sum $ map snd $ M.toList classes--tablesChunks :: Maybe (Map String (Map String Int)) -> [[Chunk]]-tablesChunks Nothing = []-tablesChunks (Just tables) = concatMap (uncurry goTable) $ M.toList tables-  where-    goTable :: String -> Map String Int -> [[Chunk]]-    goTable tableName percentages =-      [chunk " "]-        : [chunk (T.pack tableName)]-        : map-          ( pad-              . ( \(s, i) ->-                    [ chunk-                        ( T.pack-                            ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) s-                            )-                        )-                    ]-                )-          )-          (M.toList percentages)-      where-        pad = (chunk (T.pack (replicate paddingSize ' ')) :)-        total = sum $ map snd $ M.toList percentages--outputPendingLines :: Text -> Maybe Text -> [[Chunk]]-outputPendingLines specifyText mReason =-  filter-    (not . null)-    [ [fore magenta $ chunk specifyText],-      case mReason of-        Nothing -> []-        Just reason -> [padding, chunk reason]-    ]--outputFailureLabels :: Maybe (Map [String] Int) -> [[Chunk]]-outputFailureLabels Nothing = []-outputFailureLabels (Just labels)-  | labels == M.singleton [] 1 = []-  | otherwise = [["Labels: ", chunk (T.pack (commaList (map show (concat $ M.keys labels))))]]--commaList :: [String] -> String-commaList [] = []-commaList [s] = s-commaList (s1 : rest) = s1 ++ ", " ++ commaList rest--outputFailureClasses :: Maybe (Map String Int) -> [[Chunk]]-outputFailureClasses Nothing = []-outputFailureClasses (Just classes)-  | M.null classes = []-  | otherwise = [["Class: ", chunk (T.pack (commaList (M.keys classes)))]]--outputGoldenCase :: GoldenCase -> [Chunk]-outputGoldenCase = \case-  GoldenNotFound -> [fore red $ chunk "Golden output not found"]-  GoldenStarted -> [fore cyan $ chunk "Golden output created"]-  GoldenReset -> [fore cyan $ chunk "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 level descriptionText executionTimeText treeWidth = chunk $ T.pack $ replicate paddingWidth ' '-  where-    paddingWidth =-      let preferredMaxWidth = 80-          checkmarkWidth = 2-          minimumSpacing = 1-          actualDescriptionWidth = T.length descriptionText-          actualTimingWidth = T.length executionTimeText-          totalNecessaryWidth = treeWidth + checkmarkWidth + minimumSpacing + actualTimingWidth -- All timings are the same width-          actualMaxWidth = max totalNecessaryWidth preferredMaxWidth-       in actualMaxWidth - paddingSize * level - actualTimingWidth - actualDescriptionWidth--outputFailures :: Settings -> ResultForest -> [[Chunk]]-outputFailures settings rf =-  let failures = filter (testRunReportFailed settings . timedValue . testDefVal . snd) $ flattenSpecForest rf-      nbDigitsInFailureCount :: Int-      nbDigitsInFailureCount = floor (logBase 10 (L.genericLength failures) :: Double)-      padFailureDetails = (chunk (T.pack (replicate (nbDigitsInFailureCount + 4) ' ')) :)-   in map (padding :) $-        concatMap (filter (not . null)) $-          indexed failures $ \w (ts, TDef timed cs) ->-            let testRunReport = timedValue timed-                status = testRunReportStatus settings testRunReport-                TestRunResult {..} = testRunReportReportedRun testRunReport-             in concat-                  [ [ [ fore cyan $-                          chunk $-                            T.pack $-                              replicate 2 ' '-                                ++ case headMay $ getCallStack cs of-                                  Nothing -> "Unknown location"-                                  Just (_, SrcLoc {..}) ->-                                    concat-                                      [ srcLocFile,-                                        ":",-                                        show srcLocStartLine-                                      ]-                      ],-                      map-                        (fore (statusColour status))-                        [ chunk $ statusCheckMark status,-                          chunk $ T.pack (printf ("%" ++ show nbDigitsInFailureCount ++ "d ") w),-                          chunk $ T.intercalate "." ts-                        ]-                    ],-                    map padFailureDetails $ retriesChunks testRunReport,-                    map (padFailureDetails . (: []) . chunk . T.pack) $-                      case (testRunResultNumTests, testRunResultNumShrinks) of-                        (Nothing, _) -> []-                        (Just numTests, Nothing) -> [printf "Failed after %d tests" numTests]-                        (Just numTests, Just 0) -> [printf "Failed after %d tests" numTests]-                        (Just numTests, Just numShrinks) -> [printf "Failed after %d tests and %d shrinks" numTests numShrinks],-                    map (padFailureDetails . (\c -> [chunk "Generated: ", c]) . fore yellow . chunk . T.pack) testRunResultFailingInputs,-                    map padFailureDetails $ outputFailureLabels testRunResultLabels,-                    map padFailureDetails $ outputFailureClasses testRunResultClasses,-                    map padFailureDetails $ maybe [] outputSomeException testRunResultException,-                    [padFailureDetails $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase],-                    concat [map padFailureDetails $ stringChunks ei | ei <- maybeToList testRunResultExtraInfo],-                    [[chunk ""]]-                  ]--outputSomeException :: SomeException -> [[Chunk]]-outputSomeException outerException =-  case fromException outerException :: Maybe Contextual of-    Just (Contextual innerException s) -> outputSomeException (SomeException innerException) ++ stringChunks s-    Nothing ->-      case fromException outerException :: Maybe Assertion of-        Just a -> outputAssertion a-        Nothing -> stringChunks $ displayException outerException--outputAssertion :: Assertion -> [[Chunk]]-outputAssertion = \case-  NotEqualButShouldHaveBeenEqualWithDiff actual expected diffM -> outputEqualityAssertionFailed actual expected diffM-  EqualButShouldNotHaveBeenEqual actual notExpected -> outputNotEqualAssertionFailed actual notExpected-  PredicateFailedButShouldHaveSucceeded actual mName -> outputPredicateSuccessAssertionFailed actual mName-  PredicateSucceededButShouldHaveFailed actual mName -> outputPredicateFailAssertionFailed actual mName-  ExpectationFailed s -> stringChunks s-  Context a' context -> outputAssertion a' ++ stringChunks 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 =-  -- 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.-  go ([] :| []) -- Start with an empty current line.-  where-    -- CurrentlyTraversingLines -> ChunksToStillSplit -> SplitChunks-    go :: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]-    go cls cs = case NE.uncons cls of-      (currentLine, mRest) -> case 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.-        Nothing -> case cs of-          -- If there is only one current line, and no more chunks, it's the last line.-          [] -> [currentLine]-          -- If there are chunks left, split the first one into lines.-          (c : rest) -> case T.splitOn "\n" (chunkText c) of-            -- Should not happen, but would be fine, just skip this chunk-            [] -> go cls rest-            -- If the chunk had more than one lines-            (l : ls) -> case NE.nonEmpty ls of-              -- If there was only one line in the chunk, we continue with the-              -- same current line onto the rest of the chunks-              Nothing -> go ((currentLine <> [c {chunkText = l}]) :| []) 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 ne -> (currentLine <> [c {chunkText = l}]) : go (NE.map (\l' -> [c {chunkText = l'}]) ne) rest-        -- If there is more than one current line, all but the last one are considered finished.-        -- We skip them one by one.-        Just ne -> currentLine : go ne cs--outputEqualityAssertionFailed :: String -> String -> Maybe [PolyDiff Text Text] -> [[Chunk]]-outputEqualityAssertionFailed actual expected diffM =-  case diffM of-    Just diff -> formatDiff actual expected diff-    Nothing ->-      concat-        [ [[chunk "Expected these values to be equal:"]],-          [[chunk "Diff computation took too long and was canceled"]],-          [[fromString actual]],-          [[fromString expected]]-        ]--formatDiff :: String -> String -> [PolyDiff Text Text] -> [[Chunk]]-formatDiff actual expected diff =-  let -- Add a header to a list of lines of chunks-      chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]-      chunksLinesWithHeader header = \case-        -- If there is only one line, put the header on that line.-        [cs] -> [header : cs]-        -- If there is more than one line, put the header on a separate line before-        cs -> [header] : cs--      -- If it's only whitespace, change the background, otherwise change the foreground-      foreOrBack :: Colour -> Text -> Chunk-      foreOrBack c t =-        (if T.null (T.strip t) then back c else fore c)-          (chunk t)-      actualChunks :: [[Chunk]]-      actualChunks = chunksLinesWithHeader (fore blue "Actual:   ") $-        splitChunksIntoLines $-          flip mapMaybe diff $ \case-            First t -> Just $ foreOrBack red t-            Second _ -> Nothing-            Both t _ -> Just $ chunk t-      expectedChunks :: [[Chunk]]-      expectedChunks = chunksLinesWithHeader (fore blue "Expected: ") $-        splitChunksIntoLines $-          flip mapMaybe diff $ \case-            First _ -> Nothing-            Second t -> Just $ foreOrBack green t-            Both t _ -> Just $ chunk t-      inlineDiffChunks :: [[Chunk]]-      inlineDiffChunks =-        if length (lines actual) == 1 && length (lines expected) == 1-          then []-          else chunksLinesWithHeader (fore blue "Inline diff: ") $-            splitChunksIntoLines $-              flip map diff $ \case-                First t -> foreOrBack red t-                Second t -> foreOrBack green t-                Both t _ -> chunk t-   in concat-        [ [[chunk "Expected these values to be equal:"]],-          actualChunks,-          expectedChunks,-          inlineDiffChunks-        ]--outputNotEqualAssertionFailed :: String -> String -> [[Chunk]]-outputNotEqualAssertionFailed actual notExpected =-  if actual == notExpected -- String equality-    then-      [ [chunk "Did not expect equality of the values but both were:"],-        [chunk (T.pack actual)]-      ]-    else-      [ [chunk "These two values were considered equal but should not have been equal:"],-        [fore blue "Actual      : ", chunk (T.pack actual)],-        [fore blue "Not Expected: ", chunk (T.pack notExpected)]-      ]--outputPredicateSuccessAssertionFailed :: String -> Maybe String -> [[Chunk]]-outputPredicateSuccessAssertionFailed actual mName =-  concat-    [ [ [chunk "Predicate failed, but should have succeeded, on this value:"],-        [chunk (T.pack actual)]-      ],-      concat [map (chunk "Predicate: " :) (stringChunks name) | name <- maybeToList mName]-    ]--outputPredicateFailAssertionFailed :: String -> Maybe String -> [[Chunk]]-outputPredicateFailAssertionFailed actual mName =-  concat-    [ [ [chunk "Predicate succeeded, but should have failed, on this value:"],-        [chunk (T.pack actual)]-      ],-      concat [map (chunk "Predicate: " :) (stringChunks name) | name <- maybeToList mName]-    ]--mContextChunks :: Maybe String -> [[Chunk]]-mContextChunks = maybe [] stringChunks--stringChunks :: String -> [[Chunk]]-stringChunks s =-  let ls = lines s-   in map ((: []) . chunk . T.pack) ls--indexed :: [a] -> (Word -> a -> b) -> [b]-indexed ls func = zipWith func [1 ..] ls--statusColour :: TestStatus -> Colour-statusColour = \case-  TestPassed -> green-  TestFailed -> red--statusCheckMark :: TestStatus -> Text-statusCheckMark = \case-  TestPassed -> "\10003 "-  TestFailed -> "\10007 "--resultForestWidth :: SpecForest a -> Int-resultForestWidth = goF 0-  where-    goF :: Int -> SpecForest a -> Int-    goF level = maximum . map (goT level)-    goT :: Int -> SpecTree a -> Int-    goT level = \case-      SpecifyNode t _ -> T.length t + level * paddingSize-      PendingNode t _ -> T.length t + level * paddingSize-      DescribeNode _ sdf -> goF (succ level) sdf-      SubForestNode sdf -> goF level sdf--specForestWidth :: SpecDefForest a b c -> Int-specForestWidth = goF 0-  where-    goF :: Int -> SpecDefForest a b c -> Int-    goF level = \case-      [] -> 0-      ts -> maximum $ map (goT level) ts-    goT :: Int -> SpecDefTree a b c -> Int-    goT level = \case-      DefSpecifyNode t _ _ -> T.length t + level * paddingSize-      DefPendingNode t _ -> T.length t + level * paddingSize-      DefDescribeNode _ sdf -> goF (succ level) sdf-      DefSetupNode _ sdf -> goF level sdf-      DefBeforeAllNode _ sdf -> goF level sdf-      DefBeforeAllWithNode _ sdf -> goF level sdf-      DefWrapNode _ sdf -> goF level sdf-      DefAroundAllNode _ sdf -> goF level sdf-      DefAroundAllWithNode _ sdf -> goF level sdf-      DefAfterAllNode _ sdf -> goF level sdf-      DefParallelismNode _ sdf -> goF level sdf-      DefTimeoutNode _ sdf -> goF level sdf-      DefRetriesNode _ sdf -> goF level sdf-      DefRandomisationNode _ sdf -> goF level sdf-      DefFlakinessNode _ sdf -> goF level sdf-      DefExpectationNode _ sdf -> goF level sdf--padding :: Chunk-padding = chunk $ T.replicate paddingSize " "--paddingSize :: Int-paddingSize = 2--orange :: Colour-orange = colour256 166--darkRed :: Colour-darkRed = colour256 160+printOutputSpecForest settings results =+  LTIO.putStr $+    LTB.toLazyText $+      let renderer =+            case settingOutputFormat settings of+              OutputFormatTerse -> renderTerseSummary+              OutputFormatPretty -> renderPrettyReport+       in renderer settings results

@@ -0,0 +1,267 @@+{-# 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 $ T.replicate paddingSize " "++paddingSize :: Int+paddingSize = 2++orange :: Colour+orange = colour256 166++darkRed :: Colour+darkRed = colour256 160++statusColour :: TestStatus -> Colour+statusColour = \case+  TestPassed -> green+  TestFailed -> red++statusCheckMark :: TestStatus -> Text+statusCheckMark = \case+  TestPassed -> "\10003 "+  TestFailed -> "\10007 "++timeChunkFor :: Word64 -> Chunk+timeChunkFor executionTime =+  let t = fromIntegral executionTime / 1_000_000 :: Double -- milliseconds+      executionTimeText = T.pack (printf "%10.2f ms" t)+      withTimingColour =+        if+          | t < 10 -> fore green+          | t < 100 -> fore yellow+          | t < 1_000 -> fore orange+          | t < 10_000 -> fore red+          | otherwise -> fore darkRed+   in withTimingColour $ chunk executionTimeText++stringChunks :: String -> [[Chunk]]+stringChunks s =+  let ls = lines s+   in map ((: []) . chunk . T.pack) ls++indexed :: [a] -> (Word -> a -> b) -> [b]+indexed ls func = zipWith func [1 ..] ls++commaList :: [String] -> String+commaList [] = []+commaList [s] = s+commaList (s1 : rest) = s1 ++ ", " ++ commaList rest++mContextChunks :: Maybe String -> [[Chunk]]+mContextChunks = maybe [] stringChunks++outputSomeException :: SomeException -> [[Chunk]]+outputSomeException outerException =+  case fromException outerException :: Maybe Contextual of+    Just (Contextual innerException s) ->+      -- Check if innerException is already a SomeException to avoid double-wrapping+      let innerSE = case cast innerException of+            Just se -> se :: SomeException+            Nothing -> SomeException innerException+       in outputSomeException innerSE ++ stringChunks s+    Nothing ->+      case fromException outerException :: Maybe Assertion of+        Just a -> outputAssertion a+        Nothing -> stringChunks $ displayException outerException++outputAssertion :: Assertion -> [[Chunk]]+outputAssertion = \case+  NotEqualButShouldHaveBeenEqualWithDiff actual expected diffM -> outputEqualityAssertionFailed actual expected diffM+  EqualButShouldNotHaveBeenEqual actual notExpected -> outputNotEqualAssertionFailed actual notExpected+  PredicateFailedButShouldHaveSucceeded actual mName -> outputPredicateSuccessAssertionFailed actual mName+  PredicateSucceededButShouldHaveFailed actual mName -> outputPredicateFailAssertionFailed actual mName+  ExpectationFailed s -> stringChunks s+  Context a' context -> outputAssertion a' ++ stringChunks 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 =+  -- 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.+  go ([] :| []) -- Start with an empty current line.+  where+    -- CurrentlyTraversingLines -> ChunksToStillSplit -> SplitChunks+    go :: NonEmpty [Chunk] -> [Chunk] -> [[Chunk]]+    go cls cs = case NE.uncons cls of+      (currentLine, mRest) -> case 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.+        Nothing -> case cs of+          -- If there is only one current line, and no more chunks, it's the last line.+          [] -> [currentLine]+          -- If there are chunks left, split the first one into lines.+          (c : rest) -> case T.splitOn "\n" (chunkText c) of+            -- Should not happen, but would be fine, just skip this chunk+            [] -> go cls rest+            -- If the chunk had more than one lines+            (l : ls) -> case NE.nonEmpty ls of+              -- If there was only one line in the chunk, we continue with the+              -- same current line onto the rest of the chunks+              Nothing -> go ((currentLine <> [c {chunkText = l}]) :| []) 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 ne -> (currentLine <> [c {chunkText = l}]) : go (NE.map (\l' -> [c {chunkText = l'}]) ne) rest+        -- If there is more than one current line, all but the last one are considered finished.+        -- We skip them one by one.+        Just ne -> currentLine : go ne cs++outputEqualityAssertionFailed :: String -> String -> Maybe [PolyDiff Text Text] -> [[Chunk]]+outputEqualityAssertionFailed actual expected diffM =+  case diffM of+    Just diff -> formatDiff actual expected diff+    Nothing ->+      concat+        [ [[chunk "Expected these values to be equal:"]],+          [[chunk "Diff computation took too long and was canceled"]],+          [[fromString actual]],+          [[fromString expected]]+        ]++formatDiff :: String -> String -> [PolyDiff Text Text] -> [[Chunk]]+formatDiff actual expected diff =+  let -- Add a header to a list of lines of chunks+      chunksLinesWithHeader :: Chunk -> [[Chunk]] -> [[Chunk]]+      chunksLinesWithHeader header = \case+        -- If there is only one line, put the header on that line.+        [cs] -> [header : cs]+        -- If there is more than one line, put the header on a separate line before+        cs -> [header] : cs++      -- If it's only whitespace, change the background, otherwise change the foreground+      foreOrBack :: Colour -> Text -> Chunk+      foreOrBack c t =+        (if T.null (T.strip t) then back c else fore c)+          (chunk t)+      actualChunks :: [[Chunk]]+      actualChunks = chunksLinesWithHeader (fore blue "Actual:   ") $+        splitChunksIntoLines $+          flip mapMaybe diff $ \case+            First t -> Just $ foreOrBack red t+            Second _ -> Nothing+            Both t _ -> Just $ chunk t+      expectedChunks :: [[Chunk]]+      expectedChunks = chunksLinesWithHeader (fore blue "Expected: ") $+        splitChunksIntoLines $+          flip mapMaybe diff $ \case+            First _ -> Nothing+            Second t -> Just $ foreOrBack green t+            Both t _ -> Just $ chunk t+      inlineDiffChunks :: [[Chunk]]+      inlineDiffChunks =+        if length (lines actual) == 1 && length (lines expected) == 1+          then []+          else chunksLinesWithHeader (fore blue "Inline diff: ") $+            splitChunksIntoLines $+              flip map diff $ \case+                First t -> foreOrBack red t+                Second t -> foreOrBack green t+                Both t _ -> chunk t+   in concat+        [ [[chunk "Expected these values to be equal:"]],+          actualChunks,+          expectedChunks,+          inlineDiffChunks+        ]++outputNotEqualAssertionFailed :: String -> String -> [[Chunk]]+outputNotEqualAssertionFailed actual notExpected =+  if actual == notExpected -- String equality+    then+      [ [chunk "Did not expect equality of the values but both were:"],+        [chunk (T.pack actual)]+      ]+    else+      [ [chunk "These two values were considered equal but should not have been equal:"],+        [fore blue "Actual      : ", chunk (T.pack actual)],+        [fore blue "Not Expected: ", chunk (T.pack notExpected)]+      ]++outputPredicateSuccessAssertionFailed :: String -> Maybe String -> [[Chunk]]+outputPredicateSuccessAssertionFailed actual mName =+  concat+    [ [ [chunk "Predicate failed, but should have succeeded, on this value:"],+        [chunk (T.pack actual)]+      ],+      concat [map (chunk "Predicate: " :) (stringChunks name) | name <- maybeToList mName]+    ]++outputPredicateFailAssertionFailed :: String -> Maybe String -> [[Chunk]]+outputPredicateFailAssertionFailed actual mName =+  concat+    [ [ [chunk "Predicate succeeded, but should have failed, on this value:"],+        [chunk (T.pack actual)]+      ],+      concat [map (chunk "Predicate: " :) (stringChunks name) | name <- maybeToList mName]+    ]++resultForestWidth :: SpecForest a -> Int+resultForestWidth = goF 0+  where+    goF :: Int -> SpecForest a -> Int+    goF level = maximum . map (goT level)+    goT :: Int -> SpecTree a -> Int+    goT level = \case+      SpecifyNode t _ -> T.length t + level * paddingSize+      PendingNode t _ -> T.length t + level * paddingSize+      DescribeNode _ sdf -> goF (succ level) sdf+      SubForestNode sdf -> goF level sdf++specForestWidth :: SpecDefForest a b c -> Int+specForestWidth = goF 0+  where+    goF :: Int -> SpecDefForest a b c -> Int+    goF level = \case+      [] -> 0+      ts -> maximum $ map (goT level) ts+    goT :: Int -> SpecDefTree a b c -> Int+    goT level = \case+      DefSpecifyNode t _ _ -> T.length t + level * paddingSize+      DefPendingNode t _ -> T.length t + level * paddingSize+      DefDescribeNode _ sdf -> goF (succ level) sdf+      DefSetupNode _ sdf -> goF level sdf+      DefBeforeAllNode _ sdf -> goF level sdf+      DefBeforeAllWithNode _ sdf -> goF level sdf+      DefWrapNode _ sdf -> goF level sdf+      DefAroundAllNode _ sdf -> goF level sdf+      DefAroundAllWithNode _ sdf -> goF level sdf+      DefAfterAllNode _ sdf -> goF level sdf+      DefParallelismNode _ sdf -> goF level sdf+      DefTimeoutNode _ sdf -> goF level sdf+      DefRetriesNode _ sdf -> goF level sdf+      DefRandomisationNode _ sdf -> goF level sdf+      DefFlakinessNode _ sdf -> goF level sdf+      DefExpectationNode _ sdf -> goF level sdf

@@ -0,0 +1,379 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Syd.Output.Pretty where++import Control.Arrow (second)+import Data.List (sortOn)+import qualified Data.List as L+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as Text+import GHC.Stack+import Safe+import Test.Syd.OptParse+import Test.Syd.Output.Common+import Test.Syd.Run+import Test.Syd.SpecDef+import Test.Syd.SpecForest+import Text.Colour+import Text.Printf++renderPrettyReport :: Settings -> Timed ResultForest -> Text.Builder+renderPrettyReport settings rf =+  mconcat $+    map+      (\line -> renderChunksBuilder (settingTerminalCapabilities settings) line <> "\n")+      (outputResultReport settings rf)++outputResultReport :: Settings -> Timed ResultForest -> [[Chunk]]+outputResultReport settings trf =+  let rf = timedValue trf+   in concat+        [ outputTestsHeader,+          outputSpecForest settings 0 (resultForestWidth rf) rf,+          [ [chunk ""],+            [chunk ""]+          ],+          outputPrettySummary settings trf+        ]++outputPrettySummary :: Settings -> Timed ResultForest -> [[Chunk]]+outputPrettySummary settings trf =+  let rf = timedValue trf+   in concat+        [ outputFailuresWithHeading settings rf,+          [[chunk ""]],+          outputStats (computeTestSuiteStats settings <$> trf),+          [[chunk ""]],+          if settingProfile settings+            then outputProfilingInfo trf+            else []+        ]++outputFailuresHeader :: [[Chunk]]+outputFailuresHeader = outputHeader "Failures:"++outputFailuresWithHeading :: Settings -> ResultForest -> [[Chunk]]+outputFailuresWithHeading settings rf =+  if anyFailedTests settings rf+    then+      concat+        [ outputFailuresHeader,+          outputFailures settings rf+        ]+    else []++outputStats :: Timed TestSuiteStats -> [[Chunk]]+outputStats timed =+  let TestSuiteStats {..} = timedValue timed+      sumTimeSeconds :: Double+      sumTimeSeconds = fromIntegral testSuiteStatSumTime / 1_000_000_000+      totalTimeSeconds :: Double+      totalTimeSeconds = fromIntegral (timedTime timed) / 1_000_000_000+   in map (padding :) $+        concat+          [ [ [ chunk "Examples:                     ",+                fore green $ chunk (T.pack (show testSuiteStatExamples))+              ]+              | testSuiteStatExamples /= testSuiteStatSuccesses+            ],+            [ [ chunk "Passed:                       ",+                ( if testSuiteStatSuccesses <= 0+                    then fore red+                    else fore green+                )+                  $ chunk (T.pack (show testSuiteStatSuccesses))+              ],+              [ chunk "Failed:                       ",+                ( if testSuiteStatFailures > 0+                    then fore red+                    else fore green+                )+                  $ chunk (T.pack (show testSuiteStatFailures))+              ]+            ],+            [ [ chunk "Flaky:                        ",+                fore red $ chunk (T.pack (show testSuiteStatFlakyTests))+              ]+              | testSuiteStatFlakyTests > 0+            ],+            [ [ chunk "Pending:                      ",+                fore magenta $ chunk (T.pack (show testSuiteStatPending))+              ]+              | testSuiteStatPending > 0+            ],+            [ [ chunk "Sum of test runtimes:",+                fore yellow $ chunk $ T.pack (printf "%13.2f seconds" sumTimeSeconds)+              ],+              [ chunk "Test suite took:     ",+                fore yellow $ chunk $ T.pack (printf "%13.2f seconds" totalTimeSeconds)+              ]+            ]+          ]++outputProfilingInfo :: Timed ResultForest -> [[Chunk]]+outputProfilingInfo Timed {..} =+  map+    ( \(path, nanos) ->+        [ timeChunkFor nanos,+          " ",+          chunk $ T.intercalate "." path+        ]+    )+    ( sortOn+        snd+        ( map+            (second (timedTime . testDefVal))+            (flattenSpecForest timedValue)+        )+    )++outputTestsHeader :: [[Chunk]]+outputTestsHeader = outputHeader "Tests:"++outputHeader :: Text -> [[Chunk]]+outputHeader t =+  [ [fore blue $ chunk t],+    [chunk ""]+  ]++outputSpecForest :: Settings -> Int -> Int -> ResultForest -> [[Chunk]]+outputSpecForest settings level treeWidth = concatMap (outputSpecTree settings level treeWidth)++outputSpecTree :: Settings -> Int -> Int -> ResultTree -> [[Chunk]]+outputSpecTree settings level treeWidth = \case+  SpecifyNode t td -> outputSpecifyLines settings level treeWidth t td+  PendingNode t mr -> outputPendingLines t mr+  DescribeNode t sf -> outputDescribeLine t : map (padding :) (outputSpecForest settings (level + 1) treeWidth sf)+  SubForestNode sf -> outputSpecForest settings level treeWidth sf++outputDescribeLine :: Text -> [Chunk]+outputDescribeLine t = [fore yellow $ chunk t]++outputSpecifyLines :: Settings -> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]+outputSpecifyLines settings level treeWidth specifyText (TDef timed _) =+  let testRunReport = timedValue timed+      executionTime = timedTime timed+      status = testRunReportStatus settings testRunReport+      TestRunResult {..} = testRunReportReportedRun testRunReport+      withStatusColour = fore (statusColour status)+      pad = (chunk (T.pack (replicate paddingSize ' ')) :)+      timeChunk = timeChunkFor executionTime+   in concatMap+        (filter (not . null))+        [ [ [ withStatusColour $ chunk (statusCheckMark status),+              withStatusColour $ chunk specifyText,+              spacingChunk level specifyText (chunkText timeChunk) treeWidth,+              timeChunk+            ]+          ],+          map pad $ retriesChunks testRunReport,+          [ pad+              [ chunk "passed for all of ",+                case w of+                  0 -> fore red $ chunk "0"+                  _ -> fore green $ chunk (T.pack (printf "%d" w)),+                " inputs."+              ]+            | status == TestPassed,+              w <- maybeToList testRunResultNumTests+          ],+          map pad $ labelsChunks (fromMaybe 1 testRunResultNumTests) testRunResultLabels,+          map pad $ classesChunks testRunResultClasses,+          map pad $ tablesChunks testRunResultTables,+          [pad $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase]+        ]++exampleNrChunk :: Word -> Word -> Chunk+exampleNrChunk total current =+  let digits :: Word+      digits = max 2 $ succ $ floor $ logBase 10 $ (fromIntegral :: Word -> Double) total+      formatStr = "%" <> show digits <> "d"+   in chunk $ T.pack $ printf formatStr current++retriesChunks :: TestRunReport -> [[Chunk]]+retriesChunks testRunReport =+  case testRunReportRetries testRunReport of+    Nothing -> []+    Just retries ->+      let flaky = testRunReportWasFlaky testRunReport+          mMessage = case testRunReportFlakinessMode testRunReport of+            MayBeFlaky mmesg -> mmesg+            MayNotBeFlaky -> Nothing+       in if flaky+            then+              concat+                [ [["Retries: ", chunk (T.pack (show retries)), fore red " !!! FLAKY !!!"]],+                  [[fore magenta $ chunk $ T.pack message] | message <- maybeToList mMessage]+                ]+            else [["Retries: ", chunk (T.pack (show retries)), " (does not look flaky)"]]++labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]+labelsChunks _ Nothing = []+labelsChunks totalCount (Just labels)+  | M.null labels = []+  | map fst (M.toList labels) == [[]] = []+  | otherwise =+      [chunk "Labels"]+        : map+          ( pad+              . ( \(ss, i) ->+                    [ chunk+                        ( T.pack+                            ( printf+                                "%5.2f%% %s"+                                (100 * fromIntegral i / fromIntegral totalCount :: Double)+                                (commaList (map show ss))+                            )+                        )+                    ]+                )+          )+          (M.toList labels)+  where+    pad = (chunk (T.pack (replicate paddingSize ' ')) :)++classesChunks :: Maybe (Map String Int) -> [[Chunk]]+classesChunks Nothing = []+classesChunks (Just classes)+  | M.null classes = []+  | otherwise =+      [chunk "Classes"]+        : map+          ( pad+              . ( \(s, i) ->+                    [ chunk+                        ( T.pack+                            ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) s+                            )+                        )+                    ]+                )+          )+          (M.toList classes)+  where+    pad = (chunk (T.pack (replicate paddingSize ' ')) :)+    total = sum $ map snd $ M.toList classes++tablesChunks :: Maybe (Map String (Map String Int)) -> [[Chunk]]+tablesChunks Nothing = []+tablesChunks (Just tables) = concatMap (uncurry goTable) $ M.toList tables+  where+    goTable :: String -> Map String Int -> [[Chunk]]+    goTable tableName percentages =+      [chunk " "]+        : [chunk (T.pack tableName)]+        : map+          ( pad+              . ( \(s, i) ->+                    [ chunk+                        ( T.pack+                            ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) s+                            )+                        )+                    ]+                )+          )+          (M.toList percentages)+      where+        pad = (chunk (T.pack (replicate paddingSize ' ')) :)+        total = sum $ map snd $ M.toList percentages++outputPendingLines :: Text -> Maybe Text -> [[Chunk]]+outputPendingLines specifyText mReason =+  filter+    (not . null)+    [ [fore magenta $ chunk specifyText],+      case mReason of+        Nothing -> []+        Just reason -> [padding, chunk reason]+    ]++outputFailureLabels :: Maybe (Map [String] Int) -> [[Chunk]]+outputFailureLabels Nothing = []+outputFailureLabels (Just labels)+  | labels == M.singleton [] 1 = []+  | otherwise = [["Labels: ", chunk (T.pack (commaList (map show (concat $ M.keys labels))))]]++outputFailureClasses :: Maybe (Map String Int) -> [[Chunk]]+outputFailureClasses Nothing = []+outputFailureClasses (Just classes)+  | M.null classes = []+  | otherwise = [["Class: ", chunk (T.pack (commaList (M.keys classes)))]]++outputGoldenCase :: GoldenCase -> [Chunk]+outputGoldenCase = \case+  GoldenNotFound -> [fore red $ chunk "Golden output not found"]+  GoldenStarted -> [fore cyan $ chunk "Golden output created"]+  GoldenReset -> [fore cyan $ chunk "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 level descriptionText executionTimeText treeWidth = chunk $ T.pack $ replicate paddingWidth ' '+  where+    paddingWidth =+      let preferredMaxWidth = 80+          checkmarkWidth = 2+          minimumSpacing = 1+          actualDescriptionWidth = T.length descriptionText+          actualTimingWidth = T.length executionTimeText+          totalNecessaryWidth = treeWidth + checkmarkWidth + minimumSpacing + actualTimingWidth -- All timings are the same width+          actualMaxWidth = max totalNecessaryWidth preferredMaxWidth+       in actualMaxWidth - paddingSize * level - actualTimingWidth - actualDescriptionWidth++outputFailures :: Settings -> ResultForest -> [[Chunk]]+outputFailures settings rf =+  let failures = filter (testRunReportFailed settings . timedValue . testDefVal . snd) $ flattenSpecForest rf+      nbDigitsInFailureCount :: Int+      nbDigitsInFailureCount = floor (logBase 10 (L.genericLength failures) :: Double)+      padFailureDetails = (chunk (T.pack (replicate (nbDigitsInFailureCount + 4) ' ')) :)+   in map (padding :) $+        concatMap (filter (not . null)) $+          indexed failures $ \w (ts, TDef timed cs) ->+            let testRunReport = timedValue timed+                status = testRunReportStatus settings testRunReport+                TestRunResult {..} = testRunReportReportedRun testRunReport+             in concat+                  [ [ [ fore cyan $+                          chunk $+                            T.pack $+                              replicate 2 ' '+                                ++ case headMay $ getCallStack cs of+                                  Nothing -> "Unknown location"+                                  Just (_, SrcLoc {..}) ->+                                    concat+                                      [ srcLocFile,+                                        ":",+                                        show srcLocStartLine+                                      ]+                      ],+                      map+                        (fore (statusColour status))+                        [ chunk $ statusCheckMark status,+                          chunk $ T.pack (printf ("%" ++ show nbDigitsInFailureCount ++ "d ") w),+                          chunk $ T.intercalate "." ts+                        ]+                    ],+                    map padFailureDetails $ retriesChunks testRunReport,+                    map (padFailureDetails . (: []) . chunk . T.pack) $+                      case (testRunResultNumTests, testRunResultNumShrinks) of+                        (Nothing, _) -> []+                        (Just numTests, Nothing) -> [printf "Failed after %d tests" numTests]+                        (Just numTests, Just 0) -> [printf "Failed after %d tests" numTests]+                        (Just numTests, Just numShrinks) -> [printf "Failed after %d tests and %d shrinks" numTests numShrinks],+                    map (padFailureDetails . (\c -> [chunk "Generated: ", c]) . fore yellow . chunk . T.pack) testRunResultFailingInputs,+                    map padFailureDetails $ outputFailureLabels testRunResultLabels,+                    map padFailureDetails $ outputFailureClasses testRunResultClasses,+                    map padFailureDetails $ maybe [] outputSomeException testRunResultException,+                    [padFailureDetails $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase],+                    concat [map padFailureDetails $ stringChunks ei | ei <- maybeToList testRunResultExtraInfo],+                    [[chunk ""]]+                  ]

@@ -0,0 +1,98 @@+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Syd.Output.Terse where++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as Text+import GHC.Stack+import Safe+import Test.Syd.OptParse+import Test.Syd.Output.Common+import Test.Syd.Run+import Test.Syd.SpecDef+import Test.Syd.SpecForest+import Text.Colour+import Text.Printf++-- | Render a terse report+renderTerseSummary :: Settings -> Timed ResultForest -> Text.Builder+renderTerseSummary settings trf =+  mconcat $+    map+      (\line -> renderChunksBuilder (settingTerminalCapabilities settings) line <> "\n")+      (outputTerseSummary settings trf)++-- | Output the terse report as chunks.+outputTerseSummary :: Settings -> Timed ResultForest -> [[Chunk]]+outputTerseSummary settings trf =+  let rf = timedValue trf+      failures = filter (testRunReportFailed settings . timedValue . testDefVal . snd) $ flattenSpecForest rf+      stats = computeTestSuiteStats settings rf+      totalTimeSeconds = fromIntegral (timedTime trf) / 1_000_000_000 :: Double+   in concat+        [ concatMap (outputTerseFailure settings) failures,+          [outputTerseStats stats totalTimeSeconds]+        ]++-- | Output a single failure in terse format.+outputTerseFailure :: Settings -> ([Text], TDef (Timed TestRunReport)) -> [[Chunk]]+outputTerseFailure _settings (ts, TDef timed cs) =+  let testRunReport = timedValue timed+      TestRunResult {..} = testRunReportReportedRun testRunReport+      location = case headMay $ getCallStack cs of+        Nothing -> "Unknown location"+        Just (_, SrcLoc {..}) -> concat [srcLocFile, ":", show srcLocStartLine]+      testPath = T.intercalate "." ts+   in concat+        [ [ [ chunk "FAIL ",+              chunk (T.pack location),+              chunk " ",+              chunk testPath+            ]+          ],+          map+            (\l -> if null l then l else padding : l)+            (maybe [] outputSomeException testRunResultException),+          [[chunk ""]]+        ]++-- | Output the summary line in terse format.+--+-- Format: Summary: X failed, Y passed, Z pending (Ns)+outputTerseStats :: TestSuiteStats -> Double -> [Chunk]+outputTerseStats TestSuiteStats {..} totalTimeSeconds =+  concat $+    concat+      [ [[padding]],+        [ [ chunk "Passed: ",+            ( if testSuiteStatSuccesses <= 0+                then fore red+                else fore green+            )+              $ chunk (T.pack (show testSuiteStatSuccesses))+          ],+          [ chunk ", Failed: ",+            ( if testSuiteStatFailures > 0+                then fore red+                else fore green+            )+              $ chunk (T.pack (show testSuiteStatFailures))+          ]+        ],+        [ [ chunk ", Flaky: ",+            fore red $ chunk (T.pack (show testSuiteStatFlakyTests))+          ]+          | testSuiteStatFlakyTests > 0+        ],+        [ [ chunk ", Pending: ",+            fore magenta $ chunk (T.pack (show testSuiteStatPending))+          ]+          | testSuiteStatPending > 0+        ],+        [ [ fore yellow $ chunk $ T.pack (printf " (%0.2f s)" totalTimeSeconds)+          ]+        ]+      ]

@@ -533,34 +533,34 @@  instance HasParser SeedSetting where   settingsParser =-    choice-      [ setting-          [ help "Use a random seed for pseudo-randomness",-            switch RandomSeed,-            long "random-seed"-          ],-        RandomSeed-          <$ setting+    withDefault (testRunSettingSeed defaultTestRunSettings) $+      choice+        [ setting             [ help "Use a random seed for pseudo-randomness",-              OptEnvConf.reader exists,-              env "RANDOM_SEED",-              metavar "ANY"+              switch RandomSeed,+              long "random-seed"             ],-        FixedSeed-          <$> setting+          RandomSeed+            <$ setting+              [ help "Use a random seed for pseudo-randomness",+                OptEnvConf.reader exists,+                env "RANDOM_SEED",+                metavar "ANY"+              ],+          FixedSeed+            <$> setting+              [ help "Seed for pseudo-randomness",+                OptEnvConf.reader auto,+                option,+                long "seed",+                env "SEED",+                metavar "INT"+              ],+          setting             [ help "Seed for pseudo-randomness",-              OptEnvConf.reader auto,-              option,-              long "seed",-              env "SEED",-              metavar "INT"-            ],-        setting-          [ help "Seed for pseudo-randomness",-            conf "seed"-          ],-        pure $ testRunSettingSeed defaultTestRunSettings-      ]+              conf "seed"+            ]+        ]  data TestRunResult = TestRunResult   { testRunResultStatus :: !TestStatus,

@@ -14,9 +14,6 @@ where  import Control.Concurrent (getNumCapabilities)-import Control.Monad-import Control.Monad.IO.Class-import qualified Data.Text.IO as TIO import System.Environment import System.Mem (performGC) import System.Random (mkStdGen, setStdGen)@@ -27,7 +24,6 @@ import Test.Syd.Runner.Asynchronous import Test.Syd.Runner.Synchronous import Test.Syd.SpecDef-import Text.Colour import Text.Printf  -- | Set the command line argument of the underlying action to empty.@@ -66,41 +62,25 @@ sydTestOnce :: Settings -> TestDefM '[] () r -> IO (Timed ResultForest) sydTestOnce settings spec = do   specForest <- execTestDefM settings spec-  tc <- deriveTerminalCapababilities settings   withNullArgs $ do     setPseudorandomness (settingSeed settings)     case settingThreads settings of       Synchronous -> runSpecForestInterleavedWithOutputSynchronously settings specForest       ByCapabilities -> do         i <- fromIntegral <$> getNumCapabilities--        when (i == 1) $ do-          let outputLine :: [Chunk] -> IO ()-              outputLine lineChunks = liftIO $ do-                putChunksLocaleWith tc lineChunks-                TIO.putStrLn ""-          mapM_-            ( outputLine-                . (: [])-                . fore red-            )-            [ chunk "WARNING: Only one CPU core detected, make sure to compile your test suite with these ghc options:",-              chunk "         -threaded -rtsopts -with-rtsopts=-N",-              chunk "         (This is important for correctness as well as speed, as a parallel test suite can find thread safety problems.)"-            ]         runSpecForestInterleavedWithOutputAsynchronously settings i specForest       Asynchronous i ->         runSpecForestInterleavedWithOutputAsynchronously settings i specForest  sydTestIterations :: Maybe Word -> Settings -> TestDefM '[] () r -> IO (Timed ResultForest)-sydTestIterations totalIterations settings spec =+sydTestIterations totalIterations settings spec = do   withNullArgs $ do     nbCapabilities <- fromIntegral <$> getNumCapabilities      let runOnce settings_ = do           setPseudorandomness (settingSeed settings_)           specForest <- execTestDefM settings_ spec-          r <- timeItT 0 $ case settingThreads settings_ of+          r <- case settingThreads settings_ of             Synchronous -> runSpecForestSynchronously settings_ specForest             ByCapabilities -> runSpecForestAsynchronously settings_ nbCapabilities specForest             Asynchronous i -> runSpecForestAsynchronously settings_ i specForest

@@ -35,7 +35,7 @@ import Test.Syd.SpecForest import Text.Colour -runSpecForestAsynchronously :: Settings -> Word -> TestForest '[] () -> IO ResultForest+runSpecForestAsynchronously :: Settings -> Word -> TestForest '[] () -> IO (Timed ResultForest) runSpecForestAsynchronously settings nbThreads testForest = do   handleForest <- makeHandleForest testForest   failFastVar <- newEmptyMVar@@ -50,8 +50,22 @@   failFastVar <- newEmptyMVar   suiteBegin <- getMonotonicTimeNSec   let runRunner = runner settings nbThreads failFastVar handleForest-      runPrinter = liftIO $ printer settings failFastVar suiteBegin handleForest+      runPrinter = case settingOutputFormat settings of+        OutputFormatPretty -> liftIO $ printer settings failFastVar suiteBegin handleForest+        OutputFormatTerse -> liftIO $ waiter failFastVar handleForest   ((), resultForest) <- concurrently runRunner runPrinter++  let outputLine :: [Chunk] -> IO ()+      outputLine lineChunks = liftIO $ do+        putChunksLocaleWith (settingTerminalCapabilities settings) lineChunks+        TIO.putStrLn ""+      outputLines :: [[Chunk]] -> IO ()+      outputLines = mapM_ outputLine++  outputLines $ case settingOutputFormat settings of+    OutputFormatPretty -> outputPrettySummary settings resultForest+    OutputFormatTerse -> outputTerseSummary settings resultForest+   pure resultForest  type HandleForest a b = SpecDefForest a b (MVar (Timed TestRunReport))@@ -328,11 +342,9 @@  printer :: Settings -> MVar () -> Word64 -> HandleForest '[] () -> IO (Timed ResultForest) printer settings failFastVar suiteBegin handleForest = do-  tc <- deriveTerminalCapababilities settings-   let outputLine :: [Chunk] -> IO ()       outputLine lineChunks = liftIO $ do-        putChunksLocaleWith tc lineChunks+        putChunksLocaleWith (settingTerminalCapabilities settings) lineChunks         TIO.putStrLn ""        treeWidth :: Int@@ -394,9 +406,6 @@         DefExpectationNode _ sdf -> fmap SubForestNode <$> goForest sdf   mapM_ outputLine outputTestsHeader   resultForest <- fromMaybe [] <$> runReaderT (goForest handleForest) 0-  outputLine [chunk " "]-  mapM_ outputLine $ outputFailuresWithHeading settings resultForest-  outputLine [chunk " "]   suiteEnd <- getMonotonicTimeNSec   let timedResult =         Timed@@ -405,13 +414,7 @@             timedBegin = suiteBegin,             timedEnd = suiteEnd           }-  mapM_ outputLine $ outputStats (computeTestSuiteStats settings <$> timedResult)-  outputLine [chunk " "] -  when (settingProfile settings) $ do-    mapM_ outputLine (outputProfilingInfo timedResult)-    outputLine [chunk " "]-   pure timedResult  addLevel :: P a -> P a@@ -419,8 +422,8 @@  type P = ReaderT Int IO -waiter :: MVar () -> HandleForest '[] () -> IO ResultForest-waiter failFastVar handleForest = do+waiter :: MVar () -> HandleForest '[] () -> IO (Timed ResultForest)+waiter failFastVar handleForest = timeItT 0 $ do   let goForest :: HandleForest a b -> IO (Maybe ResultForest)       goForest hts = do         rts <- catMaybes <$> mapM goTree hts

@@ -26,10 +26,9 @@  runSpecForestInterleavedWithOutputSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest) runSpecForestInterleavedWithOutputSynchronously settings testForest = do-  tc <- deriveTerminalCapababilities settings   let outputLine :: [Chunk] -> IO ()       outputLine lineChunks = liftIO $ do-        putChunksLocaleWith tc lineChunks+        putChunksLocaleWith (settingTerminalCapabilities settings) lineChunks         TIO.putStrLn ""        treeWidth :: Int@@ -44,7 +43,9 @@         liftIO $ outputLine $ pad level line        outputLinesR :: [[Chunk]] -> R a ()-      outputLinesR = mapM_ outputLineR+      outputLinesR cs = case settingOutputFormat settings of+        OutputFormatPretty -> mapM_ outputLineR cs+        OutputFormatTerse -> return ()    let goForest :: TestForest a () -> R a (Next ResultForest)       goForest [] = pure (Continue [])

@@ -17,18 +17,19 @@ import Test.Syd.SpecDef import Test.Syd.SpecForest -runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest+runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest) runSpecForestSynchronously settings testForest =-  extractNext-    <$> runReaderT-      (goForest testForest)-      Env-        { eTimeout = settingTimeout settings,-          eRetries = settingRetries settings,-          eFlakinessMode = MayNotBeFlaky,-          eExpectationMode = ExpectPassing,-          eExternalResources = HNil-        }+  timeItT 0 $+    extractNext+      <$> runReaderT+        (goForest testForest)+        Env+          { eTimeout = settingTimeout settings,+            eRetries = settingRetries settings,+            eFlakinessMode = MayNotBeFlaky,+            eExpectationMode = ExpectPassing,+            eExternalResources = HNil+          }   where     goForest :: forall a. TestForest a () -> R a (Next ResultForest)     goForest [] = pure (Continue [])

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sydtest-version:        0.22.0.0+version:        0.23.0.0 synopsis:       A modern testing framework for Haskell with good defaults and advanced testing features. description:    A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category:       Testing@@ -42,6 +42,9 @@       Test.Syd.Modify       Test.Syd.OptParse       Test.Syd.Output+      Test.Syd.Output.Common+      Test.Syd.Output.Pretty+      Test.Syd.Output.Terse       Test.Syd.Path       Test.Syd.ReRun       Test.Syd.Run