Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-retry for openSUSE:Factory checked in at 2022-08-10 17:13:24 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-retry (Old) and /work/SRC/openSUSE:Factory/.ghc-retry.new.1521 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-retry" Wed Aug 10 17:13:24 2022 rev:6 rq:994047 version:0.9.3.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-retry/ghc-retry.changes 2022-08-01 21:30:45.845719319 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-retry.new.1521/ghc-retry.changes 2022-08-10 17:14:30.845898129 +0200 @@ -1,0 +2,7 @@ +Fri Jul 15 20:24:53 UTC 2022 - Peter Simons <[email protected]> + +- Update retry to version 0.9.3.0. + 0.9.3.0 + * Add `UnliftIO.Retry` [PR 81](https://github.com/Soostone/retry/pull/81) + +------------------------------------------------------------------- Old: ---- retry-0.9.2.1.tar.gz New: ---- retry-0.9.3.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-retry.spec ++++++ --- /var/tmp/diff_new_pack.Ifj44w/_old 2022-08-10 17:14:32.469902368 +0200 +++ /var/tmp/diff_new_pack.Ifj44w/_new 2022-08-10 17:14:32.473902379 +0200 @@ -19,7 +19,7 @@ %global pkg_name retry %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.9.2.1 +Version: 0.9.3.0 Release: 0 Summary: Retry combinators for monadic actions that may fail License: BSD-3-Clause @@ -32,6 +32,7 @@ BuildRequires: ghc-random-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-transformers-devel +BuildRequires: ghc-unliftio-core-devel ExcludeArch: %{ix86} %if %{with tests} BuildRequires: ghc-HUnit-devel ++++++ retry-0.9.2.1.tar.gz -> retry-0.9.3.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.2.1/changelog.md new/retry-0.9.3.0/changelog.md --- old/retry-0.9.2.1/changelog.md 2022-05-21 01:01:11.000000000 +0200 +++ new/retry-0.9.3.0/changelog.md 2022-07-15 22:16:51.000000000 +0200 @@ -1,3 +1,6 @@ +0.9.3.0 +* Add `UnliftIO.Retry` [PR 81](https://github.com/Soostone/retry/pull/81) + 0.9.2.1 * Use explicit import for `lift` which allows for mtl-2.3 compatibility [PR 80](https://github.com/Soostone/retry/pull/80) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.2.1/retry.cabal new/retry-0.9.3.0/retry.cabal --- old/retry-0.9.2.1/retry.cabal 2022-05-21 01:01:22.000000000 +0200 +++ new/retry-0.9.3.0/retry.cabal 2022-07-15 22:16:51.000000000 +0200 @@ -14,7 +14,7 @@ case we should hang back for a bit and retry the query instead of simply raising an exception. -version: 0.9.2.1 +version: 0.9.3.0 synopsis: Retry combinators for monadic actions that may fail license: BSD3 license-file: LICENSE @@ -35,6 +35,7 @@ library exposed-modules: Control.Retry + UnliftIO.Retry build-depends: base >= 4.8 && < 5 , exceptions >= 0.5 @@ -43,6 +44,7 @@ , transformers , mtl , mtl-compat + , unliftio-core >= 0.1.0.0 hs-source-dirs: src default-language: Haskell2010 @@ -58,7 +60,9 @@ hs-source-dirs: test,src ghc-options: -threaded other-modules: Control.Retry + UnliftIO.Retry Tests.Control.Retry + Tests.UnliftIO.Retry build-depends: base ==4.* , exceptions @@ -74,6 +78,7 @@ , ghc-prim , mtl , mtl-compat + , unliftio-core default-language: Haskell2010 if flag(lib-Werror) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.2.1/src/UnliftIO/Retry.hs new/retry-0.9.3.0/src/UnliftIO/Retry.hs --- old/retry-0.9.2.1/src/UnliftIO/Retry.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/retry-0.9.3.0/src/UnliftIO/Retry.hs 2022-07-15 22:16:51.000000000 +0200 @@ -0,0 +1,268 @@ +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : UnliftIO.Retry +-- Copyright : Ozgun Ataman <[email protected]> +-- License : BSD3 +-- +-- Maintainer : Patrick Brisbin <[email protected]> +-- Stability : provisional +-- +-- Unlifted "Control.Retry". +-- +-- @since 0.9.3.0 +---------------------------------------------------------------------------- + + +module UnliftIO.Retry + ( + -- * Types and Operations + RetryPolicyM (..) + , RetryPolicy + , retryPolicy + , retryPolicyDefault + , natTransformRetryPolicy + , RetryAction (..) + , toRetryAction + , RetryStatus (..) + , defaultRetryStatus + , applyPolicy + , applyAndDelay + + + -- ** Lenses for 'RetryStatus' + , rsIterNumberL + , rsCumulativeDelayL + , rsPreviousDelayL + + -- * Applying Retry Policies + , retrying + , retryingDynamic + , recovering + , recoveringDynamic + , stepping + , recoverAll + , skipAsyncExceptions + , logRetries + , defaultLogMsg + , retryOnError + -- ** Resumable variants + , resumeRetrying + , resumeRetryingDynamic + , resumeRecovering + , resumeRecoveringDynamic + , resumeRecoverAll + + -- * Retry Policies + , constantDelay + , exponentialBackoff + , fullJitterBackoff + , fibonacciBackoff + , limitRetries + + -- * Policy Transformers + , limitRetriesByDelay + , limitRetriesByCumulativeDelay + , capDelay + + -- * Development Helpers + , simulatePolicy + , simulatePolicyPP + ) where + +------------------------------------------------------------------------------- +import Control.Retry hiding + ( recoverAll + , recovering + , recoveringDynamic + , resumeRecovering + , resumeRecoveringDynamic + , resumeRecoverAll + , stepping + ) +import qualified Control.Retry as Retry +import Control.Monad.Catch (Handler(..)) +import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) +import Prelude +------------------------------------------------------------------------------- + + +------------------------------------------------------------------------------- +-- | Run an action and recover from a raised exception by potentially +-- retrying the action a number of times. Note that if you're going to +-- use a handler for 'SomeException', you should add explicit cases +-- *earlier* in the list of handlers to reject 'AsyncException' and +-- 'SomeAsyncException', as catching these can cause thread and +-- program hangs. 'recoverAll' already does this for you so if you +-- just plan on catching 'SomeException', you may as well use +-- 'recoverAll' +recovering + :: MonadUnliftIO m + => RetryPolicyM m + -- ^ Just use 'retryPolicyDefault' for default settings + -> [RetryStatus -> Handler m Bool] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns True *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m a) + -- ^ Action to perform + -> m a +recovering = resumeRecovering defaultRetryStatus + + +------------------------------------------------------------------------------- +-- | A variant of 'recovering' that allows specifying the initial +-- 'RetryStatus' so that a recovering operation may pick up where it left +-- off in regards to its retry policy. +resumeRecovering + :: MonadUnliftIO m + => RetryStatus + -> RetryPolicyM m + -- ^ Just use 'retryPolicyDefault' for default settings + -> [RetryStatus -> Handler m Bool] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns True *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m a) + -- ^ Action to perform + -> m a +resumeRecovering retryStatus policy hs f = withRunInIO $ \runInIO -> + Retry.resumeRecovering + retryStatus + (transRetryPolicy runInIO policy) + (map ((.) $ transHandler runInIO) hs) + (runInIO . f) + + +------------------------------------------------------------------------------- +-- | The difference between this and 'recovering' is the same as +-- the difference between 'retryingDynamic' and 'retrying'. +recoveringDynamic + :: MonadUnliftIO m + => RetryPolicyM m + -- ^ Just use 'retryPolicyDefault' for default settings + -> [RetryStatus -> Handler m RetryAction] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns either 'ConsultPolicy' or + -- 'ConsultPolicyOverrideDelay' *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m a) + -- ^ Action to perform + -> m a +recoveringDynamic = resumeRecoveringDynamic defaultRetryStatus + + +------------------------------------------------------------------------------- +-- | A variant of 'recoveringDynamic' that allows specifying the initial +-- 'RetryStatus' so that a recovering operation may pick up where it left +-- off in regards to its retry policy. +resumeRecoveringDynamic + :: MonadUnliftIO m + => RetryStatus + -> RetryPolicyM m + -- ^ Just use 'retryPolicyDefault' for default settings + -> [RetryStatus -> Handler m RetryAction] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns either 'ConsultPolicy' or + -- 'ConsultPolicyOverrideDelay' *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m a) + -- ^ Action to perform + -> m a +resumeRecoveringDynamic retryStatus policy hs f = withRunInIO $ \runInIO -> + Retry.resumeRecoveringDynamic + retryStatus + (transRetryPolicy runInIO policy) + (map ((.) $ transHandler runInIO) hs) + (runInIO . f) + + +------------------------------------------------------------------------------- +-- | Retry ALL exceptions that may be raised. To be used with caution; +-- this matches the exception on 'SomeException'. Note that this +-- handler explicitly does not handle 'AsyncException' nor +-- 'SomeAsyncException' (for versions of base >= 4.7). It is not a +-- good idea to catch async exceptions as it can result in hanging +-- threads and programs. Note that if you just throw an exception to +-- this thread that does not descend from SomeException, recoverAll +-- will not catch it. +-- +-- See how the action below is run once and retried 5 more times +-- before finally failing for good: +-- +-- >>> let f _ = putStrLn "Running action" >> error "this is an error" +-- >>> recoverAll retryPolicyDefault f +-- Running action +-- Running action +-- Running action +-- Running action +-- Running action +-- Running action +-- *** Exception: this is an error +recoverAll + :: MonadUnliftIO m + => RetryPolicyM m + -> (RetryStatus -> m a) + -> m a +recoverAll = resumeRecoverAll defaultRetryStatus + + +------------------------------------------------------------------------------- +-- | A variant of 'recoverAll' that allows specifying the initial +-- 'RetryStatus' so that a recovering operation may pick up where it left +-- off in regards to its retry policy. +resumeRecoverAll + :: MonadUnliftIO m + => RetryStatus + -> RetryPolicyM m + -> (RetryStatus -> m a) + -> m a +resumeRecoverAll retryStatus policy f = withRunInIO $ \runInIO -> + Retry.resumeRecoverAll + retryStatus + (transRetryPolicy runInIO policy) + (runInIO . f) + +------------------------------------------------------------------------------- +-- | A version of 'recovering' that tries to run the action only a +-- single time. The control will return immediately upon both success +-- and failure. Useful for implementing retry logic in distributed +-- queues and similar external-interfacing systems. +stepping + :: MonadUnliftIO m + => RetryPolicyM m + -- ^ Just use 'retryPolicyDefault' for default settings + -> [RetryStatus -> Handler m Bool] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns True *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m ()) + -- ^ Action to run with updated status upon failure. + -> (RetryStatus -> m a) + -- ^ Main action to perform with current status. + -> RetryStatus + -- ^ Current status of this step + -> m (Maybe a) +stepping policy hs schedule f s = withRunInIO $ \runInIO -> + Retry.stepping + (transRetryPolicy runInIO policy) + (map ((.) $ transHandler runInIO) hs) + (runInIO . schedule) + (runInIO . f) + s + + +------------------------------------------------------------------------------- +transRetryPolicy :: (forall a. m a -> n a) -> RetryPolicyM m -> RetryPolicyM n +transRetryPolicy f (RetryPolicyM p) = RetryPolicyM $ f . p + + +------------------------------------------------------------------------------- +transHandler :: (forall b. m b -> n b) -> Handler m a -> Handler n a +transHandler f (Handler h) = Handler $ f . h diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.2.1/test/Main.hs new/retry-0.9.3.0/test/Main.hs --- old/retry-0.9.2.1/test/Main.hs 2022-03-02 20:55:21.000000000 +0100 +++ new/retry-0.9.3.0/test/Main.hs 2022-07-15 22:16:51.000000000 +0200 @@ -7,6 +7,7 @@ import Test.Tasty ------------------------------------------------------------------------------- import qualified Tests.Control.Retry +import qualified Tests.UnliftIO.Retry ------------------------------------------------------------------------------- @@ -19,4 +20,5 @@ tests :: TestTree tests = testGroup "retry" [ Tests.Control.Retry.tests + , Tests.UnliftIO.Retry.tests ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.2.1/test/Tests/Control/Retry.hs new/retry-0.9.3.0/test/Tests/Control/Retry.hs --- old/retry-0.9.2.1/test/Tests/Control/Retry.hs 2022-03-02 21:25:19.000000000 +0100 +++ new/retry-0.9.3.0/test/Tests/Control/Retry.hs 2022-07-15 22:16:51.000000000 +0200 @@ -5,6 +5,14 @@ {-# LANGUAGE FlexibleContexts #-} module Tests.Control.Retry ( tests + + -- * Used to test UnliftIO versions of the same functions + , recoveringTestsWith + , maskingStateTestsWith + , quadraticDelayTestsWith + , recoveringTest + , testHandlers + , testHandlersDynamic ) where ------------------------------------------------------------------------------- @@ -56,12 +64,19 @@ ------------------------------------------------------------------------------- recoveringTests :: TestTree -recoveringTests = testGroup "recovering" +recoveringTests = recoveringTestsWith recovering + + +recoveringTestsWith + :: Monad m + => (RetryPolicyM m -> [RetryStatus -> Handler IO Bool] -> (a -> IO ()) -> IO ()) + -> TestTree +recoveringTestsWith recovering' = testGroup "recovering" [ testProperty "recovering test without quadratic retry delay" $ property $ do startTime <- liftIO getCurrentTime timeout <- forAll (Gen.int (Range.linear 0 15)) retries <- forAll (Gen.int (Range.linear 0 50)) - res <- liftIO $ try $ recovering + res <- liftIO $ try $ recovering' (constantDelay timeout <> limitRetries retries) testHandlers (const $ throwM (userError "booo")) @@ -88,7 +103,7 @@ , testCase "recovers from custom exceptions" $ do f <- mkFailN Custom1 2 - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 3) [const $ Handler $ \ Custom1 -> return shouldRetry] f @@ -96,7 +111,7 @@ , testCase "fails beyond policy using custom exceptions" $ do f <- mkFailN Custom1 3 - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 2) [const $ Handler $ \ Custom1 -> return shouldRetry] f @@ -111,7 +126,7 @@ , testCase "does not recover from unhandled exceptions" $ do f <- mkFailN Custom2 2 - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 5) [const $ Handler $ \ Custom1 -> return shouldRetry] f @@ -120,7 +135,7 @@ , testCase "recovers in presence of multiple handlers" $ do f <- mkFailN Custom2 2 - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 5) [ const $ Handler $ \ Custom1 -> return shouldRetry , const $ Handler $ \ Custom2 -> return shouldRetry ] @@ -130,7 +145,7 @@ , testCase "general exceptions catch specific ones" $ do f <- mkFailN Custom2 2 - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 5) [ const $ Handler $ \ (_::SomeException) -> return shouldRetry ] f @@ -139,7 +154,7 @@ , testCase "(redundant) even general catchers don't go beyond policy" $ do f <- mkFailN Custom2 3 - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 2) [ const $ Handler $ \ (_::SomeException) -> return shouldRetry ] f @@ -149,7 +164,7 @@ , testCase "rethrows in presence of failed exception casts" $ do f <- mkFailN Custom2 3 final <- try $ do - res <- try $ recovering + res <- try $ recovering' (constantDelay 5000 <> limitRetries 2) [ const $ Handler $ \ (_::SomeException) -> return shouldRetry ] f @@ -230,10 +245,17 @@ ------------------------------------------------------------------------------- maskingStateTests :: TestTree -maskingStateTests = testGroup "masking state" +maskingStateTests = maskingStateTestsWith recovering + + +maskingStateTestsWith + :: Monad m + => (RetryPolicyM m -> [RetryStatus -> Handler IO Bool] -> (a -> IO b) -> IO ()) + -> TestTree +maskingStateTestsWith recovering' = testGroup "masking state" [ testCase "shouldn't change masking state in a recovered action" $ do maskingState <- EX.getMaskingState - final <- try $ recovering retryPolicyDefault testHandlers $ const $ do + final <- try $ recovering' retryPolicyDefault testHandlers $ const $ do maskingState' <- EX.getMaskingState maskingState' @?= maskingState fail "Retrying..." @@ -248,7 +270,7 @@ maskingState @?= EX.MaskedInterruptible return shouldRetry ] - final <- try $ recovering retryPolicyDefault checkMaskingStateHandlers $ const $ fail "Retrying..." + final <- try $ recovering' retryPolicyDefault checkMaskingStateHandlers $ const $ fail "Retrying..." assertBool ("Expected EX.IOException but didn't get one") (isLeft (final :: Either EX.IOException ())) @@ -304,12 +326,19 @@ ------------------------------------------------------------------------------- quadraticDelayTests :: TestTree -quadraticDelayTests = testGroup "quadratic delay" +quadraticDelayTests = quadraticDelayTestsWith recovering + + +quadraticDelayTestsWith + :: Monad m + => (RetryPolicyM m -> [RetryStatus -> Handler IO Bool] -> (a -> IO b) -> IO ()) + -> TestTree +quadraticDelayTestsWith recovering' = testGroup "quadratic delay" [ testProperty "recovering test with quadratic retry delay" $ property $ do startTime <- liftIO getCurrentTime timeout <- forAll (Gen.int (Range.linear 0 15)) retries <- forAll (Gen.int (Range.linear 0 8)) - res <- liftIO $ try $ recovering + res <- liftIO $ try $ recovering' (exponentialBackoff timeout <> limitRetries retries) [const $ Handler (\(_::SomeException) -> return True)] (const $ throwM (userError "booo")) @@ -389,68 +418,68 @@ () ] ] - where - retryingTest - :: (RetryStatus -> RetryPolicyM IO -> p -> (RetryStatus -> IO ()) -> IO ()) - -> p - -> IO () - retryingTest resumableOp isRetryNeeded = do - counterRef <- newIORef (0 :: Int) - - let go policy status = do - atomicWriteIORef counterRef 0 - resumableOp - status - policy - isRetryNeeded - (const $ atomicModifyIORef' counterRef $ \n -> (1 + n, ())) - - let policy = limitRetries 2 - let nextStatus = nextStatusUsingPolicy policy - - go policy defaultRetryStatus - (3 @=?) =<< readIORef counterRef - - go policy =<< nextStatus defaultRetryStatus - (2 @=?) =<< readIORef counterRef - - go policy =<< nextStatus =<< nextStatus defaultRetryStatus - (1 @=?) =<< readIORef counterRef - - recoveringTest - :: (RetryStatus -> RetryPolicyM IO -> handlers -> (RetryStatus -> IO ()) -> IO ()) - -> handlers - -> IO () - recoveringTest resumableOp handlers = do - counterRef <- newIORef (0 :: Int) - - let go policy status = do - action <- do - mkFailUntilIO - (\_ -> atomicModifyIORef' counterRef $ \n -> (1 + n, False)) - Custom1 - try $ resumableOp status policy handlers action - - let policy = limitRetries 2 - let nextStatus = nextStatusUsingPolicy policy - do - atomicWriteIORef counterRef 0 - res <- go policy defaultRetryStatus - res @?= Left Custom1 - (3 @=?) =<< readIORef counterRef - - do - atomicWriteIORef counterRef 0 - res <- go policy =<< nextStatus defaultRetryStatus - res @?= Left Custom1 - (2 @=?) =<< readIORef counterRef +retryingTest + :: (RetryStatus -> RetryPolicyM IO -> p -> (RetryStatus -> IO ()) -> IO ()) + -> p + -> IO () +retryingTest resumableOp isRetryNeeded = do + counterRef <- newIORef (0 :: Int) - do + let go policy status = do atomicWriteIORef counterRef 0 - res <- go policy =<< nextStatus =<< nextStatus defaultRetryStatus - res @?= Left Custom1 - (1 @=?) =<< readIORef counterRef + resumableOp + status + policy + isRetryNeeded + (const $ atomicModifyIORef' counterRef $ \n -> (1 + n, ())) + + let policy = limitRetries 2 + let nextStatus = nextStatusUsingPolicy policy + + go policy defaultRetryStatus + (3 @=?) =<< readIORef counterRef + + go policy =<< nextStatus defaultRetryStatus + (2 @=?) =<< readIORef counterRef + + go policy =<< nextStatus =<< nextStatus defaultRetryStatus + (1 @=?) =<< readIORef counterRef + +recoveringTest + :: (RetryStatus -> RetryPolicyM IO -> handlers -> (RetryStatus -> IO ()) -> IO ()) + -> handlers + -> IO () +recoveringTest resumableOp handlers = do + counterRef <- newIORef (0 :: Int) + + let go policy status = do + action <- do + mkFailUntilIO + (\_ -> atomicModifyIORef' counterRef $ \n -> (1 + n, False)) + Custom1 + try $ resumableOp status policy handlers action + + let policy = limitRetries 2 + let nextStatus = nextStatusUsingPolicy policy + + do + atomicWriteIORef counterRef 0 + res <- go policy defaultRetryStatus + res @?= Left Custom1 + (3 @=?) =<< readIORef counterRef + + do + atomicWriteIORef counterRef 0 + res <- go policy =<< nextStatus defaultRetryStatus + res @?= Left Custom1 + (2 @=?) =<< readIORef counterRef + + do + atomicWriteIORef counterRef 0 + res <- go policy =<< nextStatus =<< nextStatus defaultRetryStatus + res @?= Left Custom1 + (1 @=?) =<< readIORef counterRef ------------------------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.2.1/test/Tests/UnliftIO/Retry.hs new/retry-0.9.3.0/test/Tests/UnliftIO/Retry.hs --- old/retry-0.9.2.1/test/Tests/UnliftIO/Retry.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/retry-0.9.3.0/test/Tests/UnliftIO/Retry.hs 2022-07-15 22:16:51.000000000 +0200 @@ -0,0 +1,55 @@ +module Tests.UnliftIO.Retry + ( tests + ) where + +------------------------------------------------------------------------------- +import Test.Tasty +import Test.Tasty.HUnit (testCase) +------------------------------------------------------------------------------- +import UnliftIO.Retry +import Tests.Control.Retry hiding (tests) +------------------------------------------------------------------------------- + + +tests :: TestTree +tests = testGroup "UnliftIO.Retry" + [ recoveringTests + , maskingStateTests + , quadraticDelayTests + , resumableTests + ] + + +------------------------------------------------------------------------------- +recoveringTests :: TestTree +recoveringTests = recoveringTestsWith recovering + + +------------------------------------------------------------------------------- +maskingStateTests :: TestTree +maskingStateTests = maskingStateTestsWith recovering + + +------------------------------------------------------------------------------- +quadraticDelayTests :: TestTree +quadraticDelayTests = quadraticDelayTestsWith recovering + + +------------------------------------------------------------------------------- +resumableTests :: TestTree +resumableTests = testGroup "resumable" + [ testGroup "resumeRecovering" + [ testCase "can resume" $ do + recoveringTest resumeRecovering testHandlers + ] + , testGroup "resumeRecoveringDynamic" + [ testCase "can resume" $ do + recoveringTest resumeRecoveringDynamic testHandlersDynamic + ] + , testGroup "resumeRecoverAll" + [ testCase "can resume" $ do + recoveringTest + (\status policy () action -> resumeRecoverAll status policy action) + () + ] + ]
