diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 84adab5..e61f342 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -24,13 +24,13 @@ jobs: - name: Install dependencies run: | cabal v2-update - cabal v2-configure --write-ghc-environment-files=always -j2 + cabal v2-configure --enable-tests --write-ghc-environment-files=always -j2 cabal v2-build --only-dependencies - name: Build & test run: | cabal v2-build - cabal v2-run examples + cabal v2-test cabal v2-haddock cabal v2-sdist cabal check diff --git a/README.md b/README.md index 0b43da2..065328e 100644 --- a/README.md +++ b/README.md @@ -9,8 +9,9 @@ This package provides `Control.Effect.Exception`, a module that wraps the [`Cont Please be aware that injudicious use of these functions may provoke surprising interactions with carriers that thread a monadic state as a parameter, à la the `Control.Carrier.State` types provided by `fused-effects`. For example, a function like `finally`, which does not thread any state from its body to its handler block, may discard state writes in cleanup handlers: ```haskell -λ runM (runResource (runState 'a' (modify (succ @Char) `finally` modify (succ . succ @Char)))) -('b', ()) +λ run (runState 'a' ((throwIO (userError "urk") `finally` put @Char 'z') + `catch` (\(_ :: IOException) -> pure ()))) +('a', ()) ``` If this behavior is a concern, a `Control.Carrier.State.IORef` carrier is provided, which fixes this issue given access to a `MonadIO` constraint. If it is not a concern (such as if the cleanup block is only run for its effects in `IO`), then the `StateC` carriers from `fused-effects` will suffice. For more information about the issues associated with this approach, consult Alexis King's excellent [Demystifying `MonadBaseControl`](https://lexi-lambda.github.io/blog/2019/09/07/demystifying-monadbasecontrol/). diff --git a/fused-effects-exceptions.cabal b/fused-effects-exceptions.cabal index 0a17efd..a322e2b 100644 --- a/fused-effects-exceptions.cabal +++ b/fused-effects-exceptions.cabal @@ -33,6 +33,19 @@ library , fused-effects >= 1 , transformers >= 0.4 && < 0.6 +test-suite test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + build-depends: + base + , fused-effects-exceptions + , fused-effects + , tasty ^>= 1.2 + , tasty-hunit ^>= 0.10 + , transformers + source-repository head type: git location: https://github.com/fused-effects/fused-effects-exceptions diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..6f79a86 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE ScopedTypeVariables, TypeApplications #-} + +module Main where + +import Prelude hiding (ioError) + +import qualified Control.Carrier.State.IORef as IOState +import qualified Control.Carrier.State.Strict as State +import Control.Carrier.Lift (runM) +import Control.Effect.Exception +import Control.Effect.State +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as HUnit + +problematic :: (Has (Lift IO) sig m, Has (State Char) sig m) => m () +problematic = + let throws = modify @Char succ *> throwIO (userError "should explode") `finally` put @Char 'x' + in throws `catch` (\(_ :: IOException) -> pure ()) + +testStateDropsWrites :: Tasty.TestTree +testStateDropsWrites = HUnit.testCase "State.Strict drops writes" $ do + result <- runM . State.execState 'a' $ problematic + result HUnit.@?= 'a' -- writes are lost + +testIOStatePreservesWrites :: Tasty.TestTree +testIOStatePreservesWrites = HUnit.testCase "State.IORef preserves writes" $ do + result <- runM . IOState.execState 'a' $ problematic + result HUnit.@?= 'x' + +tests :: Tasty.TestTree +tests = Tasty.testGroup "Control.Carrier.Exception" + [ Tasty.testGroup "finally" + [ testStateDropsWrites + , testIOStatePreservesWrites + ] + ] + +main :: IO () +main = Tasty.defaultMain tests +