commit ghc-retry for openSUSE:Factory
Hello community, here is the log from the commit of package ghc-retry for openSUSE:Factory checked in at 2016-01-21 23:43:21 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-retry (Old) and /work/SRC/openSUSE:Factory/.ghc-retry.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-retry" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-retry/ghc-retry.changes 2016-01-08 15:22:47.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-retry.new/ghc-retry.changes 2016-01-22 01:08:27.000000000 +0100 @@ -1,0 +2,10 @@ +Fri Jan 15 10:08:09 UTC 2016 - mimi.vx@gmail.com + +- update to 0.7.1 +* Various documentation updates. +* Add stepping combinator for manual retries. +* Add applyPolicy and applyAndDelay +* Add Read instance for RetryStatus +* Fix logic bug in rsPreviousDelay in first retry + +------------------------------------------------------------------- Old: ---- retry-0.7.0.1.tar.gz New: ---- retry-0.7.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-retry.spec ++++++ --- /var/tmp/diff_new_pack.PLGn45/_old 2016-01-22 01:08:29.000000000 +0100 +++ /var/tmp/diff_new_pack.PLGn45/_new 2016-01-22 01:08:29.000000000 +0100 @@ -20,7 +20,7 @@ %bcond_with tests Name: ghc-retry -Version: 0.7.0.1 +Version: 0.7.1 Release: 0 Summary: Retry combinators for monadic actions that may fail Group: System/Libraries ++++++ retry-0.7.0.1.tar.gz -> retry-0.7.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.7.0.1/changelog.md new/retry-0.7.1/changelog.md --- old/retry-0.7.0.1/changelog.md 2015-11-15 01:28:27.000000000 +0100 +++ new/retry-0.7.1/changelog.md 2016-01-13 18:40:22.000000000 +0100 @@ -1,3 +1,10 @@ +0.7.1 +* Various documentation updates. +* Add stepping combinator for manual retries. +* Add applyPolicy and applyAndDelay +* Add Read instance for RetryStatus +* Fix logic bug in rsPreviousDelay in first retry + 0.7.0.1 * Officially drop support for GHC < 7.6 due to usage of Generics. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.7.0.1/retry.cabal new/retry-0.7.1/retry.cabal --- old/retry-0.7.0.1/retry.cabal 2015-11-15 01:28:27.000000000 +0100 +++ new/retry-0.7.1/retry.cabal 2016-01-13 18:40:22.000000000 +0100 @@ -14,7 +14,7 @@ case we should hang back for a bit and retry the query instead of simply raising an exception. -version: 0.7.0.1 +version: 0.7.1 synopsis: Retry combinators for monadic actions that may fail license: BSD3 license-file: LICENSE diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/retry-0.7.0.1/src/Control/Retry.hs new/retry-0.7.1/src/Control/Retry.hs --- old/retry-0.7.0.1/src/Control/Retry.hs 2015-11-15 01:28:27.000000000 +0100 +++ new/retry-0.7.1/src/Control/Retry.hs 2016-01-13 18:40:22.000000000 +0100 @@ -32,12 +32,11 @@ RetryPolicyM (..) , RetryPolicy , retryPolicy - , RetryStatus - -- ** Fields for 'RetryStatus' - , rsIterNumber - , rsCumulativeDelay - , rsPreviousDelay + , RetryStatus (..) , defaultRetryStatus + , applyPolicy + , applyAndDelay + -- ** Lenses for 'RetryStatus' , rsIterNumberL @@ -47,6 +46,7 @@ -- * Applying Retry Policies , retrying , recovering + , stepping , recoverAll , logRetries @@ -162,8 +162,8 @@ data RetryStatus = RetryStatus { rsIterNumber :: !Int -- ^ Iteration number, where 0 is the first try , rsCumulativeDelay :: !Int -- ^ Delay incurred so far from retries in microseconds - , rsPreviousDelay :: !(Maybe Int) -- ^ Previous attempt's delay. Will always be Nothing on first run. - } deriving (Show, Eq, Generic) + , rsPreviousDelay :: !(Maybe Int) -- ^ Latest attempt's delay. Will always be Nothing on first run. + } deriving (Read, Show, Eq, Generic) ------------------------------------------------------------------------------- @@ -190,6 +190,45 @@ {-# INLINE rsPreviousDelayL #-} + +------------------------------------------------------------------------------- +-- | Apply policy on status to see what the decision would be. +-- 'Nothing' implies no retry, 'Just' returns updated status. +applyPolicy + :: Monad m + => RetryPolicyM m + -> RetryStatus + -> m (Maybe RetryStatus) +applyPolicy (RetryPolicyM policy) s = do + res <- policy s + case res of + Just delay -> return $! Just $! RetryStatus + { rsIterNumber = rsIterNumber s + 1 + , rsCumulativeDelay = rsCumulativeDelay s + delay + , rsPreviousDelay = Just delay } + Nothing -> return Nothing + + +------------------------------------------------------------------------------- +-- | Apply policy and delay by its amount if it results in a retry. +-- Return updated status. +applyAndDelay + :: MonadIO m + => RetryPolicyM m + -> RetryStatus + -> m (Maybe RetryStatus) +applyAndDelay policy s = do + chk <- applyPolicy policy s + case chk of + Just rs -> do + case (rsPreviousDelay rs) of + Nothing -> return () + Just delay -> liftIO $ threadDelay delay + return (Just rs) + Nothing -> return Nothing + + + ------------------------------------------------------------------------------- -- | Helper for making simplified policies that don't use the monadic -- context. @@ -314,21 +353,17 @@ -> (RetryStatus -> m b) -- ^ Action to run -> m b -retrying (RetryPolicyM policy) chk f = go defaultRetryStatus +retrying policy chk f = go defaultRetryStatus where go s = do res <- f s chk' <- chk s res case chk' of True -> do - chk <- policy s - case chk of - Just delay -> do - liftIO (threadDelay delay) - go $! RetryStatus { rsIterNumber = rsIterNumber s + 1 - , rsCumulativeDelay = rsCumulativeDelay s + delay - , rsPreviousDelay = Just (maybe 0 (const delay) (rsPreviousDelay s))} + rs <- applyAndDelay policy s + case rs of Nothing -> return res + Just rs' -> go $! rs' False -> return res @@ -386,21 +421,21 @@ -- 'recoverAll' recovering #if MIN_VERSION_exceptions(0, 6, 0) - :: (MonadIO m, MonadMask m) + :: (MonadIO m, MonadMask m) #else - :: (MonadIO m, MonadCatch m) + :: (MonadIO m, MonadCatch m) #endif - => RetryPolicyM m - -- ^ Just use 'def' 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 p@(RetryPolicyM policy) hs f = mask $ \restore -> go restore defaultRetryStatus + => RetryPolicyM m + -- ^ Just use 'def' 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 policy hs f = mask $ \restore -> go restore defaultRetryStatus where go restore = loop where @@ -416,18 +451,62 @@ chk <- h e' case chk of True -> do - res <- policy s - case res of - Just delay -> do - liftIO $ threadDelay delay - loop $! RetryStatus { rsIterNumber = rsIterNumber s + 1 - , rsCumulativeDelay = rsCumulativeDelay s + delay - , rsPreviousDelay = Just (maybe 0 (const delay) (rsPreviousDelay s))} + rs <- applyAndDelay policy s + case rs of + Just rs' -> loop $! rs' Nothing -> throwM e' False -> throwM e' | otherwise = recover e hs' + +------------------------------------------------------------------------------- +-- | 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 +#if MIN_VERSION_exceptions(0, 6, 0) + :: (MonadIO m, MonadMask m) +#else + :: (MonadIO m, MonadCatch m) +#endif + => RetryPolicyM m + -- ^ Just use 'def' 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 = do + r <- try $ f s + case r of + Right x -> return $ Just x + Left e -> recover (e :: SomeException) hs + where + recover e [] = throwM e + recover e ((($ s) -> Handler h) : hs') + | Just e' <- fromException e = do + chk <- h e' + case chk of + True -> do + res <- applyPolicy policy s + case res of + Just rs -> do + schedule $! rs + return Nothing + Nothing -> throwM e' + False -> throwM e' + | otherwise = recover e hs' + + ------------------------------------------------------------------------------- -- | Helper function for constructing handler functions of the form required -- by 'recovering'.
participants (1)
-
root@hilbert.suse.de