on fbc5b30 help sign in
effectful/tests/AsyncTests.hs
71 lines 1.9 kB history raw
1module AsyncTests (asyncTests) where
3import Control.Concurrent (threadDelay)
4import Control.Monad
5import Control.Monad.IO.Class
6import Test.Tasty
7import Test.Tasty.HUnit
8import qualified Data.Set as S
10import Effectful.Async
11import Effectful.Error
12import Effectful.State.Dynamic
13import Effectful.Monad
14import qualified Utils as U
16asyncTests :: TestTree
17asyncTests = testGroup "Async"
18 [ testCase "local state" test_localState
19 , testCase "shared state" test_sharedState
20 , testCase "error handling" test_errorHandling
21 ]
23test_localState :: Assertion
24test_localState = runIOE . runAsyncE . evalState x $ do
25 replicateConcurrently_ 2 $ do
26 r <- goDownward 0
27 U.assertEqual "expected result" x r
28 where
29 x :: Int
30 x = 100000
32 goDownward :: State Int :> es => Int -> Eff es Int
33 goDownward acc = do
34 end <- state @Int $ \case
35 0 -> (True, 0)
36 n -> (False, n - 1)
37 if end
38 then pure acc
39 else goDownward $ acc + 1
41test_sharedState :: Assertion
42test_sharedState = runIOE . runAsyncE . evalStateMVar (S.empty @Int) $ do
43 concurrently_ (addWhen even x) (addWhen odd x)
44 U.assertEqual "expected result" (S.fromList [1..x]) =<< get
45 where
46 x :: Int
47 x = 100
49 addWhen :: State (S.Set Int) :> es => (Int -> Bool) -> Int -> Eff es ()
50 addWhen f = \case
51 0 -> pure ()
52 n -> do
53 when (f n) $ do
54 modify $ S.insert n
55 addWhen f $ n - 1
57test_errorHandling :: Assertion
58test_errorHandling = runIOE . runAsyncE . evalStateMVar (0::Int) $ do
59 r <- runError $ concurrently_
60 (liftIO (threadDelay 10000) >> throwError err)
61 (modify (+x))
62 case r of
63 Left (_, e) -> U.assertEqual "error caught" err e
64 Right _ -> U.assertFailure "error not caught"
65 U.assertEqual "state updated" x =<< get
66 where
67 x :: Int
68 x = 67
70 err :: String
71 err = "thrown from async"