polysemy-resume 0.5.0.0 → 0.6.0.0

raw patch · 14 files changed

+1335/−606 lines, 14 filesdep −hedgehogdep −tasty-hedgehogdep −textdep ~incipit-coredep ~polysemydep ~polysemy-pluginPVP ok

version bump matches the API change (PVP)

Dependencies removed: hedgehog, tasty-hedgehog, text

Dependency ranges changed: incipit-core, polysemy, polysemy-plugin

API changes (from Hackage documentation)

Files

• changelog.md +30/−0
• lib/Polysemy/Resume.hs +54/−6
• lib/Polysemy/Resume/Effect/Resumable.hs +1/−0
• lib/Polysemy/Resume/Effect/Stop.hs +1/−1
• lib/Polysemy/Resume/Interpreter/Resumable.hs +329/−0
• lib/Polysemy/Resume/Interpreter/Scoped.hs +374/−0
• lib/Polysemy/Resume/Interpreter/Stop.hs +254/−0
• lib/Polysemy/Resume/Resumable.hs +0/−327
• lib/Polysemy/Resume/Resume.hs +66/−26
• lib/Polysemy/Resume/Stop.hs +0/−230
• polysemy-resume.cabal +19/−14
• readme.md +205/−0
• test/Polysemy/Resume/HigherOrderTest.hs +1/−1
• test/Polysemy/Resume/Test/InterceptTest.hs +1/−1

@@ -0,0 +1,30 @@+# Unreleased++# 0.6.0.0++* Add `replaceStop`, shorthand for `mapStop . const`.+* Add `∀` to `Stop` interpreters.+* Add resumers that transform to `Fail`.+* Move `Scoped` interpreters from `polysemy-conc`, since `Scoped` is now in `polysemy`.+* Support GHC 9.4.++# 0.5.0.0++* Add interceptors.+* Change modules for effects to `Polysemy.Resume.Effect`.+* Add `stopEitherAs`.+* Add exception catching `stop` combinators.++# 0.2.0.0++* Add combinators `resumeOr` and `resumingOr`, which take an additional branch for the success case.+* Improve `raiseResumable`:+  * Don't discard resources+  * Allow interpreter to change type of `a`+* Add operator versions of `resume` (`!!`) and `resumeAs` (`<!`), (`!>`).+* Add combinators `resumeWith` and `resumingWith` that ignore the error and execute an action, plus their operator+  variants `(!>>)` and `(<<!)`.++# 0.1.0.0++* initial release

