retry-effectful (empty) → 0.1.0.0

raw patch · 6 files changed

+375/−0 lines, 6 filesdep +basedep +effectful-coredep +exceptions

Dependencies added: base, effectful-core, exceptions, retry, retry-effectful, tasty, tasty-hunit

Files

CHANGELOG.md +4/−0
LICENSE.md +31/−0
README.md +6/−0
retry-effectful.cabal +58/−0
src/Effectful/Retry.hs +245/−0
test/Main.hs +31/−0

+ CHANGELOG.md view

@@ -0,0 +1,4 @@+# CHANGELOG++## v0.1.0.0+* Initial release

+ LICENSE.md view

@@ -0,0 +1,31 @@+Copyright (c) 2022, Tristan de Cacqueray+Copyright (c) 2013, Ozgun Ataman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ozgun Ataman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,6 @@+# retry-effectful++Adaptation of the [retry][retry] library for the [effectful][effectful] ecosystem.++[retry]: https://hackage.haskell.org/package/retry+[effectful]: https://github.com/haskell-effectful/effectful

+ retry-effectful.cabal view

@@ -0,0 +1,58 @@+cabal-version:      3.0+name:               retry-effectful+version:            0.1.0.0+category:           Control+stability:          experimental+synopsis:           Adaptation of the retry library for the effectful ecosystem.+description:+  Adaptation of the @<https://hackage.haskell.org/package/retry retry>@ library for the @<https://hackage.haskell.org/package/effectful effectful>@ ecosystem.++bug-reports:        https://github.com/change-metrics/retry-effectful/issues+homepage:           https://github.com/change-metrics/retry-effectful#readme+author:             Tristan de Cacqueray+maintainer:         tdecacqu@redhat.com+copyright:          2022 Red Hat+license:            BSD-3-Clause+license-file:       LICENSE.md+build-type:         Simple+extra-source-files:+  CHANGELOG.md+  README.md++source-repository head+  type:     git+  location: https://github.com/change-metrics/retry-effectful++common common+  ghc-options:+    -Weverything -Wno-redundant-constraints -Wno-implicit-prelude+    -Wno-missing-import-lists -Wno-safe -Wno-unsafe+    -Wno-missing-safe-haskell-mode -Wno-missing-local-signatures++  if impl(ghc >=9.2)+    ghc-options: -Wno-missing-kind-signatures++  default-language: Haskell2010++library+  import:          common+  hs-source-dirs:  src+  exposed-modules: Effectful.Retry+  build-depends:+    , base            <5+    , effectful-core  >=1.0 && <3.0+    , exceptions+    , retry           >=0.9.3++test-suite retry-effectful-test+  import:         common+  ghc-options:    -rtsopts -threaded -with-rtsopts=-N+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  hs-source-dirs: test+  build-depends:+    , base            <5+    , effectful-core  >=1.0 && <3.0+    , retry-effectful+    , tasty           ^>=1.4.2+    , tasty-hunit     ^>=0.10

+ src/Effectful/Retry.hs view

