Merge pull request #9 from fused-effects/test-imony

Add test suite.

.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

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/).

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

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
+