@@ -1,3 +1,4 @@+-- | Description: Polysemy effects for cross-interpreter error tracking. module Polysemy.Resume (   -- * Introduction   -- $intro@@ -15,6 +16,24 @@   resumable,   raiseResumable,   resumableIO,+  interpretScopedResumable,+  interpretScopedResumableH,+  interpretScopedResumable_,+  interpretScopedResumableWith,+  interpretScopedResumableWithH,+  interpretScopedResumableWith_,+  interpretResumableScoped,+  interpretResumableScopedH,+  interpretResumableScoped_,+  interpretResumableScopedWith,+  interpretResumableScopedWithH,+  interpretResumableScopedWith_,+  interpretScopedR,+  interpretScopedRH,+  interpretScopedR_,+  interpretScopedRWith,+  interpretScopedRWithH,+  interpretScopedRWith_,   -- * Partial Handlers   -- $partial   resumableOr,@@ -41,12 +60,36 @@   resumableFor,   runAsResumable,   catchResumable,-  module Polysemy.Resume.Stop,+  stopToFailWith,+  stopToFail,+  resumeFailWith,+  resumeFail,+  module Polysemy.Resume.Interpreter.Stop, ) where  import Polysemy.Resume.Effect.Resumable (Resumable, type (!!)) import Polysemy.Resume.Effect.Stop (Stop (..), stop)-import Polysemy.Resume.Resumable (+import Polysemy.Resume.Interpreter.Scoped (+  interpretResumableScoped,+  interpretResumableScopedH,+  interpretResumableScopedWith,+  interpretResumableScopedWithH,+  interpretResumableScopedWith_,+  interpretResumableScoped_,+  interpretScopedR,+  interpretScopedRH,+  interpretScopedRWith,+  interpretScopedRWithH,+  interpretScopedRWith_,+  interpretScopedR_,+  interpretScopedResumable,+  interpretScopedResumableH,+  interpretScopedResumableWith,+  interpretScopedResumableWithH,+  interpretScopedResumableWith_,+  interpretScopedResumable_,+  )+import Polysemy.Resume.Interpreter.Resumable (   catchResumable,   interceptResumable,   interceptResumableH,@@ -68,6 +111,8 @@   resumeAs,   resumeEither,   resumeError,+  resumeFail,+  resumeFailWith,   resumeHoist,   resumeHoistAs,   resumeHoistError,@@ -78,14 +123,17 @@   resuming,   resumingOr,   resumingWith,+  stopToFail,+  stopToFailWith,   (!!),   (!>),   (!>>),   (<!),   (<<!),   )-import Polysemy.Resume.Stop (+import Polysemy.Resume.Interpreter.Stop (   mapStop,+  replaceStop,   runStop,   showStop,   stopEither,@@ -97,10 +145,10 @@   stopToError,   stopToErrorWith,   stopToIOFinal,-  stopTryIOE,+  stopTryAny,   stopTryIO,+  stopTryIOE,   stopTryIOError,-  stopTryAny,   )  -- $intro@@ -133,7 +181,7 @@ -- -- If we want to use @Stopper@ in the interpreter of another effect, we have no way of knowing about the errors thrown -- by its interpreter, even though we can catch @Boom@!--- This library makes the connection explicit by changing 'Polysemy.Error.Error' to 'Stop' and wrapping 'Stopper' in+-- This library makes the connection explicit by changing 'Polysemy.Error.Error' to 'Stop' and wrapping @Stopper@ in -- 'Resumable' when using it in an effect stack:  -- $partial

@@ -1,3 +1,4 @@+-- |Description: The 'Resumable' effect. module Polysemy.Resume.Effect.Resumable where  import Polysemy.Internal.Union (Weaving)

@@ -1,6 +1,6 @@ {-# options_haddock prune #-} --- |Description: Internal+-- |Description: The 'Stop' effect. module Polysemy.Resume.Effect.Stop where  -- |An effect similar to 'Polysemy.Error.Error' without the ability to be caught.

@@ -0,0 +1,329 @@+{-# options_haddock prune #-}+{-# options_ghc -Wno-redundant-constraints #-}++-- | Description: Interpreters for 'Resumable'.+module Polysemy.Resume.Interpreter.Resumable where++import Polysemy.Error (Error (Throw))+import Polysemy.Internal (Sem (Sem, runSem), liftSem, usingSem)+import Polysemy.Internal.CustomErrors (FirstOrder)+import Polysemy.Internal.Tactics (liftT, runTactics)+import Polysemy.Internal.Union (ElemOf, Weaving (Weaving), decomp, hoist, inj, injWeaving, membership, prjUsing, weave)++import Polysemy.Resume.Effect.Resumable (Resumable (..))+import Polysemy.Resume.Effect.Stop (Stop, stop)+import Polysemy.Resume.Interpreter.Stop (StopExc, runStop, stopOnError, stopToIOFinal)++type InterpreterTrans' eff eff' r r' =+  ∀ a b .+  (Sem (eff' : r') a -> Sem r b) ->+  Sem (eff : r) a ->+  Sem r b++type InterpreterTrans eff eff' r =+  InterpreterTrans' eff eff' r r++distribEither ::+  Functor f =>+  f () ->+  (f (Either err a) -> res) ->+  Either err (f a) ->+  res+distribEither initialState result =+  result . \case+    Right fa -> Right <$> fa+    Left err -> Left err <$ initialState+{-# inline distribEither #-}++-- | Convert a bare interpreter for @eff@, which (potentially) uses 'Stop' to signal errors, into an interpreter for+-- 'Resumable'.+-- /Beware/: This will display unsound behaviour if:+-- * the interpreter is wrapped with actions of another effect, as in:+--+--   @+--   interpretEff :: InterpreterFor Eff r+--   ...+--+--   interpretEffResumable :: InterpreterFor (Resumable Text Eff) r+--   interpretEffResumable sem =+--   resumable (interpretEff (sem `finally` releaseResources))+--   @+--+--   In this case, @releaseResources@ will be called after /every/ use of @Eff@ in @sem@, not after the entire thunk.+--+-- * the interpreter of a higher-order effect uses a different interpreter after using @runT@/@bindT@.+--   In this case, it will use the original interpreter instead.+--+-- If your use case matches one of these conditions, you'll need to use 'interpretResumable'.+--+-- >>> run $ resumable interpretStopper (interpretResumer mainProgram)+-- 237+resumable ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .+  InterpreterFor eff (Stop err : r) ->+  InterpreterFor (Resumable err eff) r+resumable interpreter (Sem m) =+  Sem \ k -> m \ u ->+    case decomp (hoist (resumable interpreter) u) of+      Right (Weaving (Resumable e) s wv ex ins) ->+        distribEither s ex <$> runSem resultFromEff k+        where+          resultFromEff =+            runStop $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)+      Left g ->+        k g+{-# inline resumable #-}++-- | Convenience combinator for turning an interpreter that doesn't use 'Stop' into a 'Resumable'.+raiseResumable ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .+  InterpreterTrans (Resumable err eff) eff r+raiseResumable interpreter =+  interpreter . normalize . raiseUnder+  where+    normalize :: InterpreterFor (Resumable err eff) (eff : r)+    normalize (Sem m) =+      Sem \ k -> m \ u ->+        case decomp (hoist normalize u) of+          Right (Weaving (Resumable e) s wv ex ins) ->+            ex . fmap Right <$> (usingSem k $ liftSem $ weave s wv ins (injWeaving e))+          Left g ->+            k g+    {-# inline normalize #-}+{-# inline raiseResumable #-}++-- | Like 'resumable', but use exceptions instead of 'Control.Monad.Trans.ExceptT'.+resumableIO ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .+  Exception (StopExc err) =>+  Member (Final IO) r =>+  InterpreterFor eff (Stop err : r) ->+  InterpreterFor (Resumable err eff) r+resumableIO interpreter (Sem m) =+  Sem \ k -> m \ u ->+    case decomp (hoist (resumable interpreter) u) of+      Right (Weaving (Resumable e) s wv ex ins) ->+        distribEither s ex <$> runSem resultFromEff k+        where+          resultFromEff =+            stopToIOFinal $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)+      Left g ->+        k g+{-# inline resumableIO #-}++-- | Like 'interpretResumable', but for higher-order effects.+interpretResumableH ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .+  -- | This handler function has @'Stop' err@ in its stack, allowing it to absorb errors.+  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->+  InterpreterFor (Resumable err eff) r+interpretResumableH handler (Sem m) =+  Sem \ k -> m \ u ->+    case decomp u of+      Left there ->+        k (hoist (interpretResumableH handler) there)+      Right (Weaving (Resumable (Weaving e s dist ex ins)) sOuter distOuter exOuter insOuter) ->+        usingSem k (exFinal <$> runStop (tac (handler e)))+        where+          tac =+            runTactics+            (Compose (s <$ sOuter))+            (raiseUnder . fmap Compose . distOuter . fmap dist . getCompose)+            (ins <=< insOuter . getCompose)+            (raise . interpretResumableH handler . fmap Compose . distOuter . fmap dist . getCompose)+          exFinal = exOuter . \case+            Right (Compose a) -> Right . ex <$> a+            Left err -> Left err <$ sOuter+{-# inline interpretResumableH #-}++-- | Create an interpreter for @'Resumable' err eff@ by supplying a handler function for @eff@, analogous to+-- 'Polysemy.interpret'.+-- If the handler throws errors with 'Stop', they will be absorbed into 'Resumable', to be caught by+-- 'Polysemy.Resume.resume' in a downstream interpreter.+--+-- @+-- interpretStopperResumable ::+--   InterpreterFor Stopper r+-- interpretStopperResumable =+--   interpretResumable \\case+--     StopBang -> stop (Bang 13)+--     StopBoom -> stop (Boom "ouch")+-- @+--+-- >>> run $ interpretStopperResumable (interpretResumer mainProgram)+-- 237+interpretResumable ::+  ∀ (err :: Type) (eff :: Effect) r .+  FirstOrder eff "interpretResumable" =>+  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->+  InterpreterFor (Resumable err eff) r+interpretResumable handler =+  interpretResumableH \ e -> liftT (handler e)+{-# inline interpretResumable #-}++-- | Interceptor variant of 'interpretResumableH'.+interceptResumableUsingH ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .+  ElemOf (Resumable err eff) r ->+  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->+  Sem r a ->+  Sem r a+interceptResumableUsingH proof handler (Sem m) =+  Sem \ k -> m \ u ->+    case prjUsing proof u of+      Nothing ->+        k (hoist (interceptResumableUsingH proof handler) u)+      Just (Weaving (Resumable (Weaving e s dist ex ins)) sOuter distOuter exOuter insOuter) ->+        usingSem k (exFinal <$> runStop (tac (handler e)))+        where+          tac =+            runTactics+            (Compose (s <$ sOuter))+            (raise . raise . fmap Compose . distOuter . fmap dist . getCompose)+            (ins <=< insOuter . getCompose)+            (raise . interceptResumableUsingH proof handler . fmap Compose . distOuter . fmap dist . getCompose)+          exFinal = exOuter . \case+            Right (Compose a) -> Right . ex <$> a+            Left err -> Left err <$ sOuter+{-# inline interceptResumableUsingH #-}++-- | Interceptor variant of 'interpretResumable'.+interceptResumableUsing ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .+  FirstOrder eff "interceptResumableUsing" =>+  ElemOf (Resumable err eff) r ->+  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->+  Sem r a ->+  Sem r a+interceptResumableUsing proof f =+  interceptResumableUsingH proof \ e ->+    liftT (f e)+{-# inline interceptResumableUsing #-}++-- | Interceptor variant of 'interpretResumableH'.+interceptResumableH ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .+  Member (Resumable err eff) r =>+  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->+  Sem r a ->+  Sem r a+interceptResumableH =+  interceptResumableUsingH membership+{-# inline interceptResumableH #-}++-- | Interceptor variant of 'interpretResumable'.+interceptResumable ::+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .+  Member (Resumable err eff) r =>+  FirstOrder eff "interceptResumable" =>+  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->+  Sem r a ->+  Sem r a+interceptResumable f =+  interceptResumableH \ e ->+    liftT (f e)+{-# inline interceptResumable #-}++-- | Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'.+resumableError ::+  ∀ (err :: Type) (eff :: Effect) r .+  InterpreterFor eff (Error err : Stop err : r) ->+  InterpreterFor (Resumable err eff) r+resumableError interpreter =+  resumable (stopOnError . interpreter . raiseUnder)+{-# inline resumableError #-}++-- | Convert an interpreter for @eff@ that throws errors of type @err@ into a @Resumable@, but limiting the errors+-- handled by consumers to the type @handled@, which rethrowing 'Error's of type @unhandled@.+--+-- The function @canHandle@ determines how the errors are split.+--+-- @+-- newtype Blip =+--   Blip { unBlip :: Int }+--   deriving (Eq, Show)+--+-- bangOnly :: Boom -> Either Text Blip+-- bangOnly = \\case+--   Bang n -> Right (Blip n)+--   Boom msg -> Left msg+--+-- interpretResumerPartial ::+--   Member (Resumable Blip Stopper) r =>+--   InterpreterFor Resumer r+-- interpretResumerPartial =+--   interpret \\ MainProgram ->+--     resume (192 \<$ stopBang) \\ (Blip num) ->+--       pure (num * 3)+-- @+--+-- >>> runError (resumableFor bangOnly interpretStopper (interpretResumerPartial mainProgram))+-- Right 39+resumableOr ::+  ∀ (err :: Type) (eff :: Effect) unhandled handled r .+  Member (Error unhandled) r =>+  (err -> Either unhandled handled) ->+  InterpreterFor eff (Stop err : r) ->+  InterpreterFor (Resumable handled eff) r+resumableOr canHandle interpreter (Sem m) =+  Sem \ k -> m \ u ->+    case decomp (hoist (resumableOr canHandle interpreter) u) of+      Right (Weaving (Resumable e) s wv ex ins) ->+        distribEither s ex <$> (tryHandle =<< runSem resultFromEff k)+        where+          tryHandle = \case+            Left err ->+              either (k . inj . Throw) (pure . Left) (canHandle err)+            Right a ->+              pure (Right a)+          resultFromEff =+            runStop $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)+      Left g ->+        k g+{-# inline resumableOr #-}++-- | Variant of 'resumableOr' that uses 'Maybe' and rethrows the original error.+resumableFor ::+  ∀ (err :: Type) (eff :: Effect) handled r .+  Member (Error err) r =>+  (err -> Maybe handled) ->+  InterpreterFor eff (Stop err : r) ->+  InterpreterFor (Resumable handled eff) r+resumableFor canHandle =+  resumableOr canHandle'+  where+    canHandle' err =+      maybeToRight err (canHandle err)+{-# inline resumableFor #-}++-- | Reinterpreting variant of 'resumableFor'.+catchResumable ::+  ∀ (err :: Type) (eff :: Effect) handled r .+  Members [eff, Error err] r =>+  (err -> Maybe handled) ->+  InterpreterFor (Resumable handled eff) r+catchResumable canHandle (Sem m) =+  Sem \ k -> m \ u ->+    case decomp (hoist (catchResumable canHandle) u) of+      Right (Weaving (Resumable e) s wv ex ins) ->+        distribEither s ex <$> runSem resultFromEff k+        where+          resultFromEff =+            catchJust canHandle (fmap Right $ liftSem $ weave s wv ins (injWeaving e)) (pure . Left)+      Left g ->+        k g+{-# inline catchResumable #-}++-- | Interpret an effect @eff@ by wrapping it in @Resumable@ and @Stop@ and leaving the rest up to the user.+runAsResumable ::+  ∀ (err :: Type) (eff :: Effect) r .+  Members [Resumable err eff, Stop err] r =>+  InterpreterFor eff r+runAsResumable (Sem m) =+  Sem \ k -> m \ u ->+    case decomp (hoist (runAsResumable @err @eff) u) of+      Right wav ->+        runSem (either (stop @err) pure =<< send (Resumable wav)) k+      Left g ->+        k g+{-# inline runAsResumable #-}

@@ -0,0 +1,374 @@+{-# options_haddock prune #-}++-- |Description: Interpreters for 'Scoped' in combination with 'Resumable'+--+-- @since 0.6.0.0+module Polysemy.Resume.Interpreter.Scoped where++import GHC.Err (errorWithoutStackTrace)+import Polysemy.Internal (liftSem, restack)+import Polysemy.Internal.Combinators (interpretWeaving)+import Polysemy.Internal.Scoped (Scoped (InScope, Run))+import Polysemy.Internal.Sing (KnownList (singList))+import Polysemy.Internal.Tactics (liftT)+import Polysemy.Internal.Union (Weaving (Weaving), extendMembershipLeft, injWeaving, injectMembership, weave)++import Polysemy.Resume.Effect.Resumable (Resumable (Resumable), type (!!))+import Polysemy.Resume.Effect.Stop (Stop)+import Polysemy.Resume.Interpreter.Resumable (interpretResumableH)+import Polysemy.Resume.Interpreter.Stop (runStop)++exResumable ::+  Functor f =>+  f () ->+  (f (Either err a) -> x) ->+  (f' a' -> a) ->+  Sem r (Either err (f (f' a'))) ->+  Sem r x+exResumable s ex ex' =+  fmap $ ex . \case+    Right a -> Right . ex' <$> a+    Left err -> Left err <$ s+{-# inline exResumable #-}++-- |Combined higher-order interpreter for 'Scoped' and 'Resumable'.+-- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the+-- entire scope.+interpretScopedResumableH ::+  ∀ param resource effect err r .+  (∀ x . param -> (resource -> Sem (Stop err : r) x) -> Sem (Stop err : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) (Stop err : r) x) ->+  InterpreterFor (Scoped param effect !! err) r+interpretScopedResumableH withResource scopedHandler =+  interpretWeaving \case+    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do+      exResumable s ex ex' $ runStop $ withResource param \ resource ->+        interpretH (scopedHandler resource) (raiseUnder (go $ raiseUnder $ wv ((wv' (main <$ s')) <$ s)))+    _ ->+      errorWithoutStackTrace "top level run"+  where+    go :: InterpreterFor (Scoped param effect !! err) (effect : r)+    go =+      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of+        Run act ->+          ex . fmap Right <$> liftSem (weave s (go . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))+        InScope param main -> do+          exResumable s ex ex' $ raise $ runStop $ withResource param \ resource ->+            interpretH (scopedHandler resource) (raiseUnder (go $ wv (wv' (main <$ s') <$ s)))++-- |Combined interpreter for 'Scoped' and 'Resumable'.+-- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the+-- entire scope.+interpretScopedResumable ::+  ∀ param resource effect err r .+  (∀ x . param -> (resource -> Sem (Stop err : r) x) -> Sem (Stop err : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->+  InterpreterFor (Scoped param effect !! err) r+interpretScopedResumable withResource scopedHandler =+  interpretScopedResumableH withResource \ r e -> liftT (scopedHandler r e)++-- |Combined interpreter for 'Scoped' and 'Resumable'.+-- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the+-- entire scope.+-- In this variant, the resource allocator is a plain action.+interpretScopedResumable_ ::+  ∀ param resource effect err r .+  (param -> Sem (Stop err : r) resource) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->+  InterpreterFor (Scoped param effect !! err) r+interpretScopedResumable_ resource =+  interpretScopedResumable \ p use -> use =<< resource p++-- |Combined higher-order interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects+-- that are interpreted by the resource allocator.+-- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the+-- entire scope.+interpretScopedResumableWithH ::+  ∀ extra param resource effect err r r1 extraerr .+  extraerr ~ (extra ++ '[Stop err]) =>+  r1 ~ (extraerr ++ r) =>+  KnownList (extra ++ '[Stop err]) =>+  (∀ x . param -> (resource -> Sem r1 x) -> Sem (Stop err : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r1 x) ->+  InterpreterFor (Scoped param effect !! err) r+interpretScopedResumableWithH withResource scopedHandler =+  interpretWeaving \case+    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do+      exResumable s ex ex' $ runStop $ withResource param \ resource ->+        interpretH (scopedHandler resource) $ inScope $+          restack+            (injectMembership+             (singList @'[Scoped param effect !! err])+             (singList @(effect : extraerr))) $ wv (wv' (main <$ s') <$ s)+    _ ->+      errorWithoutStackTrace "top level Run"+  where+    inScope :: InterpreterFor (Scoped param effect !! err) (effect : r1)+    inScope =+      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of+        InScope param main ->+          restack+            (extendMembershipLeft (singList @(effect : extraerr))) $+            exResumable s ex ex' $ runStop $ withResource param \ resource ->+              interpretH (scopedHandler resource) (inScope $ wv (wv' (main <$ s') <$ s))+        Run act ->+          ex . fmap Right <$> liftSem (weave s (inScope . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))++-- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are+-- interpreted by the resource allocator.+-- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the+-- entire scope.+interpretScopedResumableWith ::+  ∀ extra param resource effect err r r1 .+  r1 ~ ((extra ++ '[Stop err]) ++ r) =>+  KnownList (extra ++ '[Stop err]) =>+  (∀ x . param -> (resource -> Sem r1 x) -> Sem (Stop err : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem r1 x) ->+  InterpreterFor (Scoped param effect !! err) r+interpretScopedResumableWith withResource scopedHandler =+  interpretScopedResumableWithH @extra withResource \ r e -> liftT (scopedHandler r e)++-- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are+-- interpreted by the resource allocator.+-- This allows 'Stop' to be sent from within the resource allocator so that the consumer receives it, terminating the+-- entire scope.+-- In this variant, no resource is used and the allocator is a plain interpreter.+interpretScopedResumableWith_ ::+  ∀ extra param effect err r r1 .+  r1 ~ ((extra ++ '[Stop err]) ++ r) =>+  KnownList (extra ++ '[Stop err]) =>+  (∀ x . param -> Sem r1 x -> Sem (Stop err : r) x) ->+  (∀ r0 x . effect (Sem r0) x -> Sem r1 x) ->+  InterpreterFor (Scoped param effect !! err) r+interpretScopedResumableWith_ extra scopedHandler =+  interpretScopedResumableWith @extra (\ p f -> extra p (f ())) (const scopedHandler)++-- |Combined higher-order interpreter for 'Resumable' and 'Scoped'.+-- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the+-- scope.+interpretResumableScopedH ::+  ∀ param resource effect err r .+  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! err) (Sem r0) (Stop err : r) x) ->+  InterpreterFor (Scoped param (effect !! err)) r+interpretResumableScopedH withResource scopedHandler =+  interpretWeaving $ \(Weaving effect s wv ex _) -> case effect of+    Run _ -> errorWithoutStackTrace "top level run"+    InScope param main -> withResource param \ resource ->+      ex <$> interpretResumableH (scopedHandler resource) (inScope $ raiseUnder $ wv (main <$ s))+  where+    inScope :: InterpreterFor (Scoped param (effect !! err)) (effect !! err : r)+    inScope =+      interpretWeaving \ (Weaving effect s wv ex ins) -> case effect of+        Run act -> liftSem $ injWeaving $ Weaving act s (inScope . wv) ex ins+        InScope param main -> raise $ withResource param \ resource ->+          ex <$> interpretResumableH (scopedHandler resource) (inScope $ wv (main <$ s))++-- |Combined interpreter for 'Resumable' and 'Scoped'.+-- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the+-- scope.+interpretResumableScoped ::+  ∀ param resource effect err r .+  (∀ x . param -> (resource -> Sem r x) -> Sem r x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->+  InterpreterFor (Scoped param (effect !! err)) r+interpretResumableScoped withResource scopedHandler =+  interpretResumableScopedH withResource \ r e -> liftT (scopedHandler r e)++-- |Combined interpreter for 'Resumable' and 'Scoped'.+-- In this variant:+-- - Only the handler may send 'Stop', but this allows resumption to happen on each action inside of the scope.+-- - The resource allocator is a plain action.+interpretResumableScoped_ ::+  ∀ param resource effect err r .+  (param -> Sem r resource) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r) x) ->+  InterpreterFor (Scoped param (effect !! err)) r+interpretResumableScoped_ resource =+  interpretResumableScoped \ p use -> use =<< resource p++-- |Combined higher-order interpreter for 'Resumable' and 'Scoped' that allows the handler to use additional effects+-- that are interpreted by the resource allocator.+-- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the+-- scope.+interpretResumableScopedWithH ::+  ∀ extra param resource effect err r r1 .+  r1 ~ (extra ++ r) =>+  KnownList extra =>+  (∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! err) (Sem r0) (Stop err : r1) x) ->+  InterpreterFor (Scoped param (effect !! err)) r+interpretResumableScopedWithH withResource scopedHandler =+  interpretWeaving \case+    Weaving (InScope param main) s wv ex _ ->+      ex <$> withResource param \ resource ->+        interpretResumableH (scopedHandler resource) $ inScope $+          restack+            (injectMembership+             (singList @'[Scoped param (effect !! err)])+             (singList @(effect !! err : extra))) $ wv (main <$ s)+    _ ->+      errorWithoutStackTrace "top level Run"+  where+    inScope :: InterpreterFor (Scoped param (effect !! err)) (effect !! err : r1)+    inScope =+      interpretWeaving \case+        Weaving (InScope param main) s wv ex _ ->+          restack+            (extendMembershipLeft (singList @(effect !! err : extra)))+            (ex <$> withResource param \resource ->+                interpretResumableH (scopedHandler resource) $ inScope $ wv (main <$ s))+        Weaving (Run act) s wv ex ins ->+          liftSem $ injWeaving $ Weaving act s (inScope . wv) ex ins++-- |Combined interpreter for 'Resumable' and 'Scoped' that allows the handler to use additional effects that are+-- interpreted by the resource allocator.+-- In this variant, only the handler may send 'Stop', but this allows resumption to happen on each action inside of the+-- scope.+interpretResumableScopedWith ::+  ∀ extra param resource effect err r r1 .+  r1 ~ (extra ++ r) =>+  KnownList extra =>+  (∀ x . param -> (resource -> Sem r1 x) -> Sem r x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop err : r1) x) ->+  InterpreterFor (Scoped param (effect !! err)) r+interpretResumableScopedWith withResource scopedHandler =+  interpretResumableScopedWithH @extra withResource \ r e -> liftT (scopedHandler r e)++-- |Combined interpreter for 'Resumable' and 'Scoped' that allows the handler to use additional effects that are+-- interpreted by the resource allocator.+-- In this variant:+-- - Only the handler may send 'Stop', but this allows resumption to happen on each action inside of the scope.+-- - No resource is used and the allocator is a plain interpreter.+interpretResumableScopedWith_ ::+  ∀ extra param effect err r r1 .+  r1 ~ (extra ++ r) =>+  KnownList extra =>+  (∀ x . param -> Sem r1 x -> Sem r x) ->+  (∀ r0 x . effect (Sem r0) x -> Sem (Stop err : r1) x) ->+  InterpreterFor (Scoped param (effect !! err)) r+interpretResumableScopedWith_ extra scopedHandler =+  interpretResumableScopedWith @extra @param @() @effect @err @r @r1 (\ p f -> extra p (f ())) (const scopedHandler)++-- |Combined higher-order interpreter for 'Resumable' and 'Scoped'.+-- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the+-- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,+-- continuing the scope execution on resumption.+interpretScopedRH ::+  ∀ param resource effect eo ei r .+  (∀ x . param -> (resource -> Sem (Stop eo : r) x) -> Sem (Stop eo : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! ei) (Sem r0) (Stop ei : Stop eo : r) x) ->+  InterpreterFor (Scoped param (effect !! ei) !! eo) r+interpretScopedRH withResource scopedHandler =+  interpretWeaving \case+    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do+      exResumable s ex ex' $ runStop $ withResource param \ resource ->+        interpretResumableH (scopedHandler resource) (raiseUnder (inScope $ raiseUnder $ wv (wv' (main <$ s') <$ s)))+    _ ->+      errorWithoutStackTrace "top level run"+  where+    inScope :: InterpreterFor (Scoped param (effect !! ei) !! eo) (effect !! ei : r)+    inScope =+      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of+        Run act ->+          ex . fmap Right <$> liftSem (weave s (inScope . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))+        InScope param main -> do+          exResumable s ex ex' $ raise $ runStop $ withResource param \ resource ->+            interpretResumableH (scopedHandler resource) (raiseUnder (inScope $ wv (wv' (main <$ s') <$ s)))++-- |Combined interpreter for 'Scoped' and 'Resumable'.+-- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the+-- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,+-- continuing the scope execution on resumption.+interpretScopedR ::+  ∀ param resource effect eo ei r .+  (∀ x . param -> (resource -> Sem (Stop eo : r) x) -> Sem (Stop eo : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop ei : Stop eo : r) x) ->+  InterpreterFor (Scoped param (effect !! ei) !! eo) r+interpretScopedR withResource scopedHandler =+  interpretScopedRH withResource \ r e -> liftT (scopedHandler r e)++-- |Combined interpreter for 'Scoped' and 'Resumable'.+-- In this variant:+-- - Both the handler and the scope may send different errors via 'Stop', encoding the concept that the+--   resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,+--   continuing the scope execution on resumption.+-- - The resource allocator is a plain action.+interpretScopedR_ ::+  ∀ param resource effect eo ei r .+  (param -> Sem (Stop eo : r) resource) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop ei : Stop eo : r) x) ->+  InterpreterFor (Scoped param (effect !! ei) !! eo) r+interpretScopedR_ resource =+  interpretScopedR \ p use -> use =<< resource p++-- |Combined higher-order interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects+-- that are interpreted by the resource allocator.+-- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the+-- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,+-- continuing the scope execution on resumption.+interpretScopedRWithH ::+  ∀ extra param resource effect eo ei r r1 extraerr .+  extraerr ~ (extra ++ '[Stop eo]) =>+  r1 ~ (extra ++ Stop eo : r) =>+  r1 ~ ((extra ++ '[Stop eo]) ++ r) =>+  KnownList (extra ++ '[Stop eo]) =>+  (∀ x . param -> (resource -> Sem (extra ++ Stop eo : r) x) -> Sem (Stop eo : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical (effect !! ei) (Sem r0) (Stop ei : r1) x) ->+  InterpreterFor (Scoped param (effect !! ei) !! eo) r+interpretScopedRWithH withResource scopedHandler =+  interpretWeaving \case+    Weaving (Resumable (Weaving (InScope param main) s' wv' ex' _)) s wv ex _ -> do+      exResumable s ex ex' $ runStop $ withResource param \ resource ->+        interpretResumableH (scopedHandler resource) $ inScope $+          restack+            (injectMembership+             (singList @'[Scoped param (effect !! ei) !! eo])+             (singList @(effect !! ei : extraerr))) $ wv (wv' (main <$ s') <$ s)+    _ ->+      errorWithoutStackTrace "top level Run"+  where+    inScope :: InterpreterFor (Scoped param (effect !! ei) !! eo) (effect !! ei : r1)+    inScope =+      interpretWeaving \ (Weaving (Resumable (Weaving effect s' wv' ex' ins')) s wv ex ins) -> case effect of+        InScope param main ->+          exResumable s ex ex' $+          restack (extendMembershipLeft (singList @(effect !! ei : extraerr))) $+          runStop $+          withResource param \ resource ->+            interpretResumableH (scopedHandler resource) (inScope $ wv (wv' (main <$ s') <$ s))+        Run act ->+          ex . fmap Right <$> liftSem (weave s (inScope . wv) ins (injWeaving (Weaving act s' wv' ex' ins')))++-- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are+-- interpreted by the resource allocator.+-- In this variant, both the handler and the scope may send different errors via 'Stop', encoding the concept that the+-- resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,+-- continuing the scope execution on resumption.+interpretScopedRWith ::+  ∀ extra param resource effect eo ei r r1 .+  r1 ~ (extra ++ Stop eo : r) =>+  r1 ~ ((extra ++ '[Stop eo]) ++ r) =>+  KnownList (extra ++ '[Stop eo]) =>+  (∀ x . param -> (resource -> Sem r1 x) -> Sem (Stop eo : r) x) ->+  (∀ r0 x . resource -> effect (Sem r0) x -> Sem (Stop ei : r1) x) ->+  InterpreterFor (Scoped param (effect !! ei) !! eo) r+interpretScopedRWith withResource scopedHandler =+  interpretScopedRWithH @extra withResource \ r e -> liftT (scopedHandler r e)++-- |Combined interpreter for 'Scoped' and 'Resumable' that allows the handler to use additional effects that are+-- interpreted by the resource allocator.+-- - Both the handler and the scope may send different errors via 'Stop', encoding the concept that the+--   resource allocation may fail to prevent the scope from being executed, and each individual scoped action may fail,+--   continuing the scope execution on resumption.+-- - The resource allocator is a plain action.+interpretScopedRWith_ ::+  ∀ extra param effect eo ei r r1 .+  r1 ~ (extra ++ Stop eo : r) =>+  r1 ~ ((extra ++ '[Stop eo]) ++ r) =>+  KnownList (extra ++ '[Stop eo]) =>+  (∀ x . param -> Sem r1 x -> Sem (Stop eo : r) x) ->+  (∀ r0 x . effect (Sem r0) x -> Sem (Stop ei : r1) x) ->+  InterpreterFor (Scoped param (effect !! ei) !! eo) r+interpretScopedRWith_ extra scopedHandler =+  interpretScopedRWith @extra (\ p f -> extra p (f ())) (const scopedHandler)

@@ -0,0 +1,254 @@+{-# options_haddock prune #-}++-- |Description: Interpreters for 'Stop'.+module Polysemy.Resume.Interpreter.Stop where++import qualified Control.Exception as Base+import Control.Exception (throwIO)+import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT, throwE)+import Data.Typeable (typeRep)+import Polysemy.Final (getInitialStateS, interpretFinal, runS, withStrategicToFinal)+import Polysemy.Internal (Sem (Sem), usingSem)+import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, weave)+import qualified Text.Show++import Polysemy.Resume.Effect.Stop (Stop (Stop), stop)++-- |Equivalent of 'runError'.+runStop ::+  Sem (Stop err : r) a ->+  Sem r (Either err a)+runStop (Sem m) =+  Sem \ k ->+    runExceptT $ m \ u ->+      case decomp u of+        Left x ->+          ExceptT $ k $ weave (Right ()) (either (pure . Left) runStop) rightToMaybe x+        Right (Weaving (Stop err) _ _ _ _) ->+          throwE err+{-# inline runStop #-}++-- | Internal type used to tag exceptions thrown by 'Stop' interpreters.+newtype StopExc err =+  StopExc { unStopExc :: err }+  deriving stock (Typeable)++instance {-# overlappable #-} Typeable err => Show (StopExc err) where+  show =+    mappend "StopExc: " . show . typeRep++instance Show (StopExc Text) where+  show (StopExc err) =+    "StopExc " <> show err++instance {-# overlappable #-} Typeable err => Exception (StopExc err)++instance Exception (StopExc Text)++-- |Run 'Stop' by throwing exceptions.+runStopAsExcFinal ::+  ∀ err r a .+  Exception (StopExc err) =>+  Member (Final IO) r =>+  Sem (Stop err : r) a ->+  Sem r a+runStopAsExcFinal =+  interpretFinal \case+    Stop err ->+      pure (throwIO (StopExc err))+{-# inline runStopAsExcFinal #-}++-- |Run 'Stop' by throwing and catching exceptions.+stopToIOFinal ::+  ∀ err r a .+  Exception (StopExc err) =>+  Member (Final IO) r =>+  Sem (Stop err : r) a ->+  Sem r (Either err a)+stopToIOFinal sem =+  withStrategicToFinal @IO do+    m' <- runS (runStopAsExcFinal sem)+    s <- getInitialStateS+    pure $ either ((<$ s) . Left . unStopExc) (fmap Right) <$> Base.try m'+{-# inline stopToIOFinal #-}++-- |Stop if the argument is 'Left', transforming the error with @f@.+stopEitherWith ::+  ∀ err err' r a .+  Member (Stop err') r =>+  (err -> err') ->+  Either err a ->+  Sem r a+stopEitherWith f =+  either (stop . f) pure+{-# inline stopEitherWith #-}++-- |Stop if the argument is 'Left', using the supplied error.+stopEitherAs ::+  ∀ err err' r a .+  Member (Stop err') r =>+  err' ->+  Either err a ->+  Sem r a+stopEitherAs err =+  stopEitherWith (const err)+{-# inline stopEitherAs #-}++-- |Stop if the argument is 'Left'.+stopEither ::+  ∀ err r a .+  Member (Stop err) r =>+  Either err a ->+  Sem r a+stopEither =+  stopEitherWith id+{-# inline stopEither #-}++-- |Stop with the supplied error if the argument is 'Nothing'.+stopNote ::+  ∀ err r a .+  Member (Stop err) r =>+  err ->+  Maybe a ->+  Sem r a+stopNote err =+  maybe (stop err) pure+{-# inline stopNote #-}++-- |Convert a program using regular 'Error's to one using 'Stop'.+stopOnError ::+  ∀ err r a .+  Member (Stop err) r =>+  Sem (Error err : r) a ->+  Sem r a+stopOnError =+  stopEither <=< runError+{-# inline stopOnError #-}++-- |Convert a program using regular 'Error's to one using 'Stop'.+stopOnErrorWith ::+  ∀ err err' r a .+  Member (Stop err') r =>+  (err -> err') ->+  Sem (Error err : r) a ->+  Sem r a+stopOnErrorWith f =+  stopEitherWith f <=< runError+{-# inline stopOnErrorWith #-}++-- |Convert a program using 'Stop' to one using 'Error', transforming the error with the supplied function.+stopToErrorWith ::+  ∀ err err' r a .+  Member (Error err') r =>+  (err -> err') ->+  Sem (Stop err : r) a ->+  Sem r a+stopToErrorWith f =+  either (throw . f) pure <=< runStop+{-# inline stopToErrorWith #-}++-- |Convert a program using 'Stop' to one using 'Error'.+stopToError ::+  ∀ err r a .+  Member (Error err) r =>+  Sem (Stop err : r) a ->+  Sem r a+stopToError =+  stopToErrorWith id+{-# inline stopToError #-}++-- |Convert a program using 'Stop' to one using 'Error'.+stopToErrorIO ::+  ∀ err r a .+  Exception (StopExc err) =>+  Members [Error err, Final IO] r =>+  Sem (Stop err : r) a ->+  Sem r a+stopToErrorIO =+  either throw pure <=< stopToIOFinal+{-# inline stopToErrorIO #-}++-- |Map over the error type in a 'Stop'.+mapStop ::+  ∀ err e' r a .+  Member (Stop e') r =>+  (err -> e') ->+  Sem (Stop err : r) a ->+  Sem r a+mapStop f (Sem m) =+  Sem \ k -> m \ u ->+    case decomp u of+      Left x ->+        k (hoist (mapStop f) x)+      Right (Weaving (Stop err) _ _ _ _) ->+        usingSem k (send $ Stop (f err))+{-# inline mapStop #-}++-- |Replace the error in a 'Stop' with another type.+replaceStop ::+  ∀ err e' r a .+  Member (Stop e') r =>+  e' ->+  Sem (Stop err : r) a ->+  Sem r a+replaceStop e' =+  mapStop (const e')+{-# inline replaceStop #-}++-- |Convert the error type in a 'Stop' to 'Text'.+showStop ::+  ∀ err r a .+  Show err =>+  Member (Stop Text) r =>+  Sem (Stop err : r) a ->+  Sem r a+showStop =+  mapStop @err @Text show+{-# inline showStop #-}++-- |Convert an 'IO' exception to 'Stop' using the provided transformation.+stopTryIOE ::+  ∀ exc err r a .+  Exception exc =>+  Members [Stop err, Embed IO] r =>+  (exc -> err) ->+  IO a ->+  Sem r a+stopTryIOE f =+  stopEitherWith f <=< tryIOE @exc+{-# inline stopTryIOE #-}++-- |Convert an 'IO' exception of type @err@ to 'Stop' using the provided transformation from 'Text'.+stopTryIO ::+  ∀ exc err r a .+  Exception exc =>+  Members [Stop err, Embed IO] r =>+  (Text -> err) ->+  IO a ->+  Sem r a+stopTryIO f =+  stopEitherWith f <=< tryIO @exc+{-# inline stopTryIO #-}++-- |Convert an 'IO' exception of type 'Control.Exception.IOError' to 'Stop' using the provided transformation from+-- 'Text'.+stopTryIOError ::+  ∀ err r a .+  Members [Stop err, Embed IO] r =>+  (Text -> err) ->+  IO a ->+  Sem r a+stopTryIOError f =+  stopEitherWith f <=< tryIOError+{-# inline stopTryIOError #-}++-- |Convert an 'IO' exception to 'Stop' using the provided transformation from 'Text'.+stopTryAny ::+  ∀ err r a .+  Members [Stop err, Embed IO] r =>+  (Text -> err) ->+  IO a ->+  Sem r a+stopTryAny f =+  stopEitherWith f <=< tryAny+{-# inline stopTryAny #-}

@@ -1,327 +0,0 @@-{-# options_ghc -Wno-redundant-constraints #-}--module Polysemy.Resume.Resumable where--import Polysemy.Error (Error (Throw))-import Polysemy.Internal (Sem (Sem, runSem), liftSem, usingSem)-import Polysemy.Internal.CustomErrors (FirstOrder)-import Polysemy.Internal.Tactics (liftT, runTactics)-import Polysemy.Internal.Union (ElemOf, Weaving (Weaving), decomp, hoist, inj, injWeaving, membership, prjUsing, weave)--import Polysemy.Resume.Effect.Resumable (Resumable (..))-import Polysemy.Resume.Effect.Stop (Stop, stop)-import Polysemy.Resume.Stop (StopExc, runStop, stopOnError, stopToIOFinal)--type InterpreterTrans' eff eff' r r' =-  ∀ a b .-  (Sem (eff' : r') a -> Sem r b) ->-  Sem (eff : r) a ->-  Sem r b--type InterpreterTrans eff eff' r =-  InterpreterTrans' eff eff' r r--distribEither ::-  Functor f =>-  f () ->-  (f (Either err a) -> res) ->-  Either err (f a) ->-  res-distribEither initialState result =-  result . \case-    Right fa -> Right <$> fa-    Left err -> Left err <$ initialState-{-# inline distribEither #-}---- |Convert a bare interpreter for @eff@, which (potentially) uses 'Stop' to signal errors, into an interpreter for--- 'Resumable'.--- /Beware/: This will display unsound behaviour if:--- * the interpreter is wrapped with actions of another effect, as in:------   @---   interpretEff :: InterpreterFor Eff r---   ...------   interpretEffResumable :: InterpreterFor (Resumable Text Eff) r---   interpretEffResumable sem =---   resumable (interpretEff (sem `finally` releaseResources))---   @------   In this case, @releaseResources@ will be called after /every/ use of @Eff@ in @sem@, not after the entire thunk.------ * the interpreter of a higher-order effect uses a different interpreter after using @runT@/@bindT@.---   In this case, it will use the original interpreter instead.------ If your use case matches one of these conditions, you'll need to use 'interpretResumable'.------ >>> run $ resumable interpretStopper (interpretResumer mainProgram)--- 237-resumable ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .-  InterpreterFor eff (Stop err : r) ->-  InterpreterFor (Resumable err eff) r-resumable interpreter (Sem m) =-  Sem \ k -> m \ u ->-    case decomp (hoist (resumable interpreter) u) of-      Right (Weaving (Resumable e) s wv ex ins) ->-        distribEither s ex <$> runSem resultFromEff k-        where-          resultFromEff =-            runStop $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)-      Left g ->-        k g-{-# inline resumable #-}---- |Convenience combinator for turning an interpreter that doesn't use 'Stop' into a 'Resumable'.-raiseResumable ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .-  InterpreterTrans (Resumable err eff) eff r-raiseResumable interpreter =-  interpreter . normalize . raiseUnder-  where-    normalize :: InterpreterFor (Resumable err eff) (eff : r)-    normalize (Sem m) =-      Sem \ k -> m \ u ->-        case decomp (hoist normalize u) of-          Right (Weaving (Resumable e) s wv ex ins) ->-            ex . fmap Right <$> (usingSem k $ liftSem $ weave s wv ins (injWeaving e))-          Left g ->-            k g-    {-# inline normalize #-}-{-# inline raiseResumable #-}---- |Like 'resumable', but use exceptions instead of 'ExceptT'.-resumableIO ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .-  Exception (StopExc err) =>-  Member (Final IO) r =>-  InterpreterFor eff (Stop err : r) ->-  InterpreterFor (Resumable err eff) r-resumableIO interpreter (Sem m) =-  Sem \ k -> m \ u ->-    case decomp (hoist (resumable interpreter) u) of-      Right (Weaving (Resumable e) s wv ex ins) ->-        distribEither s ex <$> runSem resultFromEff k-        where-          resultFromEff =-            stopToIOFinal $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)-      Left g ->-        k g-{-# inline resumableIO #-}---- |Like 'interpretResumable', but for higher-order effects.-interpretResumableH ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .-  -- |This handler function has @'Stop' err@ in its stack, allowing it to absorb errors.-  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->-  InterpreterFor (Resumable err eff) r-interpretResumableH handler (Sem m) =-  Sem \ k -> m \ u ->-    case decomp u of-      Left there ->-        k (hoist (interpretResumableH handler) there)-      Right (Weaving (Resumable (Weaving e s dist ex ins)) sOuter distOuter exOuter insOuter) ->-        usingSem k (exFinal <$> runStop (tac (handler e)))-        where-          tac =-            runTactics-            (Compose (s <$ sOuter))-            (raiseUnder . fmap Compose . distOuter . fmap dist . getCompose)-            (ins <=< insOuter . getCompose)-            (raise . interpretResumableH handler . fmap Compose . distOuter . fmap dist . getCompose)-          exFinal = exOuter . \case-            Right (Compose a) -> Right . ex <$> a-            Left err -> Left err <$ sOuter-{-# inline interpretResumableH #-}---- |Create an interpreter for @'Resumable' err eff@ by supplying a handler function for @eff@, analogous to--- 'Polysemy.interpret'.--- If the handler throws errors with 'Stop', they will be absorbed into 'Resumable', to be caught by--- 'Polysemy.Resume.resume' in a downstream interpreter.------ @--- interpretStopperResumable ::---   InterpreterFor Stopper r--- interpretStopperResumable =---   interpretResumable \\case---     StopBang -> stop (Bang 13)---     StopBoom -> stop (Boom "ouch")--- @------ >>> run $ interpretStopperResumable (interpretResumer mainProgram)--- 237-interpretResumable ::-  ∀ (err :: Type) (eff :: Effect) r .-  FirstOrder eff "interpretResumable" =>-  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->-  InterpreterFor (Resumable err eff) r-interpretResumable handler =-  interpretResumableH \ e -> liftT (handler e)-{-# inline interpretResumable #-}---- |Interceptor variant of 'interpretResumableH'.-interceptResumableUsingH ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .-  ElemOf (Resumable err eff) r ->-  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->-  Sem r a ->-  Sem r a-interceptResumableUsingH proof handler (Sem m) =-  Sem \ k -> m \ u ->-    case prjUsing proof u of-      Nothing ->-        k (hoist (interceptResumableUsingH proof handler) u)-      Just (Weaving (Resumable (Weaving e s dist ex ins)) sOuter distOuter exOuter insOuter) ->-        usingSem k (exFinal <$> runStop (tac (handler e)))-        where-          tac =-            runTactics-            (Compose (s <$ sOuter))-            (raise . raise . fmap Compose . distOuter . fmap dist . getCompose)-            (ins <=< insOuter . getCompose)-            (raise . interceptResumableUsingH proof handler . fmap Compose . distOuter . fmap dist . getCompose)-          exFinal = exOuter . \case-            Right (Compose a) -> Right . ex <$> a-            Left err -> Left err <$ sOuter-{-# inline interceptResumableUsingH #-}---- |Interceptor variant of 'interpretResumable'.-interceptResumableUsing ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .-  FirstOrder eff "interceptResumableUsing" =>-  ElemOf (Resumable err eff) r ->-  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->-  Sem r a ->-  Sem r a-interceptResumableUsing proof f =-  interceptResumableUsingH proof \ e ->-    liftT (f e)-{-# inline interceptResumableUsing #-}---- |Interceptor variant of 'interpretResumableH'.-interceptResumableH ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .-  Member (Resumable err eff) r =>-  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->-  Sem r a ->-  Sem r a-interceptResumableH =-  interceptResumableUsingH membership-{-# inline interceptResumableH #-}---- |Interceptor variant of 'interpretResumable'.-interceptResumable ::-  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .-  Member (Resumable err eff) r =>-  FirstOrder eff "interceptResumable" =>-  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->-  Sem r a ->-  Sem r a-interceptResumable f =-  interceptResumableH \ e ->-    liftT (f e)-{-# inline interceptResumable #-}---- |Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'.-resumableError ::-  ∀ (err :: Type) (eff :: Effect) r .-  InterpreterFor eff (Error err : Stop err : r) ->-  InterpreterFor (Resumable err eff) r-resumableError interpreter =-  resumable (stopOnError . interpreter . raiseUnder)-{-# inline resumableError #-}---- |Convert an interpreter for @eff@ that throws errors of type @err@ into a @Resumable@, but limiting the errors--- handled by consumers to the type @handled@, which rethrowing 'Error's of type @unhandled@.------ The function @canHandle@ determines how the errors are split.------ @--- newtype Blip =---   Blip { unBlip :: Int }---   deriving (Eq, Show)------ bangOnly :: Boom -> Either Text Blip--- bangOnly = \\case---   Bang n -> Right (Blip n)---   Boom msg -> Left msg------ interpretResumerPartial ::---   Member (Resumable Blip Stopper) r =>---   InterpreterFor Resumer r--- interpretResumerPartial =---   interpret \\ MainProgram ->---     resume (192 \<$ stopBang) \\ (Blip num) ->---       pure (num * 3)--- @------ >>> runError (resumableFor bangOnly interpretStopper (interpretResumerPartial mainProgram))--- Right 39-resumableOr ::-  ∀ (err :: Type) (eff :: Effect) unhandled handled r .-  Member (Error unhandled) r =>-  (err -> Either unhandled handled) ->-  InterpreterFor eff (Stop err : r) ->-  InterpreterFor (Resumable handled eff) r-resumableOr canHandle interpreter (Sem m) =-  Sem \ k -> m \ u ->-    case decomp (hoist (resumableOr canHandle interpreter) u) of-      Right (Weaving (Resumable e) s wv ex ins) ->-        distribEither s ex <$> (tryHandle =<< runSem resultFromEff k)-        where-          tryHandle = \case-            Left err ->-              either (k . inj . Throw) (pure . Left) (canHandle err)-            Right a ->-              pure (Right a)-          resultFromEff =-            runStop $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)-      Left g ->-        k g-{-# inline resumableOr #-}---- |Variant of 'resumableOr' that uses 'Maybe' and rethrows the original error.-resumableFor ::-  ∀ (err :: Type) (eff :: Effect) handled r .-  Member (Error err) r =>-  (err -> Maybe handled) ->-  InterpreterFor eff (Stop err : r) ->-  InterpreterFor (Resumable handled eff) r-resumableFor canHandle =-  resumableOr canHandle'-  where-    canHandle' err =-      maybeToRight err (canHandle err)-{-# inline resumableFor #-}---- |Reinterpreting variant of 'resumableFor'.-catchResumable ::-  ∀ (err :: Type) (eff :: Effect) handled r .-  Members [eff, Error err] r =>-  (err -> Maybe handled) ->-  InterpreterFor (Resumable handled eff) r-catchResumable canHandle (Sem m) =-  Sem \ k -> m \ u ->-    case decomp (hoist (catchResumable canHandle) u) of-      Right (Weaving (Resumable e) s wv ex ins) ->-        distribEither s ex <$> runSem resultFromEff k-        where-          resultFromEff =-            catchJust canHandle (fmap Right $ liftSem $ weave s wv ins (injWeaving e)) (pure . Left)-      Left g ->-        k g-{-# inline catchResumable #-}---- |Interpret an effect @eff@ by wrapping it in @Resumable@ and @Stop@ and leaving the rest up to the user.-runAsResumable ::-  ∀ (err :: Type) (eff :: Effect) r .-  Members [Resumable err eff, Stop err] r =>-  InterpreterFor eff r-runAsResumable (Sem m) =-  Sem \ k -> m \ u ->-    case decomp (hoist (runAsResumable @err @eff) u) of-      Right wav ->-        runSem (either (stop @err) pure =<< send (Resumable wav)) k-      Left g ->-        k g-{-# inline runAsResumable #-}

@@ -1,17 +1,17 @@--- |Resumption combinators, transforming an effect into 'Resumable' and 'Stop'.+-- | Resumption combinators, transforming an effect into 'Resumable' and 'Stop'. module Polysemy.Resume.Resume where  import Polysemy.Resume.Effect.Resumable (Resumable) import Polysemy.Resume.Effect.Stop (Stop, stop)-import Polysemy.Resume.Resumable (runAsResumable)-import Polysemy.Resume.Stop (runStop)+import Polysemy.Resume.Interpreter.Resumable (runAsResumable)+import Polysemy.Resume.Interpreter.Stop (runStop) --- |Execute the action of a regular effect @eff@ so that any error of type @err@ that maybe be thrown by the (unknown)+-- | Execute the action of a regular effect @eff@ so that any error of type @err@ that maybe be thrown by the (unknown) -- interpreter used for @eff@ will be caught here and handled by the @handler@ argument. -- This is similar to 'Polysemy.Error.catch' with the additional guarantee that the error will have to be explicitly -- matched, therefore preventing accidental failure to handle an error and bubbling it up to @main@. -- It also imposes a membership of @Resumable err eff@ on the program, requiring the interpreter for @eff@ to be adapted--- with 'Polysemy.Resume.Resumable.resumable'.+-- with 'Polysemy.Resume.Interpreter.Resumable.resumable'. -- -- @ -- data Resumer :: Effect where@@ -37,7 +37,7 @@   either handler pure =<< runStop (runAsResumable @err (raiseUnder sem)) {-# inline resume #-} --- |Operator version of 'resume'.+-- | Operator version of 'resume'. -- -- @since 0.2.0.0 (!!) ::@@ -50,7 +50,7 @@   resume {-# inline (!!) #-} --- Reinterpreting version of 'resume'.+-- | Reinterpreting version of 'resume'. resumeRe ::   ∀ err eff r a .   Sem (eff : r) a ->@@ -60,7 +60,7 @@   either handler pure =<< runStop (runAsResumable @err (raiseUnder2 sem)) {-# inline resumeRe #-} --- |Flipped variant of 'resume'.+-- | Flipped variant of 'resume'. resuming ::   ∀ err eff r a .   Member (Resumable err eff) r =>@@ -71,7 +71,7 @@   flip resume {-# inline resuming #-} --- |Flipped variant of 'resumeRe'.+-- | Flipped variant of 'resumeRe'. resumingRe ::   ∀ err eff r a .   (err -> Sem (Resumable err eff : r) a) ->@@ -81,7 +81,7 @@   flip resumeRe {-# inline resumingRe #-} --- |Variant of 'resume' that unconditionally recovers with a constant value.+-- | Variant of 'resume' that unconditionally recovers with a constant value. resumeAs ::   ∀ err eff r a .   Member (Resumable err eff) r =>@@ -92,7 +92,7 @@   resuming @err \ _ -> pure a {-# inline resumeAs #-} --- |Operator version of 'resumeAs'.+-- | Operator version of 'resumeAs'. -- -- @since 0.2.0.0 (<!) ::@@ -104,7 +104,7 @@ (<!) =   resumeAs @err --- |Operator version of 'resumeAs', flipped version of '(<!)'.+-- | Operator version of 'resumeAs', flipped version of '(<!)'. -- -- @since 0.2.0.0 (!>) ::@@ -116,7 +116,7 @@ (!>) =   flip (resumeAs @err) --- |Convenience specialization of 'resume' that silently discards errors for void programs.+-- | Convenience specialization of 'resume' that silently discards errors for void programs. resume_ ::   ∀ err eff r .   Member (Resumable err eff) r =>@@ -125,7 +125,7 @@ resume_ =   resumeAs @err () --- |Variant of 'resume' that unconditionally recovers with an action.+-- | Variant of 'resume' that unconditionally recovers with an action. -- -- @since 0.2.0.0 resumeWith ::@@ -138,7 +138,7 @@   resume @err ma (const ma') {-# inline resumeWith #-} --- |Operator variant of 'resumeWith'.+-- | Operator variant of 'resumeWith'. -- -- @since 0.2.0.0 (!>>) ::@@ -151,7 +151,7 @@   resumeWith @err {-# inline (!>>) #-} --- |Variant of 'resuming' that unconditionally recovers with an action.+-- | Variant of 'resuming' that unconditionally recovers with an action. -- -- @since 0.2.0.0 resumingWith ::@@ -164,7 +164,7 @@   resume @err ma (const ma') {-# inline resumingWith #-} --- |Operator variant of 'resumingWith'.+-- | Operator variant of 'resumingWith'. -- -- @since 0.2.0.0 (<<!) ::@@ -177,7 +177,7 @@   resumingWith @err {-# inline (<<!) #-} --- |Variant of 'resume' that propagates the error to another 'Stop' effect after applying a function.+-- | Variant of 'resume' that propagates the error to another 'Stop' effect after applying a function. resumeHoist ::   ∀ err eff err' r a .   Members [Resumable err eff, Stop err'] r =>@@ -188,7 +188,7 @@   resuming (stop . f) {-# inline resumeHoist #-} --- |Variant of 'resumeHoist' that uses a constant value.+-- | Variant of 'resumeHoist' that uses a constant value. resumeHoistAs ::   ∀ err eff err' r .   Members [Resumable err eff, Stop err'] r =>@@ -198,7 +198,7 @@   resumeHoist @err (const err) {-# inline resumeHoistAs #-} --- |Variant of 'resumeHoist' that uses the unchanged error.+-- | Variant of 'resumeHoist' that uses the unchanged error. restop ::   ∀ err eff r .   Members [Resumable err eff, Stop err] r =>@@ -207,7 +207,7 @@   resumeHoist @err id {-# inline restop #-} --- |Variant of 'resume' that immediately produces an 'Either'.+-- | Variant of 'resume' that immediately produces an 'Either'. resumeEither ::   ∀ err eff r a .   Member (Resumable err eff) r =>@@ -216,7 +216,7 @@ resumeEither ma =   resuming (pure . Left) (Right <$> ma) --- |Variant of 'resume' that takes a branch for error and success.+-- | Variant of 'resume' that takes a branch for error and success. -- This allows the success branch to contain other resumptions. -- -- @since 0.2.0.0@@ -232,7 +232,7 @@     Right a -> fb a     Left e -> err e --- |Variant of 'resuming' that takes a branch for error and success.+-- | Variant of 'resuming' that takes a branch for error and success. -- This allows the success branch to contain other resumptions. -- -- @since 0.2.0.0@@ -246,7 +246,7 @@ resumingOr err ma fb =   resumeOr ma fb err --- |Variant of 'resume' that propagates the error to an 'Error' effect after applying a function.+-- | Variant of 'resume' that propagates the error to an 'Error' effect after applying a function. resumeHoistError ::   ∀ err eff err' r a .   Members [Resumable err eff, Error err'] r =>@@ -257,7 +257,7 @@   resuming (throw . f) {-# inline resumeHoistError #-} --- |Variant of 'resumeHoistError' that uses the unchanged error.+-- | Variant of 'resumeHoistError' that uses the unchanged error. resumeHoistErrorAs ::   ∀ err eff err' r a .   Members [Resumable err eff, Error err'] r =>@@ -268,7 +268,7 @@   resumeHoistError @err (const err) {-# inline resumeHoistErrorAs #-} --- |Variant of 'resumeHoistError' that uses the unchanged error.+-- | Variant of 'resumeHoistError' that uses the unchanged error. resumeError ::   ∀ err eff r a .   Members [Resumable err eff, Error err] r =>@@ -277,3 +277,43 @@ resumeError =   resumeHoistError @err id {-# inline resumeError #-}++-- | Transform 'Stop' to 'Fail' using the supplied error message rendering function.+stopToFailWith ::+  ∀ err r .+  Member Fail r =>+  (err -> Text) ->+  InterpreterFor (Stop err) r+stopToFailWith f =+  either (fail . toString . f) pure <=< runStop+{-# inline stopToFailWith #-}++-- | Resume a computation, converting 'Stop' to 'Fail'.+resumeFailWith ::+  ∀ err eff r .+  Members [Fail, Resumable err eff] r =>+  (err -> Text) ->+  InterpreterFor eff r+resumeFailWith f =+  resuming (fail . toString . f)+{-# inline resumeFailWith #-}++-- | Transform 'Stop' to 'Fail' using 'show'.+stopToFail ::+  ∀ err r .+  Show err =>+  Member Fail r =>+  InterpreterFor (Stop err) r+stopToFail =+  stopToFailWith show+{-# inline stopToFail #-}++-- | Resume a computation, converting 'Stop' to 'Fail' using 'show'.+resumeFail ::+  ∀ err eff r .+  Show err =>+  Members [Fail, Resumable err eff] r =>+  InterpreterFor eff r+resumeFail =+  resumeFailWith @err show+{-# inline resumeFail #-}

@@ -1,230 +0,0 @@-module Polysemy.Resume.Stop where--import qualified Control.Exception as Base-import Control.Exception (throwIO)-import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT, throwE)-import Data.Typeable (typeRep)-import Polysemy.Final (getInitialStateS, interpretFinal, runS, withStrategicToFinal)-import Polysemy.Internal (Sem (Sem), usingSem)-import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, weave)-import qualified Text.Show--import Polysemy.Resume.Effect.Stop (Stop (Stop), stop)--hush :: Either e a -> Maybe a-hush (Right a) = Just a-hush (Left _) = Nothing---- |Equivalent of 'runError'.-runStop ::-  Sem (Stop e : r) a ->-  Sem r (Either e a)-runStop (Sem m) =-  Sem \ k ->-    runExceptT $ m \ u ->-      case decomp u of-        Left x ->-          ExceptT $ k $ weave (Right ()) (either (pure . Left) runStop) hush x-        Right (Weaving (Stop e) _ _ _ _) ->-          throwE e-{-# inline runStop #-}--newtype StopExc e =-  StopExc { unStopExc :: e }-  deriving (Typeable)--instance {-# overlappable #-} Typeable e => Show (StopExc e) where-  show =-    mappend "StopExc: " . show . typeRep--instance Show (StopExc Text) where-  show (StopExc e) =-    "StopExc " <> show e--instance {-# overlappable #-} Typeable e => Exception (StopExc e)--instance Exception (StopExc Text)--runStopAsExcFinal ::-  Exception (StopExc e) =>-  Member (Final IO) r =>-  Sem (Stop e : r) a ->-  Sem r a-runStopAsExcFinal =-  interpretFinal \case-    Stop e ->-      pure (throwIO (StopExc e))-{-# inline runStopAsExcFinal #-}---- |Run 'Stop' by throwing exceptions.-stopToIOFinal ::-  Exception (StopExc e) =>-  Member (Final IO) r =>-  Sem (Stop e : r) a ->-  Sem r (Either e a)-stopToIOFinal sem =-  withStrategicToFinal @IO do-    m' <- runS (runStopAsExcFinal sem)-    s <- getInitialStateS-    pure $ either ((<$ s) . Left . unStopExc) (fmap Right) <$> Base.try m'-{-# inline stopToIOFinal #-}---- |Stop if the argument is 'Left', transforming the error with @f@.-stopEitherWith ::-  Member (Stop err') r =>-  (err -> err') ->-  Either err a ->-  Sem r a-stopEitherWith f =-  either (stop . f) pure-{-# inline stopEitherWith #-}---- |Stop if the argument is 'Left', using the supplied error.-stopEitherAs ::-  Member (Stop err') r =>-  err' ->-  Either err a ->-  Sem r a-stopEitherAs e =-  stopEitherWith (const e)-{-# inline stopEitherAs #-}---- |Stop if the argument is 'Left'.-stopEither ::-  Member (Stop err) r =>-  Either err a ->-  Sem r a-stopEither =-  stopEitherWith id-{-# inline stopEither #-}---- |Stop with the supplied error if the argument is 'Nothing'.-stopNote ::-  Member (Stop err) r =>-  err ->-  Maybe a ->-  Sem r a-stopNote err =-  maybe (stop err) pure-{-# inline stopNote #-}---- |Convert a program using regular 'Error's to one using 'Stop'.-stopOnError ::-  Member (Stop err) r =>-  Sem (Error err : r) a ->-  Sem r a-stopOnError =-  stopEither <=< runError-{-# inline stopOnError #-}---- |Convert a program using regular 'Error's to one using 'Stop'.-stopOnErrorWith ::-  Member (Stop err') r =>-  (err -> err') ->-  Sem (Error err : r) a ->-  Sem r a-stopOnErrorWith f =-  stopEitherWith f <=< runError-{-# inline stopOnErrorWith #-}---- |Convert a program using 'Stop' to one using 'Error', transforming the error with the supplied function.-stopToErrorWith ::-  Member (Error err') r =>-  (err -> err') ->-  Sem (Stop err : r) a ->-  Sem r a-stopToErrorWith f =-  either (throw . f) pure <=< runStop-{-# inline stopToErrorWith #-}---- |Convert a program using 'Stop' to one using 'Error'.-stopToError ::-  Member (Error err) r =>-  Sem (Stop err : r) a ->-  Sem r a-stopToError =-  stopToErrorWith id-{-# inline stopToError #-}---- |Convert a program using 'Stop' to one using 'Error'.-stopToErrorIO ::-  Exception (StopExc err) =>-  Members [Error err, Final IO] r =>-  Sem (Stop err : r) a ->-  Sem r a-stopToErrorIO =-  either throw pure <=< stopToIOFinal-{-# inline stopToErrorIO #-}---- |Map over the error type in a 'Stop'.-mapStop ::-  ∀ e e' r a .-  Member (Stop e') r =>-  (e -> e') ->-  Sem (Stop e : r) a ->-  Sem r a-mapStop f (Sem m) =-  Sem \ k -> m \ u ->-    case decomp u of-      Left x ->-        k (hoist (mapStop f) x)-      Right (Weaving (Stop e) _ _ _ _) ->-        usingSem k (send $ Stop (f e))-{-# inline mapStop #-}---- |Convert the error type in a 'Stop' to 'Text'.-showStop ::-  ∀ e r a .-  Show e =>-  Member (Stop Text) r =>-  Sem (Stop e : r) a ->-  Sem r a-showStop =-  mapStop @e @Text show-{-# inline showStop #-}---- |Convert an 'IO' exception to 'Stop' using the provided transformation.-stopTryIOE ::-  ∀ exc e r a .-  Exception exc =>-  Members [Stop e, Embed IO] r =>-  (exc -> e) ->-  IO a ->-  Sem r a-stopTryIOE f =-  stopEitherWith f <=< tryIOE @exc-{-# inline stopTryIOE #-}---- |Convert an 'IO' exception of type @e@ to 'Stop' using the provided transformation from 'Text'.-stopTryIO ::-  ∀ exc e r a .-  Exception exc =>-  Members [Stop e, Embed IO] r =>-  (Text -> e) ->-  IO a ->-  Sem r a-stopTryIO f =-  stopEitherWith f <=< tryIO @exc-{-# inline stopTryIO #-}---- |Convert an 'IO' exception of type 'IOError' to 'Stop' using the provided transformation from 'Text'.-stopTryIOError ::-  ∀ e r a .-  Members [Stop e, Embed IO] r =>-  (Text -> e) ->-  IO a ->-  Sem r a-stopTryIOError f =-  stopEitherWith f <=< tryIOError-{-# inline stopTryIOError #-}---- |Convert an 'IO' exception to 'Stop' using the provided transformation from 'Text'.-stopTryAny ::-  ∀ e r a .-  Members [Stop e, Embed IO] r =>-  (Text -> e) ->-  IO a ->-  Sem r a-stopTryAny f =-  stopEitherWith f <=< tryAny-{-# inline stopTryAny #-}

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.6.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack  name:           polysemy-resume-version:        0.5.0.0+version:        0.6.0.0 synopsis:       Polysemy error tracking description:    See https://hackage.haskell.org/package/polysemy-resume/docs/Polysemy-Resume.html category:       Error@@ -17,6 +17,9 @@ license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple+extra-source-files:+    changelog.md+    readme.md  source-repository head   type: git@@ -27,9 +30,10 @@       Polysemy.Resume       Polysemy.Resume.Effect.Resumable       Polysemy.Resume.Effect.Stop-      Polysemy.Resume.Resumable+      Polysemy.Resume.Interpreter.Resumable+      Polysemy.Resume.Interpreter.Scoped+      Polysemy.Resume.Interpreter.Stop       Polysemy.Resume.Resume-      Polysemy.Resume.Stop   hs-source-dirs:       lib   default-extensions:@@ -53,6 +57,7 @@       DisambiguateRecordFields       DoAndIfThenElse       DuplicateRecordFields+      EmptyCase       EmptyDataDecls       ExistentialQuantification       FlexibleContexts@@ -67,8 +72,9 @@       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns-      OverloadedStrings+      OverloadedLabels       OverloadedLists+      OverloadedStrings       PackageImports       PartialTypeSignatures       PatternGuards@@ -95,8 +101,8 @@   ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages   build-depends:       base >=4.12 && <5-    , incipit-core >=0.3-    , polysemy >=1.6+    , incipit-core >=0.4+    , polysemy ==1.8.*     , transformers   mixins:       base hiding (Prelude)@@ -134,6 +140,7 @@       DisambiguateRecordFields       DoAndIfThenElse       DuplicateRecordFields+      EmptyCase       EmptyDataDecls       ExistentialQuantification       FlexibleContexts@@ -148,8 +155,9 @@       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns-      OverloadedStrings+      OverloadedLabels       OverloadedLists+      OverloadedStrings       PackageImports       PartialTypeSignatures       PatternGuards@@ -176,16 +184,13 @@   ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.12 && <5-    , hedgehog-    , incipit-core >=0.3-    , polysemy-    , polysemy-plugin+    , incipit-core >=0.4+    , polysemy ==1.8.*+    , polysemy-plugin >=0.4.3 && <0.5     , polysemy-resume     , polysemy-test >=0.6     , stm     , tasty-    , tasty-hedgehog-    , text   mixins:       base hiding (Prelude)     , incipit-core (IncipitCore as Prelude)

@@ -0,0 +1,205 @@+# About++This library provides the Polysemy effects 'Resumable' and 'Stop' for the+purpose of safely connecting throwing and catching errors across different+interpreters.++# Example++Given these two effects and an error:++```haskell+import Polysemy.Resume (Resumable, Stop, resumable, resumableFor, resume, runStop, stop)++data Stopper :: Effect where+  StopBang :: Stopper m ()+  StopBoom :: Stopper m ()++makeSem ''Stopper++data Resumer :: Effect where+  MainProgram :: Resumer m Int++makeSem ''Resumer++data Boom =+  Boom { unBoom :: Text }+  |+  Bang { unBang :: Int }+  deriving (Eq, Show)+```++we implement an interpreter for `Stopper` that may throw the error `Boom`, but+we do not want to hardcode that fact into the effect constructors, as in:++```haskell+data Stopper :: Effect where+  StopBang :: Stopper m (Either Boom ())+```++because we might want to provide alternative interpreters that do not have this+requirement, and `Boom` might contain information about the interpreter+implementation that we don't want to leak into the effect signature.++On the other hand, having no guarantee that the consumer program knows about or+catches the error requires us to manually ensure we handle them at the+appropriate location.+This is especially critical due to the fact that using `catch` requires an+`Error` membership, which in turn requires the `Error` to be handled outside of+the consumer again, hiding any new uses of the throwing interpreter in another+part of the program.++A first attempt at making this situation safer is to introduce a wrapping+effect:++```haskell+data Resumable err eff m a where+  Resumable ::+    ∀ err eff r a .+    Weaving eff (Sem r) a ->+    Resumable err eff (Sem r) (Either err a)+```++which we now use instead of the raw `eff` in consumers:++```haskell+interpretResumer ::+  Member (Resumable Boom Stopper) r =>+  InterpreterFor Resumer r+interpretResumer =+  interpret \ MainProgram ->+    resume (192 <$ stopBang) \ _ ->+      pure 237+```++For a nicer syntax, there is a type alias for `Resumable`:++```haskell+Member (Stopper !! Boom) r =>+```++We have now marked the interpreter for `Resumer`, which consumes `Stopper`, as+being capable of handling the `Boom` error when it occurs in `Stopper`.+The function `resume` takes an error handler as its second argument with which+we can catch `Boom`.++The interpreter for `Stopper` could look like this:++```haskell+interpretStopper ::+  Member (Stop Boom) r =>+  InterpreterFor Stopper r+interpretStopper =+  interpret \case+    StopBang -> stop (Bang 13)+    StopBoom -> stop (Boom "ouch")+```++Instead of `Error`, we are using `Stop` here, which is identical except for not+providing `Catch`.+This only serves to be more explicit about the intention of the error, but+a regular `Error` can be converted with `stopOnError`.++In order to convert this interpreter to a `Resumable`, we use `resumable`:++```haskell+>>> run $ resumable interpretStopper (interpretResumer mainProgram)+237+```++`resumable` weaves `interpretStopper` and its `Stop` together into+a `Resumable`, which is then consumed entirely by `resume` inside+`interpretResumer`, so no additional effects have to be handled.++## Higher-Order Effects++Converting an interpreter with `resumable` only works in rather simple+conditions.+If there are higher-order effects involved, you may get incorrect semantics,+for example when inserting a `finally` around the entire resumable program:++```haskell+resumable (interpretStopper (sem `finally` releaseResources))+```++In this case, `releaseResources` is executed after each use of `StopBang` or+`StopBoom`.+This requires the use of `interpretResumable` and `interpretResumableH`, which+take handler functions like `interpret`:++```haskell+interpretStopper ::+  InterpreterFor (Stopper !! Boom) r+interpretStopper =+  interpretResumable \case+    StopBang -> stop (Bang 13)+    StopBoom -> stop (Boom "ouch")+```++## Partial Error Handling++Of course, one requirement in the problem description still remains+unsatisfied: We might want to hide implementation details of `interpretStopper`+from consumers.+We can do that by transforming the `Boom` error into a more abstract version at+the interpretation site:++```haskell+newtype Blip =+  Blip { unBlip :: Int }+  deriving (Eq, Show)++bangOnly :: Boom -> Maybe Blip+bangOnly = \case+  Bang n -> Just (Blip n)+  Boom _ -> Nothing+```++Now `Boom` might have contained information about e.g. an http client backend,+and we're transforming that into an error that just says "http error".+If a consumer also deals with that backend, we might keep that information.++This modified error can now be used for `Resumable`.+First, we change the `Resumer` interpreter to use `Blip`:++```haskell+interpretResumerPartial ::+  Member (Resumable Blip Stopper) r =>+  InterpreterFor Resumer r+interpretResumerPartial =+  interpret \ MainProgram ->+    resume (192 <$ stopBang) \ (Blip num) ->+      pure (num * 3)+```++Then we use a different adapter function for `interpretStopper`:++```haskell+>>> runError (resumableFor bangOnly interpretStopper (interpretResumerPartial mainProgram))+Right 39+```++`resumableFor` transforms the error and passes it to the consumer if it is+a `Just`, and rethrows it if not.+Since the error was only partially handled and unhandled errors get thrown as+`Error`, we have to call `runError` on the result, to obtain an `Either`.++If the consumer uses a constructor that throws an unhandled variant of the+error, it propagates to the call site:++```haskell+interpretResumerPartialUnhandled ::+  Member (Resumable Blip Stopper) r =>+  InterpreterFor Resumer r+interpretResumerPartialUnhandled =+  interpret \ MainProgram ->+    resume (192 <$ stopBoom) \ (Blip num) ->+      pure (num * 3)++>>> runError ((resumableFor bangOnly interpretStopper) (interpretResumerPartialUnhandled mainProgram))+Left (Boom "ouch")+```++# Thanks++to @KingOfTheHomeless for providing the initial implementation and lots of consultation!

@@ -7,7 +7,7 @@  import Polysemy.Resume (type (!!)) import Polysemy.Resume.Effect.Stop (stop)-import Polysemy.Resume.Resumable (interpretResumableH)+import Polysemy.Resume.Interpreter.Resumable (interpretResumableH) import Polysemy.Resume.Resume (resume)  data Eff :: Effect where

@@ -7,7 +7,7 @@  import Polysemy.Resume.Effect.Resumable (type (!!)) import Polysemy.Resume.Effect.Stop (stop)-import Polysemy.Resume.Resumable (interceptResumable, interpretResumable)+import Polysemy.Resume.Interpreter.Resumable (interceptResumable, interpretResumable) import Polysemy.Resume.Resume (restop, (!!), (<!))  data A :: Effect where