fused-effects-exceptions/test/Main.hs

34 lines
1015 B
Haskell
Raw Normal View History

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
2019-10-29 18:15:52 +00:00
module Main where
import Prelude hiding (ioError)
import Control.Carrier.Lift (runM)
import qualified Control.Carrier.State.Strict as State
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
2020-07-13 15:15:51 +00:00
result <- State.execState 'a' problematic
result HUnit.@?= 'a' -- writes are lost
tests :: Tasty.TestTree
tests = Tasty.testGroup "Control.Carrier.Exception"
[ Tasty.testGroup "finally"
[ testStateDropsWrites
]
]
2019-10-29 18:15:52 +00:00
main :: IO ()
main = Tasty.defaultMain tests