@@ -1,9 +1,12 @@
11module Main (main) where
22
3−import Control.Monad.Catch
3+import Control.Concurrent.Async.Lifted
44import Control.Monad.IO.Class
55import Test.Tasty
66import 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
710
811import Effective
912import Effective.State
@@ -16,6 +19,7 @@ main = defaultMain $ testGroup "effective"
1619 , testCase "stateM" test_stateM
1720 , testCase "deep stack" test_deepStack
1821 , testCase "exceptions" test_exceptions
22+ , testCase "concurrency" test_concurrentState
1923 ]
2024 ]
2125
@@ -50,28 +54,60 @@ test_deepStack = runEffIO $ do
5054
5155test_exceptions :: Assertion
5256test_exceptions = runEffIO $ do
53− e <- try @_ @Ex $ runState (0::Int) action
54− assertEqual_ "exception caught" e (Left Ex)
55−
56− s1 <- execState (0::Int) $ try @_ @Ex action
57− assertEqual_ "state partially updated" s1 1
58−
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
57+ testTry "exceptions" E.try
58+ testCatch "exceptions" E.catch
59+ testTry "lifted-base" LE.try
60+ testCatch "lifted-base" LE.catch
61+ testTry "unliftio" UE.try
62+ testCatch "unliftio" UE.catch
6363 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+
6484 action :: State Int :> es => Eff es ()
6585 action = do
6686 modify @Int (+1)
67− _ <- throwM Ex
87+ _ <- E.throwM Ex
6888 modify @Int (+2)
6989
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+
70106----------------------------------------
71107-- Helpers
72108
73109data Ex = Ex deriving (Eq, Show)
74−instance Exception Ex
110+instance E.Exception Ex
75111
76112runEffIO :: Eff '[IOE] a -> IO a
77113runEffIO = runEff . runIOE