git.iko.soy/effectful
on master help sign in
More tests for exceptions and concurrency
4dbb829Andrzej Rybczak
effective.cabal+3
compare with master
unifiedsplit
@@ -93,8 +93,11 @@ test-suite test
93 build-depends: base <5
93 build-depends: base <5
94 , effective
94 , effective
95 , exceptions
95 , exceptions
96+ , lifted-async
97+ , lifted-base
96 , tasty
98 , tasty
97 , tasty-hunit
99 , tasty-hunit
100+ , unliftio
98
101
99 hs-source-dirs: tests
102 hs-source-dirs: tests
100
103
tests/Main.hs+49−13
@@ -1,9 +1,12 @@
1module Main (main) where
1module Main (main) where
2
2
3−import Control.Monad.Catch
3+import Control.Concurrent.Async.Lifted
4import Control.Monad.IO.Class
4import Control.Monad.IO.Class
5import Test.Tasty
5import Test.Tasty
6import Test.Tasty.HUnit
6import Test.Tasty.HUnit
7+import qualified Control.Monad.Catch as E
8+import qualified Control.Exception.Lifted as LE
9+import qualified UnliftIO.Exception as UE
7
10
8import Effective
11import Effective
9import Effective.State
12import Effective.State
@@ -16,6 +19,7 @@ main = defaultMain $ testGroup "effective"
16 , testCase "stateM" test_stateM
19 , testCase "stateM" test_stateM
17 , testCase "deep stack" test_deepStack
20 , testCase "deep stack" test_deepStack
18 , testCase "exceptions" test_exceptions
21 , testCase "exceptions" test_exceptions
22+ , testCase "concurrency" test_concurrentState
19 ]
23 ]
20 ]
24 ]
21
25
@@ -50,28 +54,60 @@ test_deepStack = runEffIO $ do
50
54
51test_exceptions :: Assertion
55test_exceptions :: Assertion
52test_exceptions = runEffIO $ do
56test_exceptions = runEffIO $ do
53− e <- try @_ @Ex $ runState (0::Int) action
57+ testTry "exceptions" E.try
54− assertEqual_ "exception caught" e (Left Ex)
58+ testCatch "exceptions" E.catch
55−
59+ testTry "lifted-base" LE.try
56− s1 <- execState (0::Int) $ try @_ @Ex action
60+ testCatch "lifted-base" LE.catch
57− assertEqual_ "state partially updated" s1 1
61+ testTry "unliftio" UE.try
58−
62+ testCatch "unliftio" UE.catch
59− s2 <- execState (0::Int) $ do
60− evalState () action `catch` \Ex -> modify @Int (+4)
61− modify @Int (+8)
62− assertEqual_ "state correctly updated" s2 13
63 where
63 where
64+ testTry
65+ :: String
66+ -> (forall a es. IOE :> es => Eff es a -> Eff es (Either Ex a))
67+ -> Eff '[IOE] ()
68+ testTry lib tryImpl = do
69+ e <- tryImpl $ runState (0::Int) action
70+ assertEqual_ (lib ++ " - exception caught") e (Left Ex)
71+ s <- execState (0::Int) $ tryImpl action
72+ assertEqual_ (lib ++ " - state partially updated") s 1
73+
74+ testCatch
75+ :: String
76+ -> (forall a es. IOE :> es => Eff es a -> (Ex -> Eff es a) -> Eff es a)
77+ -> Eff '[IOE] ()
78+ testCatch lib catchImpl = do
79+ s <- execState (0::Int) $ do
80+ _ <- (evalState () action) `catchImpl` \Ex -> modify @Int (+4)
81+ modify @Int (+8)
82+ assertEqual_ (lib ++ " - state correctly updated") s 13
83+
64 action :: State Int :> es => Eff es ()
84 action :: State Int :> es => Eff es ()
65 action = do
85 action = do
66 modify @Int (+1)
86 modify @Int (+1)
67− _ <- throwM Ex
87+ _ <- E.throwM Ex
68 modify @Int (+2)
88 modify @Int (+2)
69
89
90+test_concurrentState :: Assertion
91+test_concurrentState = runEffIO . evalState x $ do
92+ replicateConcurrently_ 2 $ do
93+ r <- goDownward 0
94+ assertEqual_ "x = n" x r
95+ where
96+ x :: Int
97+ x = 1000000
98+
99+ goDownward :: State Int :> es => Int -> Eff es Int
100+ goDownward acc = get @Int >>= \case
101+ 0 -> pure acc
102+ n -> do
103+ put $ n - 1
104+ goDownward $ acc + 1
105+
70----------------------------------------
106----------------------------------------
71-- Helpers
107-- Helpers
72
108
73data Ex = Ex deriving (Eq, Show)
109data Ex = Ex deriving (Eq, Show)
74−instance Exception Ex
110+instance E.Exception Ex
75
111
76runEffIO :: Eff '[IOE] a -> IO a
112runEffIO :: Eff '[IOE] a -> IO a
77runEffIO = runEff . runIOE
113runEffIO = runEff . runIOE