tasty-flaky 0.1.1.0 → 0.1.2.0

raw patch · 3 files changed

+77/−24 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• src/Test/Tasty/Flaky.hs +72/−23
• tasty-flaky.cabal +1/−1

@@ -1,5 +1,9 @@ # Revision history for tasty-flaky +## 0.1.2.0 --  2025-02-10++* Add `flakyTestWithRetryAction`. Retry logic can now be based on test results (#1).+ ## 0.1.1.0 -- 2024-12-19  * Explicit support and testing for GHC 9.12

@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}  ----------------------------------------------------------------------------- -- |@@ -10,10 +11,11 @@ -- Maintainer  :  Laurent René de Cotret -- Portability :  portable ----- This module defines a single function, 'flakyTest', to declare a test+-- This module defines a function, 'flakyTest', to declare a test -- which intermittently fails. Flaky tests can be retries using retry policies -- provided by the "Control.Retry" module (from the @retry@ package). --+-- To dynamically retry based on the result of a test, see 'flakyTestWithRetryAction' instead. -- -- For example, you can retry test cases from @tasty-hunit@ like so: --@@ -28,8 +30,9 @@ -- if a failure occurs. -- module Test.Tasty.Flaky (-    -- * Test wrapper+    -- * Test wrappers     flakyTest+    , flakyTestWithRetryAction      -- * Re-exports     -- @@ -58,35 +61,74 @@  -- | A test tree of type @t@, with an associated retry policy data FlakyTest t-    = MkFlakyTest (RetryPolicyM IO) t+    = MkFlakyTest (RetryStatus -> Result -> IO RetryAction) (RetryPolicyM IO) t  +-- | Modify the delay of a RetryPolicy (in microseconds).+-- Does not change whether or not a retry is performed.+modifyRetryPolicyDelay :: Functor m => (Int -> Int) -> RetryPolicyM m -> RetryPolicyM m+modifyRetryPolicyDelay f (RetryPolicyM p) = RetryPolicyM $ \stat -> fmap f <$> p stat++ -- | Mark any test as flaky. ----- If this test is not successful, it will be retried according to the supplied @'RetryPolicyM' 'IO'@. +-- If this test is not successful, it will be retried according to the supplied @'RetryPolicyM' 'IO'@. -- See "Control.Retry" for documentation on how to specify a @'RetryPolicyM' 'IO'@. -- -- For example, you can retry test cases from @tasty-hunit@ like so: -- -- @ -- import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit--- +-- -- myFlakyTest :: TestTree--- myFlakyTest = 'flakyTest' ('limitRetries' 5 <> 'constantDelay' 1000) $ testCase "some test case" $ do ... +-- myFlakyTest = 'flakyTest' ('limitRetries' 5 <> 'constantDelay' 1000) $ testCase "some test case" $ do ... -- @ --+-- To dynamically retry based on the result of a test, see 'flakyTestWithRetryAction' instead. flakyTest :: (RetryPolicyM IO) -> TestTree -> TestTree-flakyTest policy (SingleTest name t)           = SingleTest name (MkFlakyTest policy t)-flakyTest policy (TestGroup name subtree)      = TestGroup name (map (flakyTest policy) subtree)-flakyTest policy (PlusTestOptions modOption t) = PlusTestOptions modOption (flakyTest policy t)-flakyTest policy (WithResource spec f)         = WithResource spec (f <&> flakyTest policy)-flakyTest policy (AskOptions f)                = AskOptions $ \optionSet -> flakyTest policy (f optionSet)-flakyTest policy (After depType expr t)        = After depType expr (flakyTest policy t)+flakyTest = flakyTestWithRetryAction (\_ _ -> pure ConsultPolicy)  +-- | Mark any test as flaky. Like 'flakyTest', but allows for overriding retry policies+-- based on test results. Also see 'RetryAction'.+--+-- For example, if you only want to retry a test if the error message contains @"some error message"@:+--+-- @+-- import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit+-- import Data.List ( isInfixOf )+--+-- myFlakyTest :: TestTree+-- myFlakyTest +--     = 'flakyTestWithRetryAction' +--              retryAction +--              ('constantDelay' 1000)+--                  $ testCase "some test case" $ do ...+--     where+--         retryAction :: 'RetryStatus' -> 'Result' -> IO 'RetryAction'+--         retryAction _ result+--             | "some error message" ``isInfixOf`` show result = pure `ConsultPolicy`+--             | otherwise = pure `DontRetry`+-- @+--+-- @since 0.1.2.0+flakyTestWithRetryAction :: (RetryStatus -> Result -> IO RetryAction)+                         -> (RetryPolicyM IO) +                         -> TestTree -> TestTree+flakyTestWithRetryAction retryAction policy = \case+    (SingleTest name t)           -> SingleTest name (MkFlakyTest retryAction policy t)+    (TestGroup name subtree)      -> TestGroup name (map go subtree)+    (PlusTestOptions modOption t) -> PlusTestOptions modOption (go t)+    (WithResource spec f)         -> WithResource spec (f <&> go)+    (AskOptions f)                -> AskOptions $ \optionSet -> go (f optionSet)+    (After depType expr t)        -> After depType expr (go t)+  where+    go = flakyTestWithRetryAction retryAction policy++ instance IsTest t => IsTest (FlakyTest t) where     run :: IsTest t => OptionSet -> FlakyTest t -> (Progress -> IO ()) -> IO Result-    run opts (MkFlakyTest policy test) progressCallback = go defaultRetryStatus+    run opts (MkFlakyTest retryAction policy test) progressCallback = go defaultRetryStatus         where             -- The logic below mimics the `retry` package's Control.Retry.retrying             -- with one major difference: we annotate the final result@@ -95,31 +137,38 @@             go :: RetryStatus -> IO Result             go status = do                 result <- run opts test progressCallback-                let consultPolicy policy' = do+                let done = pure $ annotateResult status result+                    consultPolicy policy' = do                         rs <- applyAndDelay policy' status                         case rs of                             -- We are done: no more retries-                            Nothing -> pure $ annotateResult status result+                            Nothing -> done                             -- At least one more retry-                            Just rs' -> do +                            Just rs' -> do                                 progressCallback (annotateProgress status)                                 go $! rs'                  if resultSuccessful result-                    then pure $ annotateResult status result-                    else consultPolicy policy-            +                then done+                else do+                  retry <- retryAction status result+                  case retry of+                    DontRetry -> done+                    ConsultPolicy -> consultPolicy policy+                    ConsultPolicyOverrideDelay delay ->+                      consultPolicy $ modifyRetryPolicyDelay (const delay) policy+             annotateProgress :: RetryStatus -> Progress-            annotateProgress status +            annotateProgress status                 -- Recall that `rsIterNumber` starts at 0, so the first attempt is rsIterNumber + 1                 = emptyProgress{progressText=mconcat ["Attempt #", show (rsIterNumber status + 1), " failed"]}-            +             annotateResult :: RetryStatus -> Result -> Result-            annotateResult status result +            annotateResult status result                 = result { resultDescription = resultDescription result <> annotate status }                 where                     annotate :: RetryStatus -> String-                    annotate (RetryStatus iternum cumdelay _) +                    annotate (RetryStatus iternum cumdelay _)                         | iternum == 0 = ""                         | otherwise    = mconcat [" [", show iternum, " retries, ", show cumdelay, " μs delay]"] 

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               tasty-flaky-version:            0.1.1.0+version:            0.1.2.0 synopsis:           Handle flaky Tasty-based tests description:        Handle flaky Tasty-based tests, with configuration retry policies. homepage:           https://github.com/LaurentRDC/tasty-flaky