polysemy 0.3.0.1 → 0.4.0.0

raw patch · 7 files changed

+230/−18 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +23/−1
• README.md +3/−5
• bench/Poly.hs +1/−1
• polysemy.cabal +3/−2
• src/Polysemy/Internal.hs +2/−2
• src/Polysemy/Resource.hs +116/−7
• test/BracketSpec.hs +82/−0

@@ -1,13 +1,30 @@ # Changelog for polysemy +## 0.4.0.0 (2019-06-12)++### Breaking Changes++- Renamed `runResource` to `runResourceInIO`++### Other Changes++- Added `runResource`, which runs a `Resource` purely+- Added `onException`, `finally` and `bracketOnError` to `Resource`+- Added a new function, `runResource` which performs bracketing for pure code+ ## 0.3.0.1 (2019-06-09)  - Fixed a type error in the benchmark caused by deprecation of `Semantic`  ## 0.3.0.0 (2019-06-01) +### Breaking Changes+ - Removed all deprecated names - Moved `Random` effect to `polysemy-zoo`++### Other Changes+ - `makeSem` can now be used to create term-level operators (thanks to     @TheMatten) @@ -27,9 +44,14 @@  ## 0.2.0.0 (2019-05-23) +### Breaking Changes++- Lower precedence of `.@` and `.@@` to 8, from 9++### Other Changes+ - Fixed a serious bug in `interpretH` and friends, where higher-order effects     would always be run with the current interpreter.-- Lower precedence of `.@` and `.@@` to 8, from 9 - Users need no longer require `inlineRecursiveCalls` --- the     `polysemy-plugin-0.2.0.0` will do  it automatically when compiling with `-O` - Deprecated `inlineRecursiveCalls`; slated for removal in the next version

@@ -157,7 +157,7 @@             _             -> writeTTY input >> writeTTY "no exceptions"  main :: IO (Either CustomException ())-main = (runM .@ runResource .@@ runErrorInIO @CustomException) . runTeletypeIO $ program+main = (runM .@ runResourceInIO .@@ runErrorInIO @CustomException) . runTeletypeIO $ program ```  Easy.@@ -175,11 +175,9 @@ ```haskell runResource     :: forall r a-     . Member (Lift IO) r-    => (∀ x. Sem r x -> IO x)-    -> Sem (Resource ': r) a+     . Sem (Resource ': r) a     -> Sem r a-runResource finish = interpret $ \case+runResource = interpret $ \case   ... ``` 

@@ -43,7 +43,7 @@  zoinks :: IO (Either Bool Bool) zoinks = fmap (fmap snd)-       . (runM .@ runResource .@@ runErrorInIO)+       . (runM .@ runResourceInIO .@@ runErrorInIO)        . runState False        $ prog 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 377e703e0e8b13978cd5936eac0b54f8d9ddba81bf1bdedc130d48bb4f7133dd+-- hash: 4be5160aee3aafedfc1de37204f6dbea8e61f8aceaee0deaa59520e662451bd3  name:           polysemy-version:        0.3.0.1+version:        0.4.0.0 synopsis:       Higher-order, low-boilerplate, zero-cost free monads. description:    Please see the README on GitHub at <https://github.com/isovector/polysemy#readme> category:       Language@@ -88,6 +88,7 @@   main-is: Main.hs   other-modules:       AlternativeSpec+      BracketSpec       FusionSpec       HigherOrderSpec       InspectorSpec

@@ -357,10 +357,10 @@ ------------------------------------------------------------------------------ -- | Some interpreters need to be able to lower down to the base monad (often -- 'IO') in order to function properly --- some good examples of this are--- 'Polysemy.Error.runErrorInIO' and 'Polysemy.Resource.runResource'.+-- 'Polysemy.Error.runErrorInIO' and 'Polysemy.Resource.runResourceInIO'. -- -- However, these interpreters don't compose particularly nicely; for example,--- to run 'Polysemy.Resource.runResource', you must write:+-- to run 'Polysemy.Resource.runResourceInIO', you must write: -- -- @ -- runM . runErrorInIO runM

@@ -6,9 +6,13 @@      -- * Actions   , bracket+  , bracketOnError+  , finally+  , onException      -- * Interpretations   , runResource+  , runResourceInIO   ) where  import qualified Control.Exception as X@@ -23,34 +27,139 @@   Bracket     :: m a        -- ^ Action to allocate a resource.-    -> (a -> m ())+    -> (a -> m c)        -- ^ Action to cleanup the resource. This is guaranteed to be        -- called.     -> (a -> m b)        -- ^ Action which uses the resource.     -> Resource m b+  BracketOnError+    :: m a+       -- ^ Action to allocate a resource.+    -> (a -> m c)+       -- ^ Action to cleanup the resource. This will only be called if the+       -- "use" block fails.+    -> (a -> m b)+       -- ^ Action which uses the resource.+    -> Resource m b  makeSem ''Resource   ------------------------------------------------------------------------------+-- | Like 'bracket', but for the simple case of one computation to run+-- afterward.+--+-- @since 0.4.0.0+finally+    :: Member Resource r+    => Sem r a -- ^ computation to run first+    -> Sem r b -- ^ computation to run afterward (even if an exception was raised)+    -> Sem r a+finally act end = bracket (pure ()) (pure end) (const act)+++------------------------------------------------------------------------------+-- | Like 'bracketOnError', but for the simple case of one computation to run+-- afterward.+--+-- @since 0.4.0.0+onException+    :: Member Resource r+    => Sem r a -- ^ computation to run first+    -> Sem r b -- ^ computation to run afterward if an exception was raised+    -> Sem r a+onException act end = bracketOnError (pure ()) (const end) (const act)+++------------------------------------------------------------------------------ -- | Run a 'Resource' effect via in terms of 'X.bracket'.-runResource-    :: forall r a+--+-- __Note:__ This function used to be called @runResource@ prior to 0.4.0.0.+--+-- @since 0.4.0.0+runResourceInIO+    :: ∀ r a      . Member (Lift IO) r     => (∀ x. Sem r x -> IO x)        -- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is likely        -- some combination of 'runM' and other interpreters composed via '.@'.     -> Sem (Resource ': r) a     -> Sem r a-runResource finish = interpretH $ \case+runResourceInIO finish = interpretH $ \case   Bracket alloc dealloc use -> do     a <- runT  alloc     d <- bindT dealloc     u <- bindT use -    let runIt :: Sem (Resource ': r) x -> IO x-        runIt = finish .@ runResource+    let run_it :: Sem (Resource ': r) x -> IO x+        run_it = finish .@ runResourceInIO_b -    sendM $ X.bracket (runIt a) (runIt . d) (runIt . u)+    sendM $ X.bracket (run_it a) (run_it . d) (run_it . u)++  BracketOnError alloc dealloc use -> do+    a <- runT  alloc+    d <- bindT dealloc+    u <- bindT use++    let run_it :: Sem (Resource ': r) x -> IO x+        run_it = finish .@ runResourceInIO_b++    sendM $ X.bracketOnError (run_it a) (run_it . d) (run_it . u)+++------------------------------------------------------------------------------+-- | Run a 'Resource' effect purely.+--+-- @since 0.4.0.0+runResource+    :: ∀ r a+     . Sem (Resource ': r) a+    -> Sem r a+runResource = interpretH $ \case+  Bracket alloc dealloc use -> do+    a <- runT  alloc+    d <- bindT dealloc+    u <- bindT use++    let run_it = raise . runResource_b+    resource <- run_it a+    result <- run_it $ u resource+    _ <- run_it $ d resource+    pure result++  BracketOnError alloc dealloc use -> do+    a <- runT  alloc+    d <- bindT dealloc+    u <- bindT use++    let run_it = raise . runResource_b++    resource <- run_it a+    result <- run_it $ u resource++    ins <- getInspectorT+    case inspect ins result of+      Just _ -> pure result+      Nothing -> do+        _ <- run_it $ d resource+        pure result+{-# INLINE runResource #-}+++runResource_b+    :: ∀ r a+     . Sem (Resource ': r) a+    -> Sem r a+runResource_b = runResource+{-# NOINLINE runResource_b #-}++runResourceInIO_b+    :: ∀ r a+     . Member (Lift IO) r+    => (∀ x. Sem r x -> IO x)+    -> Sem (Resource ': r) a+    -> Sem r a+runResourceInIO_b = runResourceInIO+{-# NOINLINE runResourceInIO_b #-} 

@@ -0,0 +1,82 @@+module BracketSpec where++import Polysemy+import Polysemy.Error+import Polysemy.Output+import Polysemy.Resource+import Polysemy.State+import Polysemy.Trace+import Test.Hspec+++runTest+  :: Sem '[Error (), Resource, State [Char], Trace, Output String] a+  -> ([String], ([Char], Either () a))+runTest = run+        . runFoldMapOutput @String (:[])+        . runTraceAsOutput+        . runState ""+        . runResource+        . runError @()+++spec :: Spec+spec = do+  describe "pure bracket" $ do+    it "persist state and call the finalizer" $ do+      let (ts, (s, e)) = runTest $ do+            bracket+              (put "allocated" >> pure ())+              (\() -> do+                get >>= trace+                put "finalized"+              )+              (\() -> do+                get >>= trace+                put "starting block"+                _ <- throw ()+                put "don't get here"+              )+      ts `shouldContain` ["allocated"]+      ts `shouldContain` ["starting block"]+      s `shouldBe` "finalized"+      e `shouldBe` Left ()++  describe "pure bracketOnError" $ do+    it "persist state and call the finalizer if there was an error" $ do+      let (ts, (s, e)) = runTest $ do+            bracketOnError+              (put "allocated" >> pure ())+              (\() -> do+                get >>= trace+                put "finalized"+              )+              (\() -> do+                get >>= trace+                put "starting block"+                _ <- throw ()+                put "don't get here"+              )+      ts `shouldContain` ["allocated"]+      ts `shouldContain` ["starting block"]+      s `shouldBe` "finalized"+      e `shouldBe` Left ()++    it "should not call the finalizer if there no error" $ do+      let (ts, (s, e)) = runTest $ do+            bracketOnError+              (put "allocated" >> pure ())+              (\() -> do+                get >>= trace+                put "finalized"+              )+              (\() -> do+                get >>= trace+                put "starting block"+                put "don't get here"+              )+      ts `shouldContain` ["allocated"]+      ts `shouldNotContain` ["starting block"]+      s `shouldBe` "don't get here"+      e `shouldBe` Right ()+