From f48ddeecc8236dc133571815552e039919ed5fec Mon Sep 17 00:00:00 2001 From: Tom McLaughlin Date: Fri, 26 Feb 2021 17:22:36 -0800 Subject: [PATCH] Just realized this overflow scheme isn't going to work. Checking in progress for posterity. --- sandwich-slack/app/Main.hs | 25 +++++-- .../src/Test/Sandwich/Formatters/Slack.hs | 72 +++++++++++-------- 2 files changed, 61 insertions(+), 36 deletions(-) diff --git a/sandwich-slack/app/Main.hs b/sandwich-slack/app/Main.hs index 337eaad..d1d4419 100644 --- a/sandwich-slack/app/Main.hs +++ b/sandwich-slack/app/Main.hs @@ -5,6 +5,7 @@ module Main where import Control.Concurrent import Control.Monad.IO.Class import Data.Time +import GHC.Stack import Test.Sandwich import Test.Sandwich.Formatters.Print import Test.Sandwich.Formatters.Slack @@ -14,12 +15,12 @@ simple :: TopSpec simple = parallel $ do it "does the thing 1" sleepThenSucceed it "does the thing 2" sleepThenSucceed - it "does the thing 3" sleepThenFail + it "does the thing 3" deepSleepThenFail describe "should happen sequentially" $ do it "sequential 1" sleepThenSucceed it "sequential 2" sleepThenFail it "sequential 3" sleepThenSucceed - it "does the thing 4" sleepThenFail + it "does the thing 4" deepSleepThenFail it "does the thing 5" sleepThenSucceed it "does the thing 6" sleepThenSucceed @@ -29,9 +30,11 @@ slackFormatter = defaultSlackFormatter { , slackFormatterTopMessage = Just "Top message" , slackFormatterChannel = "test-channel" - , slackFormatterMaxFailures = Nothing -- Just 2 + , slackFormatterMaxFailures = Just 2 , slackFormatterMaxFailureReasonLines = Just 0 - , slackFormatterMaxCallStackLines = Just 0 + , slackFormatterMaxFailureReasonOverflowLines = Just 10 + , slackFormatterMaxCallStackLines = Just 1 + , slackFormatterMaxCallStackOverflowLines = Just 10 , slackFormatterVisibilityThreshold = Just 50 } @@ -49,17 +52,27 @@ main = runSandwich options simple -- * Util -sleepThenSucceed :: ExampleM context () +sleepThenSucceed :: (HasCallStack) => ExampleM context () sleepThenSucceed = do -- liftIO $ threadDelay (2 * 10^1) liftIO $ threadDelay (2 * 10^5) -- liftIO $ threadDelay (1 * 10^6) -- liftIO $ threadDelay (3 * 10^6) -sleepThenFail :: ExampleM context () +sleepThenFail :: (HasCallStack) => ExampleM context () sleepThenFail = do -- liftIO $ threadDelay (2 * 10^1) liftIO $ threadDelay (2 * 10^5) -- liftIO $ threadDelay (1 * 10^6) -- liftIO $ threadDelay (3 * 10^6) 2 `shouldBe` 3 + + +deepSleepThenFail :: (HasCallStack) => ExampleM context () +deepSleepThenFail = deepSleepThenFail2 + +deepSleepThenFail2 :: (HasCallStack) => ExampleM context () +deepSleepThenFail2 = deepSleepThenFail3 + +deepSleepThenFail3 :: (HasCallStack) => ExampleM context () +deepSleepThenFail3 = sleepThenFail diff --git a/sandwich-slack/src/Test/Sandwich/Formatters/Slack.hs b/sandwich-slack/src/Test/Sandwich/Formatters/Slack.hs index 743a683..0af091f 100644 --- a/sandwich-slack/src/Test/Sandwich/Formatters/Slack.hs +++ b/sandwich-slack/src/Test/Sandwich/Formatters/Slack.hs @@ -14,9 +14,13 @@ module Test.Sandwich.Formatters.Slack ( , slackFormatterSlackConfig , slackFormatterTopMessage , slackFormatterChannel + , slackFormatterMaxFailures , slackFormatterMaxFailureReasonLines + , slackFormatterMaxFailureReasonOverflowLines , slackFormatterMaxCallStackLines + , slackFormatterMaxCallStackOverflowLines + , slackFormatterVisibilityThreshold , SlackFormatterShowCallStacks(..) @@ -65,10 +69,18 @@ data SlackFormatter = SlackFormatter { , slackFormatterMaxFailureReasonLines :: Maybe Int -- ^ Maximum number of lines to devote to showing the failure reason underneath a failure. -- Set to 'Just 0' to disable showing failure reasons. + , slackFormatterMaxFailureReasonOverflowLines :: Maybe Int + -- ^ Maximum number of lines to allow to spill into an overflow section, which requires + -- clicking a button to view. + -- Set to 'Just 0' to disable overflow for failure reasons. , slackFormatterMaxCallStackLines :: Maybe Int -- ^ Maximum number of lines to devote to showing the call stack underneath a failure. -- Set to 'Just 0' to disable showing call stacks. + , slackFormatterMaxCallStackOverflowLines :: Maybe Int + -- ^ Maximum number of lines to allow to spill into an overflow section, which requires + -- clicking a button to view. + -- Set to 'Just 0' to disable overflow for callstacks. , slackFormatterVisibilityThreshold :: Maybe Int -- ^ If present, filter the headings on failures to only include nodes whose visibility @@ -83,7 +95,9 @@ defaultSlackFormatter = SlackFormatter { , slackFormatterMaxFailures = Just 30 , slackFormatterMaxFailureReasonLines = Just 5 + , slackFormatterMaxFailureReasonOverflowLines = Just 10 , slackFormatterMaxCallStackLines = Just 5 + , slackFormatterMaxCallStackOverflowLines = Just 10 , slackFormatterVisibilityThreshold = Nothing @@ -122,7 +136,7 @@ runApp sf@(SlackFormatter {..}) rts _bc = do let pbi' = publishTree sf idToLabelAndVisibilityThreshold (diffUTCTime now startTime) newFixedTree tryAny (liftIO $ updateProgressBar slackFormatterSlackConfig pb pbi') >>= \case Left err -> logError [i|Error updating progress bar: '#{err}'|] - Right (Left err) -> logError [i|Inner error updating progress bar: '#{err}'|] + Right (Left err) -> logError [i|Inner error updating progress bar: '#{err}'. Blocks were '#{A.encode $ progressBarInfoBlocks pbi'}'|] Right (Right ()) -> return () if | allIsDone newFixedTree -> do @@ -135,33 +149,34 @@ runApp sf@(SlackFormatter {..}) rts _bc = do publishTree sf idToLabelAndVisibilityThreshold elapsed tree = pbi where - pbi = ProgressBarInfo { progressBarInfoTopMessage = T.pack <$> (slackFormatterTopMessage sf) - , progressBarInfoBottomMessage = Just fullBottomMessage - , progressBarInfoSize = Just (100.0 * (fromIntegral (succeeded + pending + failed) / (fromIntegral total))) - , progressBarInfoAttachments = Nothing - , progressBarInfoBlocks = Just $ case slackFormatterMaxFailures sf of - Nothing -> mconcat blocks - Just n -> case L.splitAt n blocks of - (xs, []) -> mconcat xs - (xs, rest) -> mconcat xs <> [extraFailuresBlock (L.length rest)] - } + pbi = ProgressBarInfo { + progressBarInfoTopMessage = T.pack <$> (slackFormatterTopMessage sf) + , progressBarInfoBottomMessage = Just fullBottomMessage + , progressBarInfoSize = Just (100.0 * (fromIntegral (succeeded + pending + failed) / (fromIntegral total))) + , progressBarInfoAttachments = Nothing + , progressBarInfoBlocks = Just $ case slackFormatterMaxFailures sf of + Nothing -> mconcat blocks + Just n -> case L.splitAt n blocks of + (xs, []) -> mconcat xs + (xs, rest) -> mconcat xs <> [extraFailuresBlock (L.length rest)] + } - runningMessage = headMay $ L.sort $ catMaybes $ concatMap (extractValues (\node -> if isRunningItBlock node then Just $ runTreeLabel $ runNodeCommon node else Nothing)) tree + runningMessage = headMay $ L.sort $ catMaybes $ flip concatMap tree $ + extractValues (\node -> if isRunningItBlock node then Just $ runTreeLabel $ runNodeCommon node else Nothing) fullBottomMessage = case runningMessage of Nothing -> bottomMessage Just t -> T.pack t <> "\n" <> bottomMessage bottomMessage = [i|#{succeeded} succeeded, #{failed} failed, #{pending} pending, #{totalRunningTests} running of #{total} (#{formatNominalDiffTime elapsed} elapsed)|] - blocks = flip concatMap tree $ extractValuesControlRecurse $ \case + blocks = catMaybes $ flip concatMap tree $ extractValuesControlRecurse $ \case -- Recurse into grouping nodes, because their failures are actually just derived from child failures - RunNodeDescribe {} -> (True, []) - RunNodeParallel {} -> (True, []) - ((runTreeStatus . runNodeCommon) -> - (Done {statusResult=(Failure (Pending {}))})) -> (False, []) + RunNodeDescribe {} -> (True, Nothing) + RunNodeParallel {} -> (True, Nothing) + ((runTreeStatus . runNodeCommon) -> (Done {statusResult=(Failure (Pending {}))})) -> (False, Nothing) node@((runTreeStatus . runNodeCommon) -> (Done {statusResult=(Failure reason)})) | isFailedBlock node -> - (False, singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason) - _ -> (True, []) + (False, Just $ singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason) + _ -> (True, Nothing) total = countWhere isItBlock tree succeeded = countWhere isSuccessItBlock tree @@ -178,21 +193,13 @@ singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason = catMaybes [ , case (markdownLinesToShow, overflowMarkdownLines) of ([], _) -> Nothing (toShow, []) -> Just $ markdownSectionWithLines toShow - (toShow, overflow) -> Just $ A.object [ - ("type", A.String "section") - , ("text", markdownBlockWithLines toShow) - , ("accessory", A.object [("type", "overflow"), ("options", A.Array (V.fromList [markdownBlockWithLines overflow]))]) - ] + (toShow, overflow) -> Just $ sectionsWithTextAndOverflow (markdownBlockWithLines toShow) [markdownBlockWithLines overflow] -- Callstack info , case (callStackLinesToShow, overflowCallStackLines) of ([], _) -> Nothing (toShow, []) -> Just $ markdownSectionWithLines toShow - (toShow, overflow) -> Just $ A.object [ - ("type", A.String "section") - , ("text", markdownBlockWithLines toShow) - , ("accessory", A.object [("type", "overflow"), ("options", A.Array (V.fromList [markdownBlockWithLines overflow]))]) - ] + (toShow, overflow) -> Just $ sectionsWithTextAndOverflow (markdownBlockWithLines toShow) [markdownBlockWithLines overflow] ] where allMarkdownLines = T.lines $ toMarkdown reason @@ -216,12 +223,17 @@ singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason = catMaybes [ _ -> Just l label = T.intercalate ", " $ mapMaybe filterFn $ toList $ runTreeAncestors $ runNodeCommon node -extraFailuresBlock numExtraFailures = markdownSectionWithLines [[i|+ #{numExtraFailures} more|]] +extraFailuresBlock numExtraFailures = markdownSectionWithLines [[i|+ #{numExtraFailures} more failure|]] markdownBlockWithLines ls = A.object [("type", A.String "mrkdwn"), ("text", A.String $ T.unlines ls)] markdownSectionWithLines ls = A.object [("type", A.String "section"), ("text", markdownBlockWithLines ls)] +sectionsWithTextAndOverflow text overflow = A.object [ + ("type", A.String "section") + , ("text", text) + , ("accessory", A.object [("type", "overflow"), ("options", A.Array (V.fromList overflow))]) + ] allIsDone :: [RunNodeFixed context] -> Bool allIsDone = all (isDone . runTreeStatus . runNodeCommon)