polysemy-resume 0.1.0.4 → 0.2.0.0

raw patch · 7 files changed

+232/−70 lines, 7 filesdep ~polysemyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: polysemy

API changes (from Hackage documentation)

Files

• changelog.md +13/−0
• lib/Polysemy/Resume.hs +19/−1
• lib/Polysemy/Resume/Data/Stop.hs +1/−0
• lib/Polysemy/Resume/Resumable.hs +51/−38
• lib/Polysemy/Resume/Resume.hs +134/−15
• lib/Polysemy/Resume/Stop.hs +12/−12
• polysemy-resume.cabal +2/−4

@@ -1,2 +1,15 @@+# 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

@@ -5,6 +5,7 @@   module Polysemy.Resume.Data.Resumable,   -- * Resuming a Stopped Computation   resume,+  (!!),   interpretResumable,   interpretResumableH,   resumable,@@ -15,6 +16,12 @@   resumableOr,   -- * Various Combinators   resumeAs,+  (<!),+  (!>),+  resumeWith,+  (!>>),+  resumingWith,+  (<<!),   resume_,   resumeHoist,   resumeHoistAs,@@ -23,6 +30,8 @@   resumeHoistErrorAs,   restop,   resumeEither,+  resumeOr,+  resumingOr,   resumeError,   resumableError,   resumableFor,@@ -32,7 +41,7 @@ ) where  import Polysemy.Resume.Data.Resumable (Resumable, type (!!))-import Polysemy.Resume.Data.Stop (Stop(..), stop)+import Polysemy.Resume.Data.Stop (Stop (..), stop) import Polysemy.Resume.Resumable (   catchResumable,   interpretResumable,@@ -55,8 +64,17 @@   resumeHoistAs,   resumeHoistError,   resumeHoistErrorAs,+  resumeOr,+  resumeWith,   resume_,   resuming,+  resumingOr,+  resumingWith,+  (!!),+  (!>),+  (!>>),+  (<!),+  (<<!),   ) import Polysemy.Resume.Stop (   mapStop,

@@ -1,3 +1,4 @@+-- |Description: Internal module Polysemy.Resume.Data.Stop where  import Polysemy (makeSem)

@@ -1,16 +1,25 @@ module Polysemy.Resume.Resumable where - import Polysemy (Final, Tactical)-import Polysemy.Error (Error(Throw), catchJust)-import Polysemy.Internal (Sem(Sem, runSem), liftSem, raise, raiseUnder, send, usingSem)+import Polysemy.Error (Error (Throw), catchJust)+import Polysemy.Internal (Sem (Sem, runSem), liftSem, raise, raiseUnder, send, 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.Resume.Data.Resumable (Resumable(..))+import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, inj, injWeaving, weave)++import Polysemy.Resume.Data.Resumable (Resumable (..)) import Polysemy.Resume.Data.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 () ->@@ -21,7 +30,7 @@   result . \case     Right fa -> Right <$> fa     Left err -> Left err <$ initialState-{-# INLINE distribEither #-}+{-# inline distribEither #-}  -- |Convert a bare interpreter for @eff@, which (potentially) uses 'Stop' to signal errors, into an interpreter for -- 'Resumable'.@@ -47,7 +56,7 @@ -- >>> run $ resumable interpretStopper (interpretResumer mainProgram) -- 237 resumable ::-  ∀ (err :: *) (eff :: Effect) (r :: EffectRow) .+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .   InterpreterFor eff (Stop err : r) ->   InterpreterFor (Resumable err eff) r resumable interpreter (Sem m) =@@ -60,28 +69,32 @@             runStop $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)       Left g ->         k g-{-# INLINE resumable #-}+  -- where+  --   int =+  --     runSem . interpreter+{-# inline resumable #-}  -- |Convenience combinator for turning an interpreter that doesn't use 'Stop' into a 'Resumable'. raiseResumable ::-  ∀ (err :: *) (eff :: Effect) (r :: EffectRow) .-  InterpreterFor eff r ->-  InterpreterFor (Resumable err eff) r-raiseResumable interpreter (Sem m) =-  Sem \ k -> m \ u ->-    case decomp (hoist (raiseResumable interpreter) u) of-      Right (Weaving (Resumable e) s wv ex ins) ->-        distribEither s ex <$> runSem resultFromEff k-        where-          resultFromEff =-            fmap Right $ interpreter $ liftSem $ weave s (raise . wv) ins (injWeaving e)-      Left g ->-        k g-{-# INLINE 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 :: *) (eff :: Effect) (r :: EffectRow) .+  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .   Exception (StopExc err) =>   Member (Final IO) r =>   InterpreterFor eff (Stop err : r) ->@@ -96,11 +109,11 @@             stopToIOFinal $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)       Left g ->         k g-{-# INLINE resumableIO #-}+{-# inline resumableIO #-}  -- |Like 'interpretResumable', but for higher-order effects. interpretResumableH ::-  ∀ (err :: *) (eff :: Effect) (r :: EffectRow) .+  ∀ (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@@ -122,7 +135,7 @@           exFinal = exOuter . \case             Right (getCompose -> a) -> Right . ex <$> a             Left err -> Left err <$ sOuter-{-# INLINE interpretResumableH #-}+{-# inline interpretResumableH #-}  -- |Create an interpreter for @'Resumable' err eff@ by supplying a handler function for @eff@, analogous to -- 'Polysemy.interpret'.@@ -142,22 +155,22 @@ -- >>> run $ interpretStopperResumable (interpretResumer mainProgram) -- 237 interpretResumable ::-  ∀ (err :: *) (eff :: Effect) r .+  ∀ (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 #-}+{-# inline interpretResumable #-}  -- |Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'. resumableError ::-  ∀ (err :: *) (eff :: Effect) r .+  ∀ (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 #-}+{-# 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@.@@ -186,7 +199,7 @@ -- >>> runError (resumableFor bangOnly interpretStopper (interpretResumerPartial mainProgram)) -- Right 39 resumableOr ::-  ∀ (err :: *) (eff :: Effect) unhandled handled r .+  ∀ (err :: Type) (eff :: Effect) unhandled handled r .   Member (Error unhandled) r =>   (err -> Either unhandled handled) ->   InterpreterFor eff (Stop err : r) ->@@ -206,11 +219,11 @@             runStop $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)       Left g ->         k g-{-# INLINE resumableOr #-}+{-# inline resumableOr #-}  -- |Variant of 'resumableOr' that uses 'Maybe' and rethrows the original error. resumableFor ::-  ∀ (err :: *) (eff :: Effect) handled r .+  ∀ (err :: Type) (eff :: Effect) handled r .   Member (Error err) r =>   (err -> Maybe handled) ->   InterpreterFor eff (Stop err : r) ->@@ -220,11 +233,11 @@   where     canHandle' err =       maybeToRight err (canHandle err)-{-# INLINE resumableFor #-}+{-# inline resumableFor #-}  -- |Reinterpreting variant of 'resumableFor'. catchResumable ::-  ∀ (err :: *) (eff :: Effect) handled r .+  ∀ (err :: Type) (eff :: Effect) handled r .   Members [eff, Error err] r =>   (err -> Maybe handled) ->   InterpreterFor (Resumable handled eff) r@@ -238,11 +251,11 @@             catchJust canHandle (fmap Right $ liftSem $ weave s wv ins (injWeaving e)) (pure . Left)       Left g ->         k g-{-# INLINE catchResumable #-}+{-# inline catchResumable #-}  -- |Interpret an effect @eff@ by wrapping it in @Resumable@ and @Stop@ and leaving the rest up to the user. runAsResumable ::-  ∀ (err :: *) (eff :: Effect) r .+  ∀ (err :: Type) (eff :: Effect) r .   Members [Resumable err eff, Stop err] r =>   InterpreterFor eff r runAsResumable (Sem m) =@@ -252,4 +265,4 @@         runSem (either (stop @err) pure =<< send (Resumable wav)) k       Left g ->         k g-{-# INLINE runAsResumable #-}+{-# inline runAsResumable #-}

@@ -1,6 +1,6 @@ module Polysemy.Resume.Resume where -import Polysemy (raiseUnder2, raiseUnder)+import Polysemy (raiseUnder, raiseUnder2) import Polysemy.Error (throw)  import Polysemy.Resume.Data.Resumable (Resumable)@@ -37,8 +37,21 @@   Sem r a resume sem handler =   either handler pure =<< runStop (runAsResumable @err (raiseUnder sem))-{-# INLINE resume #-}+{-# inline resume #-} +-- |Operator version of 'resume'.+--+-- @since 0.2.0.0+(!!) ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem (eff : r) a ->+  (err -> Sem r a) ->+  Sem r a+(!!) =+  resume+{-# inline (!!) #-}+ -- Reinterpreting version of 'resume'. resumeRe ::   ∀ err eff r a .@@ -47,7 +60,7 @@   Sem (Resumable err eff : r) a resumeRe sem handler =   either handler pure =<< runStop (runAsResumable @err (raiseUnder2 sem))-{-# INLINE resumeRe #-}+{-# inline resumeRe #-}  -- |Flipped variant of 'resume'. resuming ::@@ -58,7 +71,7 @@   Sem r a resuming =   flip resume-{-# INLINE resuming #-}+{-# inline resuming #-}  -- |Flipped variant of 'resumeRe'. resumingRe ::@@ -68,7 +81,7 @@   Sem (Resumable err eff : r) a resumingRe =   flip resumeRe-{-# INLINE resumingRe #-}+{-# inline resumingRe #-}  -- |Variant of 'resume' that unconditionally recovers with a constant value. resumeAs ::@@ -79,8 +92,32 @@   Sem r a resumeAs a =   resuming @err \ _ -> pure a-{-# INLINE resumeAs #-}+{-# inline resumeAs #-} +-- |Operator version of 'resumeAs'.+--+-- @since 0.2.0.0+(<!) ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  a ->+  Sem (eff : r) a ->+  Sem r a+(<!) =+  resumeAs @err++-- |Operator version of 'resumeAs', flipped version of '(<!)'.+--+-- @since 0.2.0.0+(!>) ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem (eff : r) a ->+  a ->+  Sem r a+(!>) =+  flip (resumeAs @err)+ -- |Convenience specialization of 'resume' that silently discards errors for void programs. resume_ ::   ∀ err eff r .@@ -90,6 +127,58 @@ resume_ =   resumeAs @err () +-- |Variant of 'resume' that unconditionally recovers with an action.+--+-- @since 0.2.0.0+resumeWith ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem (eff : r) a ->+  Sem r a ->+  Sem r a+resumeWith ma ma' =+  resume @err ma (const ma')+{-# inline resumeWith #-}++-- |Operator variant of 'resumeWith'.+--+-- @since 0.2.0.0+(!>>) ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem (eff : r) a ->+  Sem r a ->+  Sem r a+(!>>) =+  resumeWith @err+{-# inline (!>>) #-}++-- |Variant of 'resuming' that unconditionally recovers with an action.+--+-- @since 0.2.0.0+resumingWith ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem r a ->+  Sem (eff : r) a ->+  Sem r a+resumingWith ma' ma =+  resume @err ma (const ma')+{-# inline resumingWith #-}++-- |Operator variant of 'resumingWith'.+--+-- @since 0.2.0.0+(<<!) ::+  ∀ err eff r a .+  Member (Resumable err eff) r =>+  Sem r a ->+  Sem (eff : r) a ->+  Sem r a+(<<!) =+  resumingWith @err+{-# inline (<<!) #-}+ -- |Variant of 'resume' that propagates the error to another 'Stop' effect after applying a function. resumeHoist ::   ∀ err eff err' r a .@@ -99,7 +188,7 @@   Sem r a resumeHoist f =   resuming (stop . f)-{-# INLINE resumeHoist #-}+{-# inline resumeHoist #-}  -- |Variant of 'resumeHoist' that uses a constant value. resumeHoistAs ::@@ -109,7 +198,7 @@   InterpreterFor eff r resumeHoistAs err =   resumeHoist @err (const err)-{-# INLINE resumeHoistAs #-}+{-# inline resumeHoistAs #-}  -- |Variant of 'resumeHoist' that uses the unchanged error. restop ::@@ -118,17 +207,47 @@   InterpreterFor eff r restop =   resumeHoist @err id-{-# INLINE restop #-}+{-# inline restop #-} --- |Variant of 'restop' that immediately produces an 'Either'.+-- |Variant of 'resume' that immediately produces an 'Either'. resumeEither ::   ∀ err eff r a .   Member (Resumable err eff) r =>   Sem (eff : r) a ->   Sem r (Either err a)-resumeEither =-  runStop . restop @err . raiseUnder+resumeEither ma =+  resuming (pure . Left) (Right <$> ma) +-- |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+resumeOr ::+  ∀ err eff r a b .+  Member (Resumable err eff) r =>+  Sem (eff : r) a ->+  (a -> Sem r b) ->+  (err -> Sem r b) ->+  Sem r b+resumeOr ma fb err =+  resumeEither ma >>= \case+    Right a -> fb a+    Left e -> err e++-- |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+resumingOr ::+  ∀ err eff r a b .+  Member (Resumable err eff) r =>+  (err -> Sem r b) ->+  Sem (eff : r) a ->+  (a -> Sem r b) ->+  Sem r b+resumingOr err ma fb =+  resumeOr ma fb err+ -- |Variant of 'resume' that propagates the error to an 'Error' effect after applying a function. resumeHoistError ::   ∀ err eff err' r a .@@ -138,7 +257,7 @@   Sem r a resumeHoistError f =   resuming (throw . f)-{-# INLINE resumeHoistError #-}+{-# inline resumeHoistError #-}  -- |Variant of 'resumeHoistError' that uses the unchanged error. resumeHoistErrorAs ::@@ -149,7 +268,7 @@   Sem r a resumeHoistErrorAs err =   resumeHoistError @err (const err)-{-# INLINE resumeHoistErrorAs #-}+{-# inline resumeHoistErrorAs #-}  -- |Variant of 'resumeHoistError' that uses the unchanged error. resumeError ::@@ -159,4 +278,4 @@   Sem r a resumeError =   resumeHoistError @err id-{-# INLINE resumeError #-}+{-# inline resumeError #-}

@@ -28,7 +28,7 @@           ExceptT $ k $ weave (Right ()) (either (pure . Left) runStop) hush x         Right (Weaving (Stop e) _ _ _ _) ->           throwE e-{-# INLINE runStop #-}+{-# inline runStop #-}  newtype StopExc e =   StopExc { unStopExc :: e }@@ -55,7 +55,7 @@   interpretFinal \case     Stop e ->       pure (throwIO (StopExc e))-{-# INLINE runStopAsExcFinal #-}+{-# inline runStopAsExcFinal #-}  -- |Run 'Stop' by throwing exceptions. stopToIOFinal ::@@ -68,7 +68,7 @@     m' <- runS (runStopAsExcFinal sem)     s <- getInitialStateS     pure $ either ((<$ s) . Left . unStopExc) (fmap Right) <$> try m'-{-# INLINE stopToIOFinal #-}+{-# inline stopToIOFinal #-}  -- |Stop if the argument is 'Left', transforming the error with @f@. stopEitherWith ::@@ -78,7 +78,7 @@   Sem r a stopEitherWith f =   either (stop . f) pure-{-# INLINE stopEitherWith #-}+{-# inline stopEitherWith #-}  -- |Stop if the argument is 'Left'. stopEither ::@@ -87,7 +87,7 @@   Sem r a stopEither =   stopEitherWith id-{-# INLINE stopEither #-}+{-# inline stopEither #-}  -- |Stop with the supplied error if the argument is 'Nothing'. stopNote ::@@ -97,7 +97,7 @@   Sem r a stopNote err =   maybe (stop err) pure-{-# INLINE stopNote #-}+{-# inline stopNote #-}  -- |Convert a program using regular 'Error's to one using 'Stop'. stopOnError ::@@ -106,7 +106,7 @@   Sem r a stopOnError =   stopEither <=< runError-{-# INLINE stopOnError #-}+{-# inline stopOnError #-}  -- |Convert a program using regular 'Error's to one using 'Stop'. stopOnErrorWith ::@@ -116,7 +116,7 @@   Sem r a stopOnErrorWith f =   stopEitherWith f <=< runError-{-# INLINE stopOnErrorWith #-}+{-# inline stopOnErrorWith #-}  -- |Convert a program using 'Stop' to one using 'Error'. stopToError ::@@ -125,7 +125,7 @@   Sem r a stopToError =   either throw pure <=< runStop-{-# INLINE stopToError #-}+{-# inline stopToError #-}  -- |Convert a program using 'Stop' to one using 'Error'. stopToErrorIO ::@@ -135,7 +135,7 @@   Sem r a stopToErrorIO =   either throw pure <=< stopToIOFinal-{-# INLINE stopToErrorIO #-}+{-# inline stopToErrorIO #-}  -- |Map over the error type in a 'Stop'. mapStop ::@@ -151,7 +151,7 @@         k (hoist (mapStop f) x)       Right (Weaving (Stop e) _ _ _ _) ->         usingSem k (send $ Stop (f e))-{-# INLINE mapStop #-}+{-# inline mapStop #-}  -- |Convert the error type in a 'Stop' to 'Text'. showStop ::@@ -162,4 +162,4 @@   Sem r a showStop =   mapStop @e @Text show-{-# INLINE showStop #-}+{-# inline showStop #-}

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-resume-version:        0.1.0.4+version:        0.2.0.0 synopsis:       Polysemy error tracking description:    Please see the readme on Github at <https://github.com/tek/polysemy-resume> category:       Experimental@@ -174,15 +174,13 @@   build-depends:       base ==4.*     , hedgehog-    , polysemy >=1.5+    , polysemy     , polysemy-plugin     , polysemy-resume     , polysemy-test-    , relude >=0.7     , tasty     , tasty-hedgehog     , text-    , transformers   mixins:       base hiding (Prelude)     , polysemy-resume hiding (Prelude)