diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,9 @@ # Changelog for sandwich-slack -## Unreleased changes +## 0.2.0.0 + +* BREAKING CHANGE: switch most monads away from using `MonadBaseControl IO` and switch to `MonadUnliftIO`. +* Windows support improvements. ## 0.1.2.0 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Tom McLaughlin (c) 2023 +Copyright Tom McLaughlin (c) 2025 All rights reserved. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -5,15 +5,11 @@ 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 - -#ifndef mingw32_HOST_OS import Test.Sandwich.Formatters.TerminalUI -#endif simple :: TopSpec @@ -42,18 +38,12 @@ , slackFormatterVisibilityThreshold = Just 50 } -#ifndef mingw32_HOST_OS -baseFormatter = SomeFormatter defaultTerminalUIFormatter -#else -baseFormatter = SomeFormatter defaultPrintFormatter -#endif - main :: IO () main = runSandwich options simple where options = defaultOptions { - optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime) - , optionsFormatters = [baseFormatter, SomeFormatter slackFormatter] + optionsTestArtifactsDirectory = defaultTestArtifactsDirectory + , optionsFormatters = [SomeFormatter defaultTerminalUIFormatter, SomeFormatter slackFormatter] } -- * Util diff --git a/sandwich-slack.cabal b/sandwich-slack.cabal --- a/sandwich-slack.cabal +++ b/sandwich-slack.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack -- --- hash: 6138f55d728f79ee3b7afe065d16ee37a3b075445596cb82a236df8f0e23bf47 +-- hash: 29f4c739f9e4b5cb58a9ff1224cbc09f9740944e94f09355caa1d660ff54d8bb name: sandwich-slack -version: 0.1.2.0 +version: 0.2.0.0 synopsis: Sandwich integration with Slack description: Please see the . category: Testing @@ -15,7 +15,7 @@ bug-reports: https://github.com/codedownio/sandwich/issues author: Tom McLaughlin maintainer: tom@codedown.io -copyright: 2023 Tom McLaughlin +copyright: 2025 Tom McLaughlin license: BSD3 license-file: LICENSE build-type: Simple @@ -60,12 +60,13 @@ , monad-logger , mtl , safe - , safe-exceptions , sandwich , stm , string-interpolate , text , time + , unliftio + , unliftio-core , vector , wreq default-language: Haskell2010 @@ -98,13 +99,14 @@ , monad-logger , mtl , safe - , safe-exceptions , sandwich , sandwich-slack , stm , string-interpolate , text , time + , unliftio + , unliftio-core , vector , wreq default-language: Haskell2010 @@ -138,12 +140,13 @@ , monad-logger , mtl , safe - , safe-exceptions , sandwich , stm , string-interpolate , text , time + , unliftio + , unliftio-core , vector , wreq default-language: Haskell2010 diff --git a/src/Test/Sandwich/Formatters/Slack.hs b/src/Test/Sandwich/Formatters/Slack.hs --- a/src/Test/Sandwich/Formatters/Slack.hs +++ b/src/Test/Sandwich/Formatters/Slack.hs @@ -30,9 +30,9 @@ import Control.Applicative import Control.Concurrent import Control.Concurrent.STM -import Control.Exception.Safe import Control.Monad import Control.Monad.IO.Class +import Control.Monad.IO.Unlift import Control.Monad.Logger hiding (logError) import qualified Data.Aeson as A import Data.Foldable @@ -50,6 +50,7 @@ import Test.Sandwich.Formatters.Slack.Internal.ProgressBar import Test.Sandwich.Formatters.Slack.Internal.Types import Test.Sandwich.Internal +import UnliftIO.Exception data SlackFormatter = SlackFormatter { @@ -121,7 +122,7 @@ , slackFormatterMaxMessageSize = optSlackMaxMessageSize <|> slackFormatterMaxMessageSize } -runApp :: (MonadIO m, MonadCatch m, MonadLogger m) => SlackFormatter -> [RunNode BaseContext] -> BaseContext -> m () +runApp :: (MonadUnliftIO m, MonadLogger m) => SlackFormatter -> [RunNode BaseContext] -> BaseContext -> m () runApp sf@(SlackFormatter {..}) rts _bc = do startTime <- liftIO getCurrentTime @@ -159,12 +160,13 @@ loop +publishTree :: SlackFormatter -> M.Map Int (T.Text, Int) -> NominalDiffTime -> [RunNodeWithStatus context Status l t] -> ProgressBarInfo 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))) + , progressBarInfoSize = Just (100.0 * (fromIntegral (succeeded + pending' + failed) / (fromIntegral total))) , progressBarInfoAttachments = Nothing , progressBarInfoBlocks = Just $ case slackFormatterMaxFailures sf of Nothing -> mconcat blocks @@ -179,7 +181,7 @@ 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)|] + bottomMessage = [i|#{succeeded} succeeded, #{failed} failed, #{pending'} pending, #{totalRunningTests} running of #{total} (#{formatNominalDiffTime elapsed} elapsed)|] blocks = catMaybes $ flip concatMap tree $ extractValuesControlRecurse $ \case -- Recurse into grouping nodes, because their failures are actually just derived from child failures @@ -192,12 +194,13 @@ total = countWhere isItBlock tree succeeded = countWhere isSuccessItBlock tree - pending = countWhere isPendingItBlock tree + pending' = countWhere isPendingItBlock tree failed = countWhere isFailedItBlock tree totalRunningTests = countWhere isRunningItBlock tree -- totalNotStartedTests = countWhere isNotStartedItBlock tree +singleFailureBlocks :: SlackFormatter -> M.Map Int (T.Text, Int) -> RunNodeWithStatus context s l t -> FailureReason -> [A.Value] singleFailureBlocks sf idToLabelAndVisibilityThreshold node reason = catMaybes [ Just $ markdownSectionWithLines [":red_circle: *" <> label <> "*"] @@ -235,10 +238,13 @@ _ -> Just l label = T.intercalate ", " $ mapMaybe filterFn $ toList $ runTreeAncestors $ runNodeCommon node +extraFailuresBlock :: Int -> A.Value extraFailuresBlock numExtraFailures = markdownSectionWithLines [[i|+ #{numExtraFailures} more failure|]] +markdownBlockWithLines :: [T.Text] -> A.Value markdownBlockWithLines ls = A.object [("type", A.String "mrkdwn"), ("text", A.String $ T.unlines ls)] +markdownSectionWithLines :: [T.Text] -> A.Value markdownSectionWithLines ls = A.object [("type", A.String "section"), ("text", markdownBlockWithLines ls)] addToLastLine :: [T.Text] -> T.Text -> [T.Text] diff --git a/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs b/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs --- a/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs +++ b/src/Test/Sandwich/Formatters/Slack/Internal/Markdown.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Test.Sandwich.Formatters.Slack.Internal.Markdown where @@ -13,16 +12,14 @@ toMarkdown :: FailureReason -> T.Text toMarkdown (Reason {..}) = T.pack failureReason -#ifndef mingw32_HOST_OS toMarkdown (RawImage {..}) = T.pack failureFallback -#endif toMarkdown (ChildrenFailed {failureNumChildren=n}) = [i|#{n} #{if n == 1 then ("child" :: T.Text) else "children"} failed|] toMarkdown (ExpectedButGot {..}) = [i|Expected *#{failureValue1}* but got *#{failureValue2}*|] toMarkdown (DidNotExpectButGot {..}) = [i|Did not expect *#{failureValue1}*|] toMarkdown (GotException {..}) = case failureMessage of Just msg -> [i|Got exception (_#{msg}_): #{failureException}|] Nothing -> [i|Got exception (no message): #{failureException}|] -toMarkdown (Pending {..}) = "Example was pending" +toMarkdown (Pending {}) = "Example was pending" toMarkdown (GetContextException {..}) = [i|Context exception: #{failureException}|] toMarkdown (GotAsyncException {..}) = case failureMessage of Just msg -> [i|Got async exception (_#{msg}_): #{failureAsyncException}|] @@ -33,6 +30,7 @@ callStackToMarkdown (SlackFormatterTopNCallStackFrames n) cs = "\n\n" <> showCallStack (fromCallSiteList $ L.take n $ getCallStack cs) callStackToMarkdown SlackFormatterFullCallStack cs = "\n\n" <> showCallStack cs +showCallStack :: CallStack -> T.Text showCallStack (getCallStack -> rows) = ["> *" <> (T.pack name) <> "*, called at " <> [i|_#{srcLocPackage}_:*#{srcLocFile}*:#{srcLocStartLine}:#{srcLocStartCol}|] | (name, SrcLoc {..}) <- rows] diff --git a/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs b/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs --- a/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs +++ b/src/Test/Sandwich/Formatters/Slack/Internal/ProgressBar.hs @@ -79,5 +79,5 @@ lightBlocks = round $ (100 - n) * multiplier multiplier = 0.5 - roundTo :: (Fractional a, RealFrac a) => Integer -> a -> a + roundTo :: (RealFrac a) => Integer -> a -> a roundTo places num = (fromInteger $ round $ num * (10^places)) / (10.0^^places)