@@ -0,0 +1,245 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{- | This module provides a Retry effect to adapt+ the @<https://hackage.haskell.org/package/retry retry>@ library for+ the @<https://hackage.haskell.org/package/effectful effectful>@ ecosystem.+-}+module Effectful.Retry (+    -- * Effect+    Retry,+    runRetry,++    -- * Types and Operations+    Control.Retry.RetryPolicyM (..),+    Control.Retry.retryPolicy,+    Control.Retry.retryPolicyDefault,+    Control.Retry.RetryAction (..),+    Control.Retry.toRetryAction,+    Control.Retry.RetryStatus (..),+    Control.Retry.defaultRetryStatus,+    Effectful.Retry.applyPolicy,+    Effectful.Retry.applyAndDelay,++    -- * Applying Retry Policies+    Effectful.Retry.retrying,+    Effectful.Retry.retryingDynamic,+    Effectful.Retry.recovering,+    Effectful.Retry.recoveringDynamic,+    Effectful.Retry.stepping,+    Effectful.Retry.recoverAll,+    Effectful.Retry.skipAsyncExceptions,+    Effectful.Retry.logRetries,+    Control.Retry.defaultLogMsg,+    -- Effectful.Retry.retryOnError,++    -- * Resumable variants+    Effectful.Retry.resumeRetrying,+    Effectful.Retry.resumeRetryingDynamic,+    Effectful.Retry.resumeRecovering,+    Effectful.Retry.resumeRecoveringDynamic,+    Effectful.Retry.resumeRecoverAll,++    -- * Retry Policies+    Control.Retry.constantDelay,+    Control.Retry.exponentialBackoff,+    Control.Retry.fullJitterBackoff,+    Control.Retry.fibonacciBackoff,+    Control.Retry.limitRetries,++    -- * Policy Transformers+    Control.Retry.limitRetriesByDelay,+    Control.Retry.limitRetriesByCumulativeDelay,+    Control.Retry.capDelay,++    -- * Development Helpers+    Control.Retry.simulatePolicy,+    Control.Retry.simulatePolicyPP,+) where++import Effectful+import Effectful.Dispatch.Static+import Effectful.Internal.Env (Env)++import Control.Exception (AsyncException, SomeAsyncException)+import Control.Monad.Catch+import Control.Retry++-- | An empty effect to provide the retry requirements, e.g. MonadIO and MonadMask+data Retry :: Effect++type instance DispatchOf Retry = 'Static 'WithSideEffects+data instance StaticRep Retry = Retry++-- | Peel the 'Retry' effect.+runRetry :: IOE :> es => Eff (Retry : es) a -> Eff es a+runRetry = evalStaticRep Retry++-- effect helper+policyIO :: Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO+policyIO env (RetryPolicyM policy) = RetryPolicyM $ \s -> unEff (policy s) env++-- effect helper+handlerIO :: Env es -> Handler (Eff es) a -> Handler IO a+handlerIO env (Handler handler) = Handler $ \e -> unEff (handler e) env++-- wrappers+applyPolicy :: Retry :> es => RetryPolicyM (Eff es) -> RetryStatus -> Eff es (Maybe RetryStatus)+applyPolicy policy status = unsafeEff $ \env -> Control.Retry.applyPolicy (policyIO env policy) status++applyAndDelay :: Retry :> es => RetryPolicyM (Eff es) -> RetryStatus -> Eff es (Maybe RetryStatus)+applyAndDelay policy status = unsafeEff $ \env -> Control.Retry.applyAndDelay (policyIO env policy) status++retrying ::+    Retry :> es =>+    RetryPolicyM (Eff es) ->+    (RetryStatus -> b -> Eff es Bool) ->+    (RetryStatus -> Eff es b) ->+    Eff es b+retrying = Effectful.Retry.resumeRetrying defaultRetryStatus++retryingDynamic ::+    Retry :> es =>+    RetryPolicyM (Eff es) ->+    (RetryStatus -> b -> Eff es RetryAction) ->+    (RetryStatus -> Eff es b) ->+    Eff es b+retryingDynamic = Effectful.Retry.resumeRetryingDynamic defaultRetryStatus++resumeRetrying ::+    Retry :> es =>+    RetryStatus ->+    RetryPolicyM (Eff es) ->+    (RetryStatus -> b -> Eff es Bool) ->+    (RetryStatus -> Eff es b) ->+    Eff es b+resumeRetrying retryStatus policy chk =+    Effectful.Retry.resumeRetryingDynamic+        retryStatus+        policy+        (\rs -> fmap toRetryAction . chk rs)++resumeRetryingDynamic ::+    Retry :> es =>+    RetryStatus ->+    RetryPolicyM (Eff es) ->+    (RetryStatus -> b -> Eff es RetryAction) ->+    (RetryStatus -> Eff es b) ->+    Eff es b+resumeRetryingDynamic retryStatus policy chk f =+    unsafeEff $ \env ->+        Control.Retry.resumeRetryingDynamic+            retryStatus+            (policyIO env policy)+            (\rs b -> unEff (chk rs b) env)+            (\rs -> unEff (f rs) env)++recovering ::+    Retry :> es =>+    RetryPolicyM (Eff es) ->+    [RetryStatus -> Handler (Eff es) Bool] ->+    (RetryStatus -> Eff es a) ->+    Eff es a+recovering = Effectful.Retry.resumeRecovering defaultRetryStatus++resumeRecovering ::+    Retry :> es =>+    RetryStatus ->+    RetryPolicyM (Eff es) ->+    [RetryStatus -> Handler (Eff es) Bool] ->+    (RetryStatus -> Eff es a) ->+    Eff es a+resumeRecovering retryStatus policy hs =+    Effectful.Retry.resumeRecoveringDynamic retryStatus policy hs'+  where+    hs' = map (fmap toRetryAction .) hs++recoveringDynamic ::+    Retry :> es =>+    RetryPolicyM (Eff es) ->+    [RetryStatus -> Handler (Eff es) RetryAction] ->+    (RetryStatus -> Eff es a) ->+    Eff es a+recoveringDynamic = Effectful.Retry.resumeRecoveringDynamic defaultRetryStatus++resumeRecoveringDynamic ::+    Retry :> es =>+    RetryStatus ->+    RetryPolicyM (Eff es) ->+    [RetryStatus -> Handler (Eff es) RetryAction] ->+    (RetryStatus -> Eff es a) ->+    Eff es a+resumeRecoveringDynamic retryStatus policy hs f =+    unsafeEff $ \env ->+        Control.Retry.resumeRecoveringDynamic+            retryStatus+            (policyIO env policy)+            (fmap (handlerIO env) <$> hs)+            (\rs -> unEff (f rs) env)++stepping ::+    Retry :> es =>+    RetryPolicyM (Eff es) ->+    [RetryStatus -> Handler (Eff es) Bool] ->+    (RetryStatus -> Eff es ()) ->+    (RetryStatus -> Eff es a) ->+    RetryStatus ->+    Eff es (Maybe a)+stepping policy hs schedule f s =+    unsafeEff $ \env ->+        Control.Retry.stepping+            (policyIO env policy)+            (fmap (handlerIO env) <$> hs)+            (\rs -> unEff (schedule rs) env)+            (\rs -> unEff (f rs) env)+            s++recoverAll ::+    Retry :> es =>+    RetryPolicyM (Eff es) ->+    (RetryStatus -> Eff es a) ->+    Eff es a+recoverAll = Effectful.Retry.resumeRecoverAll defaultRetryStatus++resumeRecoverAll :: Retry :> es => RetryStatus -> RetryPolicyM (Eff es) -> (RetryStatus -> Eff es a) -> Eff es a+resumeRecoverAll retryStatus policy f =+    unsafeEff $ \env ->+        Control.Retry.resumeRecoverAll+            retryStatus+            (policyIO env policy)+            (\rs -> unEff (f rs) env)++skipAsyncExceptions ::+    Retry :> es =>+    [RetryStatus -> Handler (Eff es) Bool]+skipAsyncExceptions = [asyncH, someAsyncH]+  where+    asyncH _ = Handler $ \(_ :: AsyncException) -> return False+    someAsyncH _ = Handler $ \(_ :: SomeAsyncException) -> return False++logRetries ::+    (Retry :> es, Exception e) =>+    (e -> Eff es Bool) ->+    (Bool -> e -> RetryStatus -> Eff es ()) ->+    RetryStatus ->+    Handler (Eff es) Bool+logRetries test reporter status = Handler $ \err -> do+    result <- test err+    reporter result err status+    return result++{- TODO+retryOnError+    :: (Error e :> es, Retry :> es)+    => RetryPolicyM (Eff es)+    -> (RetryStatus -> e -> Eff es Bool)+    -> (RetryStatus -> Eff es a)+    -> Eff es a+retryOnError policy chk f = go defaultRetryStatus+  where+    go stat = do+-}

+ test/Main.hs view

@@ -0,0 +1,31 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Main (main) where++import Effectful+import Effectful.Retry+import Test.Tasty+import Test.Tasty.HUnit++main :: IO ()+main =+    defaultMain $+        testGroup+            "retry-effectful"+            [ testCase "`retrying` works" $ do+                res <- runRetryEff testRetrying+                assertEqual "match" res 42+            ]++runRetryEff :: Eff '[Retry, IOE] a -> IO a+runRetryEff = runEff . runRetry++testRetrying :: '[Retry] :>> es => Eff es Int+testRetrying = do+    retrying (constantDelay 100) chk (const $ pure 42)+  where+    chk _ 42 = pure False+    chk _ _ = pure True