effectful 1.2.0.0 → 2.0.0.0
raw patch · 5 files changed
+134/−36 lines, 5 filesdep ~effectful-coredep ~freer-simpledep ~fused-effectsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: effectful-core, freer-simple, fused-effects, polysemy
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- bench/Countdown.hs +44/−0
- bench/Main.hs +8/−0
- effectful.cabal +10/−10
- tests/EnvTests.hs +65/−26
CHANGELOG.md view
@@ -1,3 +1,10 @@+# effectful-2.0.0.0 (2022-08-12)+* Make storage references in the environment immutable.+* Remove `checkSizeEnv` and `forkEnv` from+ `Effectful.Dispatch.Static.Primitive`.+* Add internal versioning of effects to prevent leakage of `unsafeCoerce`.+* Make `interpose` and `impose` properly interact with other handlers.+ # effectful-1.2.0.0 (2022-07-28) * Change `SuffixOf` to `SharedSuffix` and make it behave as advertised. * Add `raiseWith`.
bench/Countdown.hs view
@@ -133,6 +133,50 @@ where runR = E.runReader () +----++programEffectfulLocalSt :: EL.State Integer E.:> es => E.Eff es Integer+programEffectfulLocalSt = do+ n <- EL.state @Integer $ \s -> (s, s - 1)+ if n <= 0+ then pure n+ else programEffectfulLocalSt+{-# NOINLINE programEffectfulLocalSt #-}++countdownEffectfulLocalSt :: Integer -> (Integer, Integer)+countdownEffectfulLocalSt n = E.runPureEff . EL.runState n $ programEffectfulLocalSt++countdownEffectfulLocalDeepSt :: Integer -> (Integer, Integer)+countdownEffectfulLocalDeepSt n = E.runPureEff+ . runR . runR . runR . runR . runR+ . EL.runState n+ . runR . runR . runR . runR . runR+ $ programEffectfulLocalSt+ where+ runR = E.runReader ()++----++programEffectfulLocalStM :: EL.State Integer E.:> es => E.Eff es Integer+programEffectfulLocalStM = do+ n <- EL.stateM @Integer $ \s -> pure (s, s - 1)+ if n <= 0+ then pure n+ else programEffectfulLocalStM+{-# NOINLINE programEffectfulLocalStM #-}++countdownEffectfulLocalStM :: Integer -> (Integer, Integer)+countdownEffectfulLocalStM n = E.runPureEff . EL.runState n $ programEffectfulLocalStM++countdownEffectfulLocalDeepStM :: Integer -> (Integer, Integer)+countdownEffectfulLocalDeepStM n = E.runPureEff+ . runR . runR . runR . runR . runR+ . EL.runState n+ . runR . runR . runR . runR . runR+ $ programEffectfulLocalStM+ where+ runR = E.runReader ()+ ---------------------------------------- -- effectful (mvar)
bench/Main.hs view
@@ -31,6 +31,14 @@ [ bench "shallow" $ nf countdownEffectfulLocal n , bench "deep" $ nf countdownEffectfulLocalDeep n ]+ , bgroup "effectful (local/static/state)"+ [ bench "shallow" $ nf countdownEffectfulLocalSt n+ , bench "deep" $ nf countdownEffectfulLocalDeepSt n+ ]+ , bgroup "effectful (local/static/stateM)"+ [ bench "shallow" $ nf countdownEffectfulLocalStM n+ , bench "deep" $ nf countdownEffectfulLocalDeepStM n+ ] , bgroup "effectful (local/dynamic)" [ bench "shallow" $ nf countdownEffectfulDynLocal n , bench "deep" $ nf countdownEffectfulDynLocalDeep n
effectful.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 build-type: Simple name: effectful-version: 1.2.0.0+version: 2.0.0.0 license: BSD-3-Clause license-file: LICENSE category: Control@@ -22,7 +22,7 @@ CHANGELOG.md README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 || ==9.4.1+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.1 bug-reports: https://github.com/haskell-effectful/effectful/issues source-repository head@@ -67,7 +67,7 @@ , async >= 2.2.2 , bytestring >= 0.10 , directory >= 1.3.2- , effectful-core >= 1.2.0.0 && < 1.3.0.0+ , effectful-core >= 2.0.0.0 && < 2.0.1.0 , process >= 1.6.9 , time >= 1.9.2@@ -153,17 +153,17 @@ if flag(benchmark-foreign-libraries) build-depends: mtl - if impl(ghc < 9.3)+ if impl(ghc < 9.5) build-depends: cleff >= 0.3.3.0 - if impl(ghc < 9.3)- build-depends: freer-simple+ if impl(ghc < 9.5)+ build-depends: freer-simple >= 1.2.1.2 - if impl(ghc < 9.3)- build-depends: fused-effects >= 1.1.0.0+ if impl(ghc < 9.5)+ build-depends: fused-effects >= 1.1.2.0 - if impl(ghc < 9.3)- build-depends: polysemy+ if impl(ghc < 9.5)+ build-depends: polysemy >= 1.7.1.0 build-depends: base , async
tests/EnvTests.hs view
@@ -1,45 +1,33 @@ module EnvTests (envTests) where +import Control.Exception+import Data.Either import Test.Tasty import Test.Tasty.HUnit import Effectful-import Effectful.Dispatch.Static-import Effectful.Dispatch.Static.Primitive+import Effectful.Dispatch.Dynamic import Effectful.Reader.Static import Effectful.State.Static.Local import qualified Utils as U envTests :: TestTree envTests = testGroup "Env"- [ testCase "staircase forkEnv" test_staircaseForkEnv- , testCase "tailEnv through forks" test_unforkedTailEnv+ [ testCase "tailEnv works" test_tailEnv , testCase "subsume works" test_subsumeEnv , testCase "inject works" test_injectEnv+ , testCase "unsafeCoerce doesn't leak" test_noUnsafeCoerce+ , testCase "interpose works" test_interpose ] -test_staircaseForkEnv :: Assertion-test_staircaseForkEnv = runEff $ do- unsafeEff $ \es0 -> do- es0f <- forkEnv es0- (`unEff` es0f) $ evalState s0 $ do- unsafeEff $ \es1 -> do- es1f <- forkEnv es1- (`unEff` es1f) $ runReader () $ do- U.assertEqual "expected result" s0 =<< get- where- s0 :: Int- s0 = 1337--test_unforkedTailEnv :: Assertion-test_unforkedTailEnv = runEff . evalState s0 . runReader () $ do- unsafeEff $ \es0 -> do- es0f <- forkEnv es0- (`unEff` es0f) $ runReader () $ do- unsafeEff $ \es1 -> do- es1f <- forkEnv es1- (`unEff` es1f) $ runReader () . raise . raise . raise $ do- U.assertEqual "expected result" s0 =<< get+test_tailEnv :: Assertion+test_tailEnv = runEff . evalState s0 $ do+ runReader () $ do+ runReader () $ do+ raise $ do+ runReader () $ do+ raise . raise $ do+ U.assertEqual "expected result" s0 =<< get where s0 :: Int s0 = 1337@@ -67,3 +55,54 @@ innerAction = do modify @Int (+4) raise $ modify @Int (+8)++test_noUnsafeCoerce :: Assertion+test_noUnsafeCoerce = do+ r <- try @ErrorCall $ funToInt id+ assertBool "unsafeCoerce leaks" (isLeft r)+ where+ funToInt :: (a -> b) -> IO Int+ funToInt f = runEff $ do+ oops <- runReader @Int 0 $ do+ withEffToIO $ \unlift -> do+ pure . unlift $ ask @Int+ runReader f $ liftIO oops++----------------------------------------++test_interpose :: IO ()+test_interpose = runEff $ do+ runA . runB . runReader () $ do+ a1 <- send A+ b1 <- send B+ U.assertEqual "a1 original" 3 a1+ U.assertEqual "b1 original" 3 b1+ doubleA $ do+ a2 <- send A+ b2 <- send B+ U.assertEqual "a2 interposed" 6 a2+ U.assertEqual "b2 interposed" 6 b2+ a3 <- send A+ b3 <- send B+ U.assertEqual "a3 original" 3 a3+ U.assertEqual "b3 original" 3 b3++data A :: Effect where+ A :: A m Int+type instance DispatchOf A = Dynamic++runA :: IOE :> es => Eff (A : es) a -> Eff es a+runA = interpret $ \_ -> \case+ A -> pure 3++doubleA :: (IOE :> es, A :> es) => Eff es a -> Eff es a+doubleA = interpose $ \_ -> \case+ A -> (+) <$> send A <*> send A++data B :: Effect where+ B :: B m Int+type instance DispatchOf B = Dynamic++runB :: (IOE :> es, A :> es) => Eff (B : es) a -> Eff es a+runB = interpret $ \_ -> \case+ B -> send A