As mentioned in the comment, I needed to retry the initialization portion of a function following the bracket pattern. So, once initialization is successful, I need to reset the counter. Since there's no way for the user of recovering to modify the counter value, I'm using this:
{-# LANGUAGE ViewPatterns #-}
import Control.Concurrent
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Retry
import Data.Function (fix)
import Data.IORef
import Prelude hiding (catch)
-- | Run an action and recover from a raised exception by potentially
-- retrying the action a number of times. This behaves the same as
-- 'recovering', except it also provides the action the ability to
-- reset the retry counter. This is useful when recovering from
-- exceptions that occur during the initialization of with-* style
-- functions which follow the bracket pattern.
recoveringWithReset
:: (MonadIO m, MonadMask m)
=> RetryPolicy
-- ^ Just use 'def' for default settings
-> [(Int -> Handler m Bool)]
-- ^ Should a given exception be retried? Action will be
-- retried if this returns True.
-> (IO () -> m a)
-- ^ Action to perform. The @IO ()@ action resets the retry
-- counter.
-> m a
recoveringWithReset (RetryPolicy policy) hs f = mask $ \restore -> do
counter <- liftIO $ newIORef 0
fix $ \loop -> do
r <- try $ restore (f (writeIORef counter 0))
case r of
Right x -> return x
Left e -> do
n <- liftIO $ readIORef counter
let recover [] = throwM e
recover ((($ n) -> Handler h) : hs')
| Just e' <- fromException e = do
chk <- h e'
if chk
then case policy n of
Just delay -> do
liftIO $ threadDelay delay
liftIO $ writeIORef counter $! n + 1
loop
Nothing -> throwM e'
else throwM e'
| otherwise = recover hs'
recover hsOne thing to point out about this implementation is that the reset action must be called during the execution of f. Results are undefined if called concurrently.
I have no opinion about the API / naming here. Another possibility would be to provide direct access to the counter.
As mentioned in the comment, I needed to retry the initialization portion of a function following the bracket pattern. So, once initialization is successful, I need to reset the counter. Since there's no way for the user of
recoveringto modify the counter value, I'm using this:{-# LANGUAGE ViewPatterns #-} import Control.Concurrent import Control.Monad.Catch import Control.Monad.IO.Class import Control.Retry import Data.Function (fix) import Data.IORef import Prelude hiding (catch) -- | Run an action and recover from a raised exception by potentially -- retrying the action a number of times. This behaves the same as -- 'recovering', except it also provides the action the ability to -- reset the retry counter. This is useful when recovering from -- exceptions that occur during the initialization of with-* style -- functions which follow the bracket pattern. recoveringWithReset :: (MonadIO m, MonadMask m) => RetryPolicy -- ^ Just use 'def' for default settings -> [(Int -> Handler m Bool)] -- ^ Should a given exception be retried? Action will be -- retried if this returns True. -> (IO () -> m a) -- ^ Action to perform. The @IO ()@ action resets the retry -- counter. -> m a recoveringWithReset (RetryPolicy policy) hs f = mask $ \restore -> do counter <- liftIO $ newIORef 0 fix $ \loop -> do r <- try $ restore (f (writeIORef counter 0)) case r of Right x -> return x Left e -> do n <- liftIO $ readIORef counter let recover [] = throwM e recover ((($ n) -> Handler h) : hs') | Just e' <- fromException e = do chk <- h e' if chk then case policy n of Just delay -> do liftIO $ threadDelay delay liftIO $ writeIORef counter $! n + 1 loop Nothing -> throwM e' else throwM e' | otherwise = recover hs' recover hsOne thing to point out about this implementation is that the reset action must be called during the execution of
f. Results are undefined if called concurrently.I have no opinion about the API / naming here. Another possibility would be to provide direct access to the counter.