polysemy-resume 0.1.0.0 → 0.1.0.1

raw patch · 8 files changed

+114/−24 lines, 8 filesdep ~polysemyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: polysemy

API changes (from Hackage documentation)

Files

• changelog.md +2/−0
• lib/Polysemy/Resume.hs +6/−1
• lib/Polysemy/Resume/Data/Resumable.hs +8/−0
• lib/Polysemy/Resume/Resumable.hs +21/−1
• lib/Polysemy/Resume/Resume.hs +1/−1
• lib/Polysemy/Resume/Stop.hs +68/−14
• polysemy-resume.cabal +4/−3
• test/Polysemy/Resume/ExampleTest.hs +4/−4

@@ -0,0 +1,2 @@+# 0.1.0.0+* initial release

@@ -6,6 +6,7 @@   -- * Resuming a Stopped Computation   resume,   resumable,+  resumableIO,   -- * Partial Handlers   -- $partial   resumableOr,@@ -25,13 +26,14 @@   module Polysemy.Resume.Stop, ) where -import Polysemy.Resume.Data.Resumable (Resumable)+import Polysemy.Resume.Data.Resumable (Resumable, type (!)) import Polysemy.Resume.Data.Stop (Stop(..), stop) import Polysemy.Resume.Resumable (   catchResumable,   resumable,   resumableError,   resumableFor,+  resumableIO,   resumableOr,   runAsResumable,   )@@ -47,8 +49,11 @@   resuming,   ) import Polysemy.Resume.Stop (+  runStop,+  stopEither,   stopOnError,   stopToError,+  stopToIOFinal,   )  -- $intro

@@ -9,3 +9,11 @@     ∀ 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

@@ -3,10 +3,11 @@ import Polysemy.Internal (Sem(Sem), liftSem, raise, raiseUnder, runSem, send) import Polysemy.Internal.Union (Weaving(Weaving), decomp, hoist, inj, injWeaving, weave) +import Polysemy (Final) 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)+import Polysemy.Resume.Stop (runStop, stopOnError, stopToIOFinal)  distribEither ::   Functor f =>@@ -41,6 +42,25 @@       Left g ->         k g {-# INLINE resumable #-}++-- |Like 'resumable', but use exceptions instead of 'ExceptT'.+resumableIO ::+  ∀ (eff :: Effect) (err :: *) (r :: EffectRow) .+  Typeable err =>+  Member (Final IO) r =>+  InterpreterFor eff (Stop err : r) ->+  InterpreterFor (Resumable err eff) r+resumableIO 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 =+            stopToIOFinal $ interpreter $ liftSem $ weave s (raise . raise . wv) ins (injWeaving e)+      Left g ->+        k g+{-# INLINE resumableIO #-}  -- |Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'. resumableError ::

@@ -12,7 +12,7 @@ -- 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+-- 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'. -- -- @

@@ -1,10 +1,15 @@ module Polysemy.Resume.Stop where  import Control.Monad.Trans.Except (throwE)+import Data.Typeable (typeRep)+import Polysemy (Final) import Polysemy.Error (runError, throw)+import Polysemy.Final (getInitialStateS, interpretFinal, runS, withStrategicToFinal) import Polysemy.Internal (Sem(Sem)) import Polysemy.Internal.Union (Weaving(Weaving), decomp, weave)+import qualified Text.Show +import Control.Exception (throwIO, try) import Polysemy.Resume.Data.Stop (Stop(Stop), stop)  hush :: Either e a -> Maybe a@@ -16,23 +21,64 @@   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+  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 WrappedExc e =+  WrappedExc { unwrapExc :: e }+  deriving (Typeable)++instance Typeable e => Show (WrappedExc e) where+  show =+    mappend "WrappedExc: " . show . typeRep++instance Typeable e => Exception (WrappedExc e)++runStopAsExcFinal ::+  Typeable e =>+  Member (Final IO) r =>+  Sem (Stop e : r) a ->+  Sem r a+runStopAsExcFinal =+  interpretFinal \case+    Stop e ->+      pure (throwIO (WrappedExc e))+{-# INLINE runStopAsExcFinal #-}++-- |Run 'Stop' by throwing exceptions.+stopToIOFinal ::+  Typeable 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 . unwrapExc) (fmap Right) <$> try m'+{-# INLINE stopToIOFinal #-}++-- |Stop if the argument is 'Left'.+stopEither ::+  Member (Stop err) r =>+  Either err a ->+  Sem r a+stopEither =+  either stop pure+ -- |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+stopOnError =+  stopEither <=< runError {-# INLINE stopOnError #-}  -- |Convert a program using 'Stop' to one using 'Error'.@@ -40,8 +86,16 @@   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+stopToError =+  either throw pure <=< runStop {-# INLINE stopToError #-}++-- |Convert a program using 'Stop' to one using 'Error'.+stopToErrorIO ::+  Typeable err =>+  Members [Error err, Final IO] r =>+  Sem (Stop err : r) a ->+  Sem r a+stopToErrorIO =+  either throw pure <=< stopToIOFinal+{-# INLINE stopToErrorIO #-}

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-resume-version:        0.1.0.0+version:        0.1.0.1 synopsis:       Polysemy error tracking description:    Please see the readme on Github at <https://github.com/tek/polysemy-resume> category:       Experimental@@ -17,6 +17,7 @@ build-type:     Simple extra-source-files:     readme.md+    changelog.md  library   exposed-modules:@@ -38,7 +39,7 @@   ghc-options: -flate-specialise -fspecialise-aggressively -Wall -fplugin=Polysemy.Plugin   build-depends:       base >=4 && <5-    , polysemy >=1.3.0 && <1.4+    , polysemy >=1.3.0     , polysemy-plugin     , relude >=0.7 && <0.8     , transformers@@ -61,7 +62,7 @@   build-depends:       base >=4 && <5     , hedgehog-    , polysemy >=1.3.0 && <1.4+    , polysemy >=1.3.0     , polysemy-plugin     , polysemy-resume     , polysemy-test

@@ -4,7 +4,7 @@ import Polysemy.Test (UnitTest, assertRight, runTestAuto, (===))  import Polysemy.Error (runError)-import Polysemy.Resume (Resumable, Stop, resumable, resumableFor, resume, stop)+import Polysemy.Resume (Stop, resumable, resumableFor, resume, stop, type (!))  data Stopper :: Effect where   StopBang :: Stopper m ()@@ -41,7 +41,7 @@     StopBoom -> stop (Boom "ouch")  interpretResumerPartialUnhandled ::-  Member (Resumable Blip Stopper) r =>+  Member (Stopper ! Blip) r =>   InterpreterFor Resumer r interpretResumerPartialUnhandled =   interpret \ MainProgram ->@@ -49,7 +49,7 @@       pure (num * 3)  interpretResumerPartial ::-  Member (Resumable Blip Stopper) r =>+  Member (Stopper ! Blip) r =>   InterpreterFor Resumer r interpretResumerPartial =   interpret \ MainProgram ->@@ -57,7 +57,7 @@       pure (num * 3)  interpretResumer ::-  Member (Resumable Boom Stopper) r =>+  Member (Stopper ! Boom) r =>   InterpreterFor Resumer r interpretResumer =   interpret \ MainProgram ->