packages feed

polysemy-resume 0.4.0.0 → 0.5.0.0

raw patch · 14 files changed

+300/−292 lines, 14 filesdep ~basedep ~incipit-coredep ~polysemy-testPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, incipit-core, polysemy-test

API changes (from Hackage documentation)

- Polysemy.Resume.Data.Resumable: [Resumable] :: forall err eff r a. Weaving eff (Sem r) a -> Resumable err eff (Sem r) (Either err a)
- Polysemy.Resume.Data.Resumable: data Resumable err eff :: Effect
- Polysemy.Resume.Data.Resumable: type eff !! err = Resumable err eff
- Polysemy.Resume.Data.Stop: [Stop] :: e -> Stop e m a
- Polysemy.Resume.Data.Stop: data Stop e :: Effect
+ Polysemy.Resume: interceptResumable :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). Member (Resumable err eff) r => FirstOrder eff "interceptResumable" => (forall x r0. eff (Sem r0) x -> Sem (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume: interceptResumableH :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). Member (Resumable err eff) r => (forall x r0. eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume: interceptResumableUsing :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). FirstOrder eff "interceptResumableUsing" => ElemOf (Resumable err eff) r -> (forall x r0. eff (Sem r0) x -> Sem (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume: interceptResumableUsingH :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). ElemOf (Resumable err eff) r -> (forall x r0. eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume: stopEitherAs :: Member (Stop err') r => err' -> Either err a -> Sem r a
+ Polysemy.Resume: stopToErrorWith :: Member (Error err') r => (err -> err') -> Sem (Stop err : r) a -> Sem r a
+ Polysemy.Resume: stopTryAny :: forall e r a. Members [Stop e, Embed IO] r => (Text -> e) -> IO a -> Sem r a
+ Polysemy.Resume: stopTryIO :: forall exc e r a. Exception exc => Members [Stop e, Embed IO] r => (Text -> e) -> IO a -> Sem r a
+ Polysemy.Resume: stopTryIOE :: forall exc e r a. Exception exc => Members [Stop e, Embed IO] r => (exc -> e) -> IO a -> Sem r a
+ Polysemy.Resume: stopTryIOError :: forall e r a. Members [Stop e, Embed IO] r => (Text -> e) -> IO a -> Sem r a
+ Polysemy.Resume.Effect.Resumable: [Resumable] :: forall err eff r a. Weaving eff (Sem r) a -> Resumable err eff (Sem r) (Either err a)
+ Polysemy.Resume.Effect.Resumable: data Resumable err eff :: Effect
+ Polysemy.Resume.Effect.Resumable: type eff !! err = Resumable err eff
+ Polysemy.Resume.Effect.Stop: [Stop] :: e -> Stop e m a
+ Polysemy.Resume.Effect.Stop: data Stop e :: Effect
+ Polysemy.Resume.Resumable: interceptResumable :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). Member (Resumable err eff) r => FirstOrder eff "interceptResumable" => (forall x r0. eff (Sem r0) x -> Sem (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume.Resumable: interceptResumableH :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). Member (Resumable err eff) r => (forall x r0. eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume.Resumable: interceptResumableUsing :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). FirstOrder eff "interceptResumableUsing" => ElemOf (Resumable err eff) r -> (forall x r0. eff (Sem r0) x -> Sem (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume.Resumable: interceptResumableUsingH :: forall (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type). ElemOf (Resumable err eff) r -> (forall x r0. eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) -> Sem r a -> Sem r a
+ Polysemy.Resume.Stop: stopEitherAs :: Member (Stop err') r => err' -> Either err a -> Sem r a
+ Polysemy.Resume.Stop: stopToErrorWith :: Member (Error err') r => (err -> err') -> Sem (Stop err : r) a -> Sem r a
+ Polysemy.Resume.Stop: stopTryAny :: forall e r a. Members [Stop e, Embed IO] r => (Text -> e) -> IO a -> Sem r a
+ Polysemy.Resume.Stop: stopTryIO :: forall exc e r a. Exception exc => Members [Stop e, Embed IO] r => (Text -> e) -> IO a -> Sem r a
+ Polysemy.Resume.Stop: stopTryIOE :: forall exc e r a. Exception exc => Members [Stop e, Embed IO] r => (exc -> e) -> IO a -> Sem r a
+ Polysemy.Resume.Stop: stopTryIOError :: forall e r a. Members [Stop e, Embed IO] r => (Text -> e) -> IO a -> Sem r a
- Polysemy.Resume: stop :: forall e_a4A5 r_a5Oh a_a4A7. MemberWithError (Stop e_a4A5) r_a5Oh => e_a4A5 -> Sem r_a5Oh a_a4A7
+ Polysemy.Resume: stop :: forall e_a4Ag r_a5Os a_a4Ai. MemberWithError (Stop e_a4Ag) r_a5Os => e_a4Ag -> Sem r_a5Os a_a4Ai

Files

− changelog.md
@@ -1,15 +0,0 @@-# Unreleased--# 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
lib/Polysemy/Resume.hs view
@@ -1,13 +1,17 @@ module Polysemy.Resume (   -- * Introduction   -- $intro-  module Polysemy.Resume.Data.Stop,-  module Polysemy.Resume.Data.Resumable,+  module Polysemy.Resume.Effect.Stop,+  module Polysemy.Resume.Effect.Resumable,   -- * Resuming a Stopped Computation   resume,   (!!),   interpretResumable,   interpretResumableH,+  interceptResumable,+  interceptResumableH,+  interceptResumableUsing,+  interceptResumableUsingH,   resumable,   raiseResumable,   resumableIO,@@ -40,10 +44,14 @@   module Polysemy.Resume.Stop, ) where -import Polysemy.Resume.Data.Resumable (Resumable, type (!!))-import Polysemy.Resume.Data.Stop (Stop (..), stop)+import Polysemy.Resume.Effect.Resumable (Resumable, type (!!))+import Polysemy.Resume.Effect.Stop (Stop (..), stop) import Polysemy.Resume.Resumable (   catchResumable,+  interceptResumable,+  interceptResumableH,+  interceptResumableUsing,+  interceptResumableUsingH,   interpretResumable,   interpretResumableH,   raiseResumable,@@ -81,12 +89,18 @@   runStop,   showStop,   stopEither,+  stopEitherAs,   stopEitherWith,   stopNote,   stopOnError,   stopOnErrorWith,   stopToError,+  stopToErrorWith,   stopToIOFinal,+  stopTryIOE,+  stopTryIO,+  stopTryIOError,+  stopTryAny,   )  -- $intro
− lib/Polysemy/Resume/Data/Resumable.hs
@@ -1,19 +0,0 @@-module Polysemy.Resume.Data.Resumable where--import Polysemy.Internal.Union (Weaving)---- |Effect that wraps another effect @eff@, marking it as throwing errors of type @err@ using--- 'Polysemy.Resume.Data.Stop.Stop'.-data Resumable err eff :: Effect where-  Resumable ::-    ∀ err eff r a .-    Weaving eff (Sem r) a ->-    Resumable err eff (Sem r) (Either err a)---- |Infix alias for 'Resumable'.------ @--- Member (Stopper !! Boom) r =>--- @-type eff !! err =-  Resumable err eff
− lib/Polysemy/Resume/Data/Stop.hs
@@ -1,22 +0,0 @@-{-# options_haddock prune #-}---- |Description: Internal-module Polysemy.Resume.Data.Stop where---- |An effect similar to 'Polysemy.Error.Error' without the ability to be caught.--- Used to signal that an error is supposed to be expected by dependent programs.------ @--- interpretStopper ::---   Member (Stop Boom) r =>---   InterpreterFor Stopper r--- interpretStopper =---   interpret \\case---     StopBang -> stop (Bang 13)---     StopBoom -> stop (Boom "ouch")--- @-data Stop e :: Effect where-  -- |Abort a computation with an error value.-  Stop :: e -> Stop e m a--makeSem ''Stop
+ lib/Polysemy/Resume/Effect/Resumable.hs view
@@ -0,0 +1,19 @@+module Polysemy.Resume.Effect.Resumable where++import Polysemy.Internal.Union (Weaving)++-- |Effect that wraps another effect @eff@, marking it as throwing errors of type @err@ using+-- 'Polysemy.Resume.Data.Stop.Stop'.+data Resumable err eff :: Effect where+  Resumable ::+    ∀ err eff r a .+    Weaving eff (Sem r) a ->+    Resumable err eff (Sem r) (Either err a)++-- |Infix alias for 'Resumable'.+--+-- @+-- Member (Stopper !! Boom) r =>+-- @+type eff !! err =+  Resumable err eff
+ lib/Polysemy/Resume/Effect/Stop.hs view
@@ -0,0 +1,22 @@+{-# options_haddock prune #-}++-- |Description: Internal+module Polysemy.Resume.Effect.Stop where++-- |An effect similar to 'Polysemy.Error.Error' without the ability to be caught.+-- Used to signal that an error is supposed to be expected by dependent programs.+--+-- @+-- interpretStopper ::+--   Member (Stop Boom) r =>+--   InterpreterFor Stopper r+-- interpretStopper =+--   interpret \\case+--     StopBang -> stop (Bang 13)+--     StopBoom -> stop (Boom "ouch")+-- @+data Stop e :: Effect where+  -- |Abort a computation with an error value.+  Stop :: e -> Stop e m a++makeSem ''Stop
lib/Polysemy/Resume/Resumable.hs view
@@ -6,10 +6,10 @@ import Polysemy.Internal (Sem (Sem, runSem), liftSem, usingSem) import Polysemy.Internal.CustomErrors (FirstOrder) import Polysemy.Internal.Tactics (liftT, runTactics)-import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, inj, injWeaving, weave)+import Polysemy.Internal.Union (ElemOf, Weaving (Weaving), decomp, hoist, inj, injWeaving, membership, prjUsing, weave) -import Polysemy.Resume.Data.Resumable (Resumable (..))-import Polysemy.Resume.Data.Stop (Stop, stop)+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' =@@ -141,7 +141,6 @@ -- -- @ -- interpretStopperResumable ::---   Member (Stop Boom) r => --   InterpreterFor Stopper r -- interpretStopperResumable = --   interpretResumable \\case@@ -159,6 +158,69 @@ 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 ::
lib/Polysemy/Resume/Resume.hs view
@@ -1,8 +1,8 @@ -- |Resumption combinators, transforming an effect into 'Resumable' and 'Stop'. module Polysemy.Resume.Resume where -import Polysemy.Resume.Data.Resumable (Resumable)-import Polysemy.Resume.Data.Stop (Stop, stop)+import Polysemy.Resume.Effect.Resumable (Resumable)+import Polysemy.Resume.Effect.Stop (Stop, stop) import Polysemy.Resume.Resumable (runAsResumable) import Polysemy.Resume.Stop (runStop) 
lib/Polysemy/Resume/Stop.hs view
@@ -9,7 +9,7 @@ import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, weave) import qualified Text.Show -import Polysemy.Resume.Data.Stop (Stop (Stop), stop)+import Polysemy.Resume.Effect.Stop (Stop (Stop), stop)  hush :: Either e a -> Maybe a hush (Right a) = Just a@@ -79,6 +79,16 @@   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 =>@@ -117,13 +127,23 @@   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 =-  either throw pure <=< runStop+  stopToErrorWith id {-# inline stopToError #-}  -- |Convert a program using 'Stop' to one using 'Error'.@@ -162,3 +182,49 @@ 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 #-}
polysemy-resume.cabal view
@@ -5,25 +5,28 @@ -- see: https://github.com/sol/hpack  name:           polysemy-resume-version:        0.4.0.0+version:        0.5.0.0 synopsis:       Polysemy error tracking-description:    Please see the readme on Github at <https://github.com/tek/polysemy-resume>-category:       Experimental+description:    See https://hackage.haskell.org/package/polysemy-resume/docs/Polysemy-Resume.html+category:       Error+homepage:       https://github.com/tek/polysemy-resume#readme+bug-reports:    https://github.com/tek/polysemy-resume/issues author:         Torsten Schmits-maintainer:     tek@tryp.io-copyright:      2020 Torsten Schmits+maintainer:     hackage@tryp.io+copyright:      2022 Torsten Schmits license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple-extra-source-files:-    readme.md-    changelog.md +source-repository head+  type: git+  location: https://github.com/tek/polysemy-resume+ library   exposed-modules:       Polysemy.Resume-      Polysemy.Resume.Data.Resumable-      Polysemy.Resume.Data.Stop+      Polysemy.Resume.Effect.Resumable+      Polysemy.Resume.Effect.Stop       Polysemy.Resume.Resumable       Polysemy.Resume.Resume       Polysemy.Resume.Stop@@ -43,6 +46,7 @@       DeriveFoldable       DeriveFunctor       DeriveGeneric+      DeriveLift       DeriveTraversable       DerivingStrategies       DerivingVia@@ -75,6 +79,7 @@       RankNTypes       RecordWildCards       RecursiveDo+      RoleAnnotations       ScopedTypeVariables       StandaloneDeriving       TemplateHaskell@@ -87,14 +92,16 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -flate-specialise -fspecialise-aggressively -Wall+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages   build-depends:-      base ==4.*-    , incipit-core >=0.2+      base >=4.12 && <5+    , incipit-core >=0.3     , polysemy >=1.6     , transformers   mixins:       base hiding (Prelude)+    , incipit-core (IncipitCore as Prelude)+    , incipit-core hiding (IncipitCore)   default-language: Haskell2010  test-suite polysemy-resume-unit@@ -103,6 +110,7 @@   other-modules:       Polysemy.Resume.ExampleTest       Polysemy.Resume.HigherOrderTest+      Polysemy.Resume.Test.InterceptTest   hs-source-dirs:       test   default-extensions:@@ -119,6 +127,7 @@       DeriveFoldable       DeriveFunctor       DeriveGeneric+      DeriveLift       DeriveTraversable       DerivingStrategies       DerivingVia@@ -151,6 +160,7 @@       RankNTypes       RecordWildCards       RecursiveDo+      RoleAnnotations       ScopedTypeVariables       StandaloneDeriving       TemplateHaskell@@ -163,19 +173,21 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base ==4.*+      base >=4.12 && <5     , hedgehog-    , incipit-core+    , incipit-core >=0.3     , polysemy     , polysemy-plugin     , polysemy-resume-    , polysemy-test+    , polysemy-test >=0.6     , stm     , tasty     , tasty-hedgehog     , text   mixins:       base hiding (Prelude)+    , incipit-core (IncipitCore as Prelude)+    , incipit-core hiding (IncipitCore)   default-language: Haskell2010
− readme.md
@@ -1,205 +0,0 @@-# 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!
test/Main.hs view
@@ -1,13 +1,17 @@ module Main where  import Polysemy.Resume.ExampleTest (test_example)+import Polysemy.Resume.HigherOrderTest (test_switchInterpreter)+import Polysemy.Resume.Test.InterceptTest (test_intercept) import Polysemy.Test (unitTest) import Test.Tasty (TestTree, defaultMain, testGroup)  tests :: TestTree tests =   testGroup "unit" [-    unitTest "stop and resume" test_example+    unitTest "stop and resume" test_example,+    unitTest "switch higher order interpreter" test_switchInterpreter,+    unitTest "intercept" test_intercept   ]  main :: IO ()
test/Polysemy/Resume/HigherOrderTest.hs view
@@ -6,7 +6,7 @@ import Polysemy.Test (UnitTest, runTestAuto, (===))  import Polysemy.Resume (type (!!))-import Polysemy.Resume.Data.Stop (stop)+import Polysemy.Resume.Effect.Stop (stop) import Polysemy.Resume.Resumable (interpretResumableH) import Polysemy.Resume.Resume (resume) 
+ test/Polysemy/Resume/Test/InterceptTest.hs view
@@ -0,0 +1,70 @@+{-# options_ghc -fplugin=Polysemy.Plugin #-}++module Polysemy.Resume.Test.InterceptTest where++import Control.Concurrent.STM (newTVarIO)+import Polysemy.Test (UnitTest, runTestAuto, (===))++import Polysemy.Resume.Effect.Resumable (type (!!))+import Polysemy.Resume.Effect.Stop (stop)+import Polysemy.Resume.Resumable (interceptResumable, interpretResumable)+import Polysemy.Resume.Resume (restop, (!!), (<!))++data A :: Effect where+  A1 :: A m Int+  A2 :: A m Int+  A3 :: A m Int++makeSem ''A++interpretA ::+  Member (AtomicState Int) r =>+  InterpreterFor (A !! Int) r+interpretA =+  interpretResumable \case+    A1 ->+      atomicGet >>= \case+        5 -> stop 13+        n -> pure (n - 1000)+    A2 ->+      pure (-1)+    A3 ->+      pure (-1)++interceptA1 ::+  Members [A !! Int, AtomicState Int] r =>+  Sem r a ->+  Sem r a+interceptA1 =+  interceptResumable \case+    A1 ->+      atomicModify' (8 *) *> restop a1+    A2 -> do+      atomicPut 5+      restop a1+    A3 ->+      stop (23)++interceptA2 ::+  Members [A !! Int, AtomicState Int] r =>+  Sem r a ->+  Sem r a+interceptA2 =+  interceptResumable \case+    A1 ->+      atomicModify' (500 +) *> restop a1+    A2 ->+      restop a2+    A3 ->+      99 <! a3++test_intercept :: UnitTest+test_intercept =+  runTestAuto do+    tv <- embed (newTVarIO 0)+    i <- runAtomicStateTVar tv $ interpretA $ interceptA1 $ interceptA2 do+      i1 <- a1 !! \ i -> fail ("first failed with: " <> show i)+      i2 <- a2 !! pure+      i3 <- a3 !! pure+      pure (i1, i2, i3)+    (3000, 13, 99) === i