effectful 2.1.0.0 → 2.2.0.0

raw patch · 10 files changed

+210/−110 lines, 10 filesdep +primitivedep ~effectful-corePVP ok

version bump matches the API change (PVP)

Dependencies added: primitive

Dependency ranges changed: effectful-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +23/−19
• effectful.cabal +8/−7
• examples/FileSystem.hs +0/−64
• tests/EnvTests.hs +29/−5
• tests/ErrorTests.hs +14/−14
• tests/Main.hs +4/−0
• tests/NonDetTests.hs +101/−0
• tests/PrimTests.hs +22/−0
• tests/ReaderTests.hs +1/−1

@@ -1,3 +1,11 @@+# effectful-2.2.0.0 (2022-10-24)+* Change `PrimState` for `Eff` from `RealWorld` to `PrimStateEff` to prevent the+  `Prim` effect from executing arbitrary `IO` actions via `ioToPrim`.+* Deprecate `(:>>)` as [GHC can't efficiently deal with type+  families](https://github.com/haskell-effectful/effectful/issues/52#issuecomment-1269155485).+* Add support for the `Alternative` and `MonadPlus` instances for `Eff` via the+  `NonDet` effect.+ # effectful-2.1.0.0 (2022-08-22) * Include the `e :> localEs` constraint in the `EffectHandler` to allow more   flexibility in handling higher order effects.

@@ -49,19 +49,11 @@ things that matter instead of reinventing all kinds of wheels, hence being a necessary condition for broader adoption of the library. -However, `eff` uses delimited continuations underneath, which:--- Are not yet supported by GHC (though [the-proposal](https://github.com/ghc-proposals/ghc-proposals/pull/313) for including-support for them has been accepted).--- Are quite hard to understand.--- Make the library "too powerful" in a sense as it faces-  [a](https://github.com/hasura/eff/issues/13)-  [few](https://github.com/hasura/eff/issues/7)-  [issues](https://github.com/hasura/eff/issues/12) with no clear path towards-  their resolution.+Unfortunately, the development of `eff` has stalled due to a+[few](https://github.com/hasura/eff/issues/13)+[subtle](https://github.com/hasura/eff/issues/7)+[issues](https://github.com/hasura/eff/issues/12) related to its use of+delimited continuations underneath.  ### What about `mtl`? @@ -101,8 +93,19 @@  ### Any downsides? -As always, there's no free lunch. The `Eff` monad doesn't support `NonDet` nor-`Coroutine` effects. However, the `NonDet` effect in existing libraries is+As always, there's no free lunch. The `Eff` monad doesn't support effect+handlers that require the ability to suspend or capture the rest of the+computation and resume it later (potentially multiple times). This prevents+`effectful` from providing (in particular):++- A `NonDet` effect handler that executes multiple+[`Alternative`](https://hackage.haskell.org/package/base/docs/Control-Applicative.html#t:Alternative)+branches and collects their results.++- A `Coroutine` effect.++It needs to be noted however that such `NonDet` effect handler in existing+libraries is [broken](https://github.com/lexi-lambda/eff/blob/8c4df4bf54faf22456354be18095b14825be5e85/notes/semantics-zoo.md) and none of the ones with support for higher order effects provide the `Coroutine` effect, so arguably it's not a big loss.@@ -110,7 +113,7 @@ If you need such capability in your application, there are well established libraries such as [conduit](https://hackage.haskell.org/package/conduit) or [list-t](https://hackage.haskell.org/package/list-t) that can be used with-`effectful` without any issues.+`effectful` without any hassle.  ### Summary @@ -147,9 +150,10 @@  ## Example -A `Filesystem` effect with two handlers, one that runs in `IO` and another that-uses an in-memory virtual file system can be found-[here](https://github.com/haskell-effectful/effectful/blob/master/effectful/examples/FileSystem.hs).+For the examples see the *Introduction* sections of+[`Effectful.Dispatch.Dynamic`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Dynamic.html)+and+[`Effectful.Dispatch.Static`](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Static.html).  ## Resources 

@@ -1,7 +1,7 @@ cabal-version:      2.4 build-type:         Simple name:               effectful-version:            2.1.0.0+version:            2.2.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.4 || ==9.4.1+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2  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      >= 2.1.0.0   && < 2.1.1.0+                    , effectful-core      >= 2.2.0.0   && < 2.2.1.0                     , process             >= 1.6.9                      , time                >= 1.9.2@@ -101,6 +101,7 @@                          , Effectful.Error.Static                          , Effectful.Error.Dynamic                          , Effectful.Fail+                         , Effectful.NonDet                          , Effectful.Prim                          , Effectful.Reader.Dynamic                          , Effectful.Reader.Static@@ -122,11 +123,12 @@                     , effectful-core                     , exceptions                     , lifted-base+                    , primitive                     , tasty                     , tasty-hunit                     , unliftio -    hs-source-dirs: tests examples+    hs-source-dirs: tests      type:           exitcode-stdio-1.0     main-is:        Main.hs@@ -136,14 +138,13 @@                     EnvTests                     EnvironmentTests                     ErrorTests+                    NonDetTests+                    PrimTests                     ReaderTests                     StateTests                     TimeoutTests                     UnliftTests                     Utils-                    -- These are examples; We do not actually run them but list-                    -- them here in order to check if they compile.-                    FileSystem  benchmark bench     import:         language

@@ -1,64 +0,0 @@-module FileSystem-  ( FileSystem(..)-  , FsError(..)-  , readFile-  , writeFile-  , runFileSystemIO-  , runFileSystemPure-  ) where--import Control.Exception (IOException)-import Control.Monad.Catch-import Prelude hiding (readFile, writeFile)-import qualified Data.Map.Strict as M-import qualified System.IO as IO--import Effectful-import Effectful.Dispatch.Dynamic-import Effectful.Error.Static-import Effectful.State.Static.Local---- | An effect for reading and writing files.-data FileSystem :: Effect where-  ReadFile  :: FilePath -> FileSystem m String-  WriteFile :: FilePath -> String -> FileSystem m ()--type instance DispatchOf FileSystem = Dynamic----- | File system error.-newtype FsError = FsError String--------------------------------------------- Operations---- | Read contents of a file.-readFile :: (HasCallStack, FileSystem :> es) => FilePath -> Eff es String-readFile = send . ReadFile---- | Write contents to a file.-writeFile :: (HasCallStack, FileSystem :> es) => FilePath -> String -> Eff es ()-writeFile path = send . WriteFile path--------------------------------------------- Handlers--runFileSystemIO-  :: (IOE :> es, Error FsError :> es)-  => Eff (FileSystem : es) a-  -> Eff es a-runFileSystemIO = interpret $ \_ -> \case-  ReadFile path           -> adapt $ IO.readFile path-  WriteFile path contents -> adapt $ IO.writeFile path contents-  where-    adapt m = liftIO m `catch` \(e::IOException) -> throwError . FsError $ show e--runFileSystemPure-  :: Error FsError :> es-  => M.Map FilePath String-  -> Eff (FileSystem : es) a-  -> Eff es a-runFileSystemPure fs0 = reinterpret (evalState fs0) $ \_ -> \case-  ReadFile path -> gets (M.lookup path) >>= \case-    Just contents -> pure contents-    Nothing       -> throwError . FsError $ "File not found: " ++ show path-  WriteFile path contents -> modify $ M.insert path contents

@@ -7,6 +7,8 @@  import Effectful import Effectful.Dispatch.Dynamic+import Effectful.Dispatch.Static+import Effectful.Dispatch.Static.Primitive import Effectful.Reader.Static import Effectful.State.Static.Local import qualified Utils as U@@ -60,11 +62,13 @@  test_noUnsafeCoerce :: Assertion test_noUnsafeCoerce = do-  r <- try @ErrorCall . evaluate $ unsafeCoerce @Int 'a'-  assertBool "unsafeCoerce" (isLeft r)+  r1 <- try @ErrorCall . evaluate $ unsafeCoerce1 @Int 'a'+  assertBool "unsafeCoerce1" (isLeft r1)+  r2 <- try @ErrorCall . evaluate $ unsafeCoerce2 @Int 'a'+  assertBool "unsafeCoerce2" (isLeft r2) -unsafeCoerce :: forall b a. a -> b-unsafeCoerce a = runPureEff $ do+unsafeCoerce1 :: forall b a. a -> b+unsafeCoerce1 a = runPureEff $ do   -- 'oops' gains access to the effect stack with Reader (Box b) via the   -- unlifting function that escaped its scope. The problem here is that this   -- effect is no longer in scope.@@ -72,7 +76,27 @@     raiseWith SeqUnlift $ \unlift -> do       pure . unlift $ ask @(Box b)   -- Put Reader (Box a) where the Reader (Box b) was before and attempt to-  -- retrieve 'a' coerced to 'b'. It fails because 'getLocation' in+  -- retrieve 'a' coerced to 'b'. It should fail because 'getLocation' in+  -- 'Effectful.Internal.Env' checks that version of the reference is the same+  -- as version of the effect.+  Box b <- runReader (Box a) $ raise oops+  pure b++unsafeCoerce2 :: forall b a. a -> b+unsafeCoerce2 a = runPureEff $ do+  backupEs <- unsafeEff cloneEnv+  -- 'oops' gains access to the effect stack with Reader (Box b) via the+  -- unlifting function that escaped its scope. The problem here is that this+  -- effect is no longer in scope.+  oops <- runReader @(Box b) (Box undefined) $ do+    raiseWith SeqUnlift $ \unlift -> do+      pure . unlift $ ask @(Box b)+  -- If restoreEnv messes up versioning (i.e. restores the version counter from+  -- before the above Reader was used), below code will succeed because the+  -- Reader (Box a) will have the same version as Reader (Box b).+  unsafeEff $ \es -> restoreEnv es backupEs+  -- Put Reader (Box a) where the Reader (Box b) was before and attempt to+  -- retrieve 'a' coerced to 'b'. It should fail because 'getLocation' in   -- 'Effectful.Internal.Env' checks that version of the reference is the same   -- as version of the effect.   Box b <- runReader (Box a) $ raise oops

@@ -9,29 +9,29 @@  errorTests :: TestTree errorTests = testGroup "Error"-  [ testCase "error from interpret" test_errorFromInterpret+  [ testCase "different handlers are independent" test_independentHandlers   ] -test_errorFromInterpret :: Assertion-test_errorFromInterpret = runEff $ do-  result <- runError @String . runNestedErr $ do-    runError @String nestedErr+test_independentHandlers :: Assertion+test_independentHandlers = runEff $ do+  result <- runError @String . runOuterThrow $ do+    runError @String outerThrow   liftIO $ case result of     Left (cs, _) -> assertBool "stack trace points to the correct action" $-      "nestedErr" == fst (last $ getCallStack cs)+      "outerThrow" == fst (last $ getCallStack cs)     Right _ -> assertFailure "error caught by the wrong (inner) handler"  ---------------------------------------- -- Helpers -data NestedErr :: Effect where-  NestedErr :: NestedErr m ()+data OuterThrow :: Effect where+  OuterThrow :: OuterThrow m () -type instance DispatchOf NestedErr = Dynamic+type instance DispatchOf OuterThrow = Dynamic -nestedErr :: (HasCallStack, NestedErr :> es) => Eff es ()-nestedErr = send NestedErr+outerThrow :: (HasCallStack, OuterThrow :> es) => Eff es ()+outerThrow = send OuterThrow -runNestedErr :: Error String :> es => Eff (NestedErr : es) a -> Eff es a-runNestedErr = interpret $ \_ -> \case-  NestedErr -> throwError "nested error"+runOuterThrow :: Error String :> es => Eff (OuterThrow : es) a -> Eff es a+runOuterThrow = interpret $ \_ -> \case+  OuterThrow -> throwError "outer"

@@ -7,6 +7,8 @@ import EnvTests import EnvironmentTests import ErrorTests+import NonDetTests+import PrimTests import ReaderTests import StateTests import TimeoutTests@@ -19,6 +21,8 @@   , envTests   , environmentTests   , errorTests+  , nonDetTests+  , primTests   , readerTests   , stateTests   , timeoutTests

@@ -0,0 +1,101 @@+module NonDetTests (nonDetTests) where++import Test.Tasty+import Test.Tasty.HUnit++import Effectful+import Effectful.Dispatch.Dynamic+import Effectful.NonDet+import Effectful.Reader.Static+import Effectful.State.Dynamic++import qualified Utils as U++nonDetTests :: TestTree+nonDetTests = testGroup "NonDet"+  [ testCaseSteps "empty (left)"  $ test_empty leftEmpty+  , testCaseSteps "empty (right)" $ test_empty rightEmpty+  , testGroup "interaction"+    [ testCaseSteps "local state"  $ test_state evalStateLocal  expectedLocalState+    , testCaseSteps "shared state" $ test_state evalStateShared expectedSharedState+    ]+  , testCaseSteps "different handlers are independent" test_independentHandlers+  ]+  where+    leftEmpty :: NonDet :> es => Eff es Bool+    leftEmpty  = runReader () (empty >> pure False) <|> runReader () (pure True)++    rightEmpty :: NonDet :> es => Eff es Bool+    rightEmpty = runReader () (pure True) <|> runReader () (empty >> pure False)++    expectedLocalState :: OnEmptyPolicy -> Int+    expectedLocalState = \case+      OnEmptyKeep     -> 3+      OnEmptyRollback -> 2++    expectedSharedState :: OnEmptyPolicy -> Int+    expectedSharedState _ = 3++test_empty+  :: Eff [NonDet, IOE] Bool+  -> (String -> IO ())+  -> Assertion+test_empty test step = runEff $ do+  runNonDetBoth test $ \policy result -> do+    liftIO . step $ show policy+    U.assertEqual "result" (Just True) (dropLeft result)++test_state+  :: (forall r. Int -> Eff [State Int, IOE] r -> Eff '[IOE] r)+  -> (OnEmptyPolicy -> Int)+  -> (String -> IO ())+  -> IO ()+test_state evalState expectedState step = runEff $ do+  evalState 0 . runNonDetBoth test $ \policy result -> do+    liftIO . step $ show policy+    U.assertEqual "result" (Just ()) (dropLeft result)+    s <- state @Int $ \s -> (s, 0)+    U.assertEqual "state" (expectedState policy) s+  where+    test :: (NonDet :> es, State Int :> es) => Eff es ()+    test = (modify @Int (+1) >> empty) <|> modify @Int (+2)++test_independentHandlers :: (String -> IO ()) -> Assertion+test_independentHandlers step = runEff $ do+  runNonDetBoth test $ \policy result -> liftIO $ do+    step $ show policy+    case result of+      Left cs -> assertBool "stack trace points to the correct action" $+        "outerEmpty" == fst (last $ getCallStack cs)+      Right _ -> assertFailure "empty handled by the wrong (inner) handler"+  where+    test :: NonDet :> es => Eff es (Either CallStack Bool)+    test = runOuterEmpty . runNonDet OnEmptyKeep $ outerEmpty <|> pure True++----------------------------------------+-- Helpers++data OuterEmpty :: Effect where+  OuterEmpty :: OuterEmpty m a++type instance DispatchOf OuterEmpty = Dynamic++outerEmpty :: (HasCallStack, OuterEmpty :> es) => Eff es a+outerEmpty = send OuterEmpty++runOuterEmpty :: NonDet :> es => Eff (OuterEmpty : es) a -> Eff es a+runOuterEmpty = interpret $ \_ -> \case+  OuterEmpty -> emptyEff++----++dropLeft :: Either e a -> Maybe a+dropLeft = either (const Nothing) Just++runNonDetBoth+  :: Eff (NonDet : es) a+  -> (OnEmptyPolicy -> Either CallStack a -> Eff es ())+  -> Eff es ()+runNonDetBoth m k = do+  k OnEmptyKeep     =<< runNonDet OnEmptyKeep m+  k OnEmptyRollback =<< runNonDet OnEmptyRollback m

@@ -0,0 +1,22 @@+module PrimTests (primTests) where++import Data.Primitive.MutVar+import Test.Tasty+import Test.Tasty.HUnit+import qualified Utils as U++import Effectful+import Effectful.Prim++primTests :: TestTree+primTests = testGroup "Prim"+  [ testCase "MutVar works" test_MutVar+  ]++test_MutVar :: Assertion+test_MutVar = runEff . runPrim $ do+  mv <- newMutVar (0::Int)+  modifyMutVar mv (+1)+  v <- readMutVar mv+  writeMutVar mv (v + 2)+  U.assertEqual "MutVar works" 3 =<< readMutVar mv

@@ -25,7 +25,7 @@ test_localInHandler runR = runEff . runR "global" . interpret f $ do   local (const "local") $ send SomeAction   where-    f :: [IOE, Reader String] :>> es => EffectHandler SomeEff es+    f :: (IOE :> es, Reader String :> es) => EffectHandler SomeEff es     f _ SomeAction = U.assertEqual "expected result" "local" =<< ask  -- | Purely dynamic Reader for testing purposes.