packages feed

polysemy-resume (empty) → 0.1.0.0

raw patch · 13 files changed

+833/−0 lines, 13 filesdep +basedep +hedgehogdep +polysemy

Dependencies added: base, hedgehog, polysemy, polysemy-plugin, polysemy-resume, polysemy-test, relude, tasty, tasty-hedgehog, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2020 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+  disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ lib/Polysemy/Resume.hs view
@@ -0,0 +1,90 @@+module Polysemy.Resume (+  -- * Introduction+  -- $intro+  module Polysemy.Resume.Data.Stop,+  module Polysemy.Resume.Data.Resumable,+  -- * Resuming a Stopped Computation+  resume,+  resumable,+  -- * Partial Handlers+  -- $partial+  resumableOr,+  -- * Various Combinators+  resumeAs,+  resumeHoist,+  resumeHoistAs,+  resuming,+  resumeHoistError,+  resumeHoistErrorAs,+  restop,+  resumeError,+  resumableError,+  resumableFor,+  runAsResumable,+  catchResumable,+  module Polysemy.Resume.Stop,+) where++import Polysemy.Resume.Data.Resumable (Resumable)+import Polysemy.Resume.Data.Stop (Stop(..), stop)+import Polysemy.Resume.Resumable (+  catchResumable,+  resumable,+  resumableError,+  resumableFor,+  resumableOr,+  runAsResumable,+  )+import Polysemy.Resume.Resume (+  restop,+  resume,+  resumeAs,+  resumeError,+  resumeHoist,+  resumeHoistAs,+  resumeHoistError,+  resumeHoistErrorAs,+  resuming,+  )+import Polysemy.Resume.Stop (+  stopOnError,+  stopToError,+  )++-- $intro+-- This library provides the Polysemy effects 'Resumable' and 'Stop' for the purpose of safely connecting throwing and+-- catching errors across different interpreters.+--+-- Consider the effect:+--+-- @+-- data Stopper :: Effect where+--   StopBang :: Stopper m ()+--   StopBoom :: Stopper m ()+--+-- makeSem ''Stopper+--+-- data Boom =+--   Boom { unBoom :: Text }+--   |+--   Bang { unBang :: Int }+--   deriving (Eq, Show)+--+-- interpretStopper ::+--   Member (Error Boom) r =>+--   InterpreterFor Stopper r+-- interpretStopper =+--   interpret \\case+--     StopBang -> throw (Bang 13)+--     StopBoom -> throw (Boom "ouch")+-- @+--+-- 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+-- 'Resumable' when using it in an effect stack:++-- $partial+-- In some cases, the errors thrown by an interpreter contain details about the implementation, which we might want to+-- hide from dependents; or it may throw fatal errors we don't want to handle at all.+-- For this purpose, we can create partial 'Resumable's by transforming errors before handling them:
+ lib/Polysemy/Resume/Data/Resumable.hs view
@@ -0,0 +1,11 @@+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 m a where+  Resumable ::+    ∀ err eff r a .+    Weaving eff (Sem r) a ->+    Resumable err eff (Sem r) (Either err a)
+ lib/Polysemy/Resume/Data/Stop.hs view
@@ -0,0 +1,20 @@+module Polysemy.Resume.Data.Stop where++import Polysemy (makeSem)++-- |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+  Stop :: e -> Stop e m a++makeSem ''Stop
+ lib/Polysemy/Resume/Prelude.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Polysemy.Resume.Prelude (+  module GHC.Err,+  module Polysemy,+  module Polysemy.Error,+  module Relude,+) where++import GHC.Err (undefined)+import Polysemy (Effect, EffectRow, InterpreterFor, Member, Members, Sem)+import Polysemy.Error (Error)+import Relude hiding (undefined)
+ lib/Polysemy/Resume/Resumable.hs view
@@ -0,0 +1,147 @@+module Polysemy.Resume.Resumable where++import Polysemy.Internal (Sem(Sem), liftSem, raise, raiseUnder, runSem, send)+import Polysemy.Internal.Union (Weaving(Weaving), decomp, hoist, inj, injWeaving, weave)++import Polysemy.Error (Error(Throw), catchJust)+import Polysemy.Resume.Data.Resumable (Resumable(..))+import Polysemy.Resume.Data.Stop (Stop, stop)+import Polysemy.Resume.Stop (runStop, stopOnError)++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'.+--+-- >>> run $ resumable interpretStopper (interpretResumer mainProgram)+-- 237+resumable ::+  ∀ (eff :: Effect) (err :: *) (r :: EffectRow) .+  InterpreterFor eff (Stop err : r) ->+  InterpreterFor (Resumable err eff) r+resumable interpreter sem =+  Sem \ k -> runSem sem \ 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 #-}++-- |Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'.+resumableError ::+  ∀ eff err 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 ::+  ∀ eff err 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 =+  Sem \ k -> runSem sem \ 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 ::+  ∀ eff err 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 ::+  ∀ eff handled err r .+  Members [eff, Error err] r =>+  (err -> Maybe handled) ->+  InterpreterFor (Resumable handled eff) r+catchResumable canHandle sem =+  Sem \ k -> runSem sem \ 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 eff r .+  Members [Resumable err eff, Stop err] r =>+  InterpreterFor eff r+runAsResumable sem =+  Sem \ k -> runSem sem \ u ->+    case decomp (hoist runAsResumable u) of+      Right wav ->+        runSem (either stop pure =<< send (Resumable wav)) k+      Left g ->+        k g+{-# INLINE runAsResumable #-}
+ lib/Polysemy/Resume/Resume.hs view
@@ -0,0 +1,126 @@+module Polysemy.Resume.Resume where++import Polysemy (raiseUnder)+import Polysemy.Error (throw)++import Polysemy.Resume.Data.Resumable (Resumable)+import Polysemy.Resume.Data.Stop (Stop, stop)+import Polysemy.Resume.Resumable (runAsResumable)+import Polysemy.Resume.Stop (runStop)++-- |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@.+-- This imposes a membership of @Resumable err eff@ on the program, requiring the interpreter for @eff@ to be adapted+-- with 'Polysemy.Resume.Resumable.resumable'.+--+-- @+-- data Resumer :: Effect where+--   MainProgram :: Resumer m Int+--+-- makeSem ''Resumer+--+-- interpretResumer ::+--   Member (Resumable Boom Stopper) r =>+--   InterpreterFor Resumer r+-- interpretResumer =+--   interpret \\ MainProgram ->+--     resume (192 \<$ stopBang) \\ _ ->+--       pure 237+-- @+resume ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem (eff : r) a ->+  (err -> Sem r a) ->+  Sem r a+resume sem handler =+  either handler pure =<< runStop (runAsResumable (raiseUnder sem))+{-# INLINE resume #-}++-- |Flipped variant of 'resume'.+resuming ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  (err -> Sem r a) ->+  Sem (eff : r) a ->+  Sem r a+resuming =+  flip resume+{-# INLINE resuming #-}++-- |Variant of 'resume' that unconditionally recovers with a constant value.+resumeAs ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  a ->+  Sem (eff : r) a ->+  Sem r a+resumeAs a =+  resuming \ _ -> pure a+{-# INLINE resumeAs #-}++-- |Variant of 'resume' that propagates the error to another 'Stop' effect after applying a function.+resumeHoist ::+  ∀ err err' eff r a .+  Members [Resumable err eff, Stop err'] r =>+  (err -> err') ->+  Sem (eff : r) a ->+  Sem r a+resumeHoist f =+  resuming (stop . f)+{-# INLINE resumeHoist #-}++-- |Variant of 'resumeHoist' that uses a constant value.+resumeHoistAs ::+  ∀ err err' eff r a .+  Members [Resumable err eff, Stop err'] r =>+  err' ->+  Sem (eff : r) a ->+  Sem r a+resumeHoistAs err =+  resumeHoist (const err)+{-# INLINE resumeHoistAs #-}++-- |Variant of 'resumeHoist' that uses the unchanged error.+restop ::+  ∀ err eff r a .+  Members [Resumable err eff, Stop err] r =>+  Sem (eff : r) a ->+  Sem r a+restop =+  resumeHoist id+{-# INLINE restop #-}++-- |Variant of 'resume' that propagates the error to an 'Error' effect after applying a function.+resumeHoistError ::+  ∀ err err' eff r a .+  Members [Resumable err eff, Error err'] r =>+  (err -> err') ->+  Sem (eff : r) a ->+  Sem r a+resumeHoistError f =+  resuming (throw . f)+{-# INLINE resumeHoistError #-}++-- |Variant of 'resumeHoistError' that uses the unchanged error.+resumeHoistErrorAs ::+  ∀ err err' eff r a .+  Members [Resumable err eff, Error err'] r =>+  err' ->+  Sem (eff : r) a ->+  Sem r a+resumeHoistErrorAs err =+  resumeHoistError (const err)+{-# INLINE resumeHoistErrorAs #-}++-- |Variant of 'resumeHoistError' that uses the unchanged error.+resumeError ::+  ∀ err eff r a .+  Members [Resumable err eff, Error err] r =>+  Sem (eff : r) a ->+  Sem r a+resumeError =+  resumeHoistError id+{-# INLINE resumeError #-}
+ lib/Polysemy/Resume/Stop.hs view
@@ -0,0 +1,47 @@+module Polysemy.Resume.Stop where++import Control.Monad.Trans.Except (throwE)+import Polysemy.Error (runError, throw)+import Polysemy.Internal (Sem(Sem))+import Polysemy.Internal.Union (Weaving(Weaving), decomp, weave)++import Polysemy.Resume.Data.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 #-}++-- |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 sem =+  runError sem >>= \case+    Right a -> pure a+    Left err -> stop err+{-# INLINE stopOnError #-}++-- |Convert a program using 'Stop' to one using 'Error'.+stopToError ::+  Member (Error err) r =>+  Sem (Stop err : r) a ->+  Sem r a+stopToError sem =+  runStop sem >>= \case+    Right a -> pure a+    Left err -> throw err+{-# INLINE stopToError #-}
+ lib/Prelude.hs view
@@ -0,0 +1,5 @@+module Prelude (+  module Polysemy.Resume.Prelude,+) where++import Polysemy.Resume.Prelude
+ polysemy-resume.cabal view
@@ -0,0 +1,79 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           polysemy-resume+version:        0.1.0.0+synopsis:       Polysemy error tracking+description:    Please see the readme on Github at <https://github.com/tek/polysemy-resume>+category:       Experimental+author:         Torsten Schmits+maintainer:     tek@tryp.io+copyright:      2020 Torsten Schmits+license:        BSD-2-Clause-Patent+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    readme.md++library+  exposed-modules:+      Polysemy.Resume+      Polysemy.Resume.Data.Resumable+      Polysemy.Resume.Data.Stop+      Polysemy.Resume.Prelude+      Polysemy.Resume.Resumable+      Polysemy.Resume.Resume+      Polysemy.Resume.Stop+      Paths_polysemy_resume+  other-modules:+      Prelude+  autogen-modules:+      Paths_polysemy_resume+  hs-source-dirs:+      lib+  default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings OverloadedLists PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns+  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -fplugin=Polysemy.Plugin+  build-depends:+      base >=4 && <5+    , polysemy >=1.3.0 && <1.4+    , polysemy-plugin+    , relude >=0.7 && <0.8+    , transformers+  mixins:+      base hiding (Prelude)+  if impl(ghc < 8.10)+    ghc-options: -O2+  default-language: Haskell2010++test-suite polysemy-resume-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Polysemy.Resume.ExampleTest+      Paths_polysemy_resume+  hs-source-dirs:+      test+  default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings OverloadedLists PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns+  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -fplugin=Polysemy.Plugin+  build-depends:+      base >=4 && <5+    , hedgehog+    , polysemy >=1.3.0 && <1.4+    , polysemy-plugin+    , polysemy-resume+    , polysemy-test+    , relude >=0.7 && <0.8+    , tasty+    , tasty-hedgehog+    , text+    , transformers+  mixins:+      base hiding (Prelude)+    , polysemy-resume hiding (Prelude)+    , polysemy-resume (Polysemy.Resume.Prelude as Prelude)+  if impl(ghc < 8.10)+    ghc-options: -O2+  default-language: Haskell2010
+ readme.md view
@@ -0,0 +1,174 @@+# 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+```++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.++## 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 the meat of the implementation!
+ test/Main.hs view
@@ -0,0 +1,15 @@+module Main where++import Polysemy.Resume.ExampleTest (test_example)+import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "unit" [+    unitTest "stop and resume" test_example+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Polysemy/Resume/ExampleTest.hs view
@@ -0,0 +1,72 @@+module Polysemy.Resume.ExampleTest where++import Polysemy (interpret, makeSem)+import Polysemy.Test (UnitTest, assertRight, runTestAuto, (===))++import Polysemy.Error (runError)+import Polysemy.Resume (Resumable, Stop, resumable, resumableFor, resume, 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)++newtype Blip =+  Blip { unBlip :: Int }+  deriving (Eq, Show)++bangOnly :: Boom -> Maybe Blip+bangOnly = \case+  Bang n -> Just (Blip n)+  Boom _ -> Nothing++interpretStopper ::+  Member (Stop Boom) r =>+  InterpreterFor Stopper r+interpretStopper =+  interpret \case+    StopBang -> stop (Bang 13)+    StopBoom -> stop (Boom "ouch")++interpretResumerPartialUnhandled ::+  Member (Resumable Blip Stopper) r =>+  InterpreterFor Resumer r+interpretResumerPartialUnhandled =+  interpret \ MainProgram ->+    resume (192 <$ stopBoom) \ (Blip num) ->+      pure (num * 3)++interpretResumerPartial ::+  Member (Resumable Blip Stopper) r =>+  InterpreterFor Resumer r+interpretResumerPartial =+  interpret \ MainProgram ->+    resume (192 <$ stopBang) \ (Blip num) ->+      pure (num * 3)++interpretResumer ::+  Member (Resumable Boom Stopper) r =>+  InterpreterFor Resumer r+interpretResumer =+  interpret \ MainProgram ->+    resume (192 <$ stopBang) \ _ ->+      pure 237++test_example :: UnitTest+test_example =+  runTestAuto do+    assertRight 39 =<< runError (resumableFor bangOnly interpretStopper (interpretResumerPartial mainProgram))+    (Left (Boom "ouch") ===) =<< runError (resumableFor bangOnly interpretStopper (interpretResumerPartialUnhandled mainProgram))+    (237 ===) =<< (resumable interpretStopper) (interpretResumer mainProgram)