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-01 21:30:25 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-retry (Old) and /work/SRC/openSUSE:Factory/.ghc-retry.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-retry" Mon Aug 1 21:30:25 2022 rev:5 rq:987084 version:0.9.2.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-retry/ghc-retry.changes 2022-02-11 23:11:30.471310110 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-retry.new.1533/ghc-retry.changes 2022-08-01 21:30:45.845719319 +0200 @@ -1,0 +2,14 @@ +Fri May 20 23:02:15 UTC 2022 - Peter Simons <psim...@suse.com> + +- Update retry to version 0.9.2.1. + 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) + +------------------------------------------------------------------- +Wed Mar 2 20:25:59 UTC 2022 - Peter Simons <psim...@suse.com> + +- Update retry to version 0.9.2.0. + 0.9.2.0 + * Add `retryOnError` [PR 44](https://github.com/Soostone/retry/pull/44) + +------------------------------------------------------------------- Old: ---- retry-0.9.1.0.tar.gz New: ---- retry-0.9.2.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-retry.spec ++++++ --- /var/tmp/diff_new_pack.itAjQe/_old 2022-08-01 21:30:46.381720856 +0200 +++ /var/tmp/diff_new_pack.itAjQe/_new 2022-08-01 21:30:46.385720868 +0200 @@ -19,7 +19,7 @@ %global pkg_name retry %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.9.1.0 +Version: 0.9.2.1 Release: 0 Summary: Retry combinators for monadic actions that may fail License: BSD-3-Clause @@ -27,6 +27,8 @@ Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel BuildRequires: ghc-exceptions-devel +BuildRequires: ghc-mtl-compat-devel +BuildRequires: ghc-mtl-devel BuildRequires: ghc-random-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-transformers-devel @@ -34,7 +36,6 @@ %if %{with tests} BuildRequires: ghc-HUnit-devel BuildRequires: ghc-hedgehog-devel -BuildRequires: ghc-mtl-devel BuildRequires: ghc-stm-devel BuildRequires: ghc-tasty-devel BuildRequires: ghc-tasty-hedgehog-devel ++++++ retry-0.9.1.0.tar.gz -> retry-0.9.2.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.1.0/README.md new/retry-0.9.2.1/README.md --- old/retry-0.9.1.0/README.md 2018-08-14 17:09:35.000000000 +0200 +++ new/retry-0.9.2.1/README.md 2022-03-02 21:25:19.000000000 +0100 @@ -11,7 +11,6 @@ with IO and similar actions that often fail. Common examples are database queries and large file uploads. - ## Documentation Please see haddocks for documentation. @@ -24,7 +23,6 @@ Ozgun Ataman, Soostone Inc - ## Contributors Contributors, please list yourself here. @@ -33,5 +31,5 @@ - John Wiegley - Michael Snoyman - Michael Xavier +- Toralf Wittner - Marco Zocca (@ocramz) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.1.0/changelog.md new/retry-0.9.2.1/changelog.md --- old/retry-0.9.1.0/changelog.md 2022-01-26 00:16:12.000000000 +0100 +++ new/retry-0.9.2.1/changelog.md 2022-05-21 01:01:11.000000000 +0200 @@ -1,3 +1,9 @@ +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) + +0.9.2.0 +* Add `retryOnError` [PR 44](https://github.com/Soostone/retry/pull/44) + 0.9.1.0 * Add resumable retry/recover variants: * `resumeRetrying` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.1.0/retry.cabal new/retry-0.9.2.1/retry.cabal --- old/retry-0.9.1.0/retry.cabal 2022-01-26 00:21:01.000000000 +0100 +++ new/retry-0.9.2.1/retry.cabal 2022-05-21 01:01:22.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.1.0 +version: 0.9.2.1 synopsis: Retry combinators for monadic actions that may fail license: BSD3 license-file: LICENSE @@ -41,6 +41,8 @@ , ghc-prim , random >= 1 , transformers + , mtl + , mtl-compat hs-source-dirs: src default-language: Haskell2010 @@ -67,10 +69,11 @@ , tasty , tasty-hunit , tasty-hedgehog - , hedgehog + , hedgehog >= 1.0 , stm , ghc-prim , mtl + , mtl-compat default-language: Haskell2010 if flag(lib-Werror) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.1.0/src/Control/Retry.hs new/retry-0.9.2.1/src/Control/Retry.hs --- old/retry-0.9.1.0/src/Control/Retry.hs 2022-01-26 00:16:12.000000000 +0100 +++ new/retry-0.9.2.1/src/Control/Retry.hs 2022-05-21 01:00:15.000000000 +0200 @@ -4,6 +4,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ViewPatterns #-} @@ -59,6 +60,7 @@ , skipAsyncExceptions , logRetries , defaultLogMsg + , retryOnError -- ** Resumable variants , resumeRetrying , resumeRetryingDynamic @@ -93,8 +95,9 @@ #endif import Control.Monad import Control.Monad.Catch -import Control.Monad.IO.Class -import Control.Monad.Trans.Class +import Control.Monad.Except +import Control.Monad.IO.Class as MIO +import Control.Monad.Trans.Class as TC import Control.Monad.Trans.Maybe import Control.Monad.Trans.State import Data.List (foldl') @@ -280,7 +283,7 @@ -- | Apply policy and delay by its amount if it results in a retry. -- Return updated status. applyAndDelay - :: MonadIO m + :: MIO.MonadIO m => RetryPolicyM m -> RetryStatus -> m (Maybe RetryStatus) @@ -817,13 +820,38 @@ ------------------------------------------------------------------------------- +retryOnError + :: (Functor m, MonadIO m, MonadError e m) + => RetryPolicyM m + -- ^ Policy + -> (RetryStatus -> e -> m Bool) + -- ^ Should an error be retried? + -> (RetryStatus -> m a) + -- ^ Action to perform + -> m a +retryOnError policy chk f = go defaultRetryStatus + where + go stat = do + res <- (Right <$> f stat) `catchError` (\e -> Left . (e, ) <$> chk stat e) + case res of + Right x -> return x + Left (e, True) -> do + mstat' <- applyAndDelay policy stat + case mstat' of + Just stat' -> do + go $! stat' + Nothing -> throwError e + Left (e, False) -> throwError e + + +------------------------------------------------------------------------------- -- | Run given policy up to N iterations and gather results. In the -- pair, the @Int@ is the iteration number and the @Maybe Int@ is the -- delay in microseconds. simulatePolicy :: Monad m => Int -> RetryPolicyM m -> m [(Int, Maybe Int)] simulatePolicy n (RetryPolicyM f) = flip evalStateT defaultRetryStatus $ forM [0..n] $ \i -> do stat <- get - delay <- lift (f stat) + delay <- TC.lift (f stat) put $! stat { rsIterNumber = i + 1 , rsCumulativeDelay = rsCumulativeDelay stat `boundedPlus` fromMaybe 0 delay diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.9.1.0/test/Tests/Control/Retry.hs new/retry-0.9.2.1/test/Tests/Control/Retry.hs --- old/retry-0.9.1.0/test/Tests/Control/Retry.hs 2022-01-26 00:16:12.000000000 +0100 +++ new/retry-0.9.2.1/test/Tests/Control/Retry.hs 2022-03-02 21:25:19.000000000 +0100 @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} module Tests.Control.Retry ( tests ) where @@ -12,8 +13,9 @@ import Control.Concurrent.STM as STM import qualified Control.Exception as EX import Control.Monad.Catch +import Control.Monad.Except import Control.Monad.Identity -import Control.Monad.IO.Class +import Control.Monad.IO.Class as MIO import Control.Monad.Writer.Strict import Data.Either import Data.IORef @@ -48,6 +50,7 @@ , limitRetriesByCumulativeDelayTests , overridingDelayTests , resumableTests + , retryOnErrorTests ] @@ -451,6 +454,22 @@ ------------------------------------------------------------------------------- +retryOnErrorTests :: TestTree +retryOnErrorTests = testGroup "retryOnError" + [ testCase "passes in the error type" $ do + errCalls <- newTVarIO [] + let policy = limitRetries 2 + let shouldWeRetry _retryStat e = do + liftIO (atomically (modifyTVar' errCalls (++ [e]))) + return True + let action rs = (throwError ("boom" ++ show (rsIterNumber rs))) + res <- runExceptT (retryOnError policy shouldWeRetry action) + res @?= (Left "boom2" :: Either String ()) + calls <- atomically (readTVar errCalls) + calls @?= ["boom0", "boom1", "boom2"] + ] + +------------------------------------------------------------------------------- nextStatusUsingPolicy :: RetryPolicyM IO -> RetryStatus -> IO RetryStatus nextStatusUsingPolicy policy status = do applyPolicy policy status >>= \case @@ -513,7 +532,7 @@ ------------------------------------------------------------------------------- -- | Generate an arbitrary 'RetryPolicy' without any limits applied. genPolicyNoLimit - :: forall mg mr. (MonadGen mg, MonadIO mr) + :: forall mg mr. (MonadGen mg, MIO.MonadIO mr) => Range Int -> mg (RetryPolicyM mr) genPolicyNoLimit durationRange =
