git.iko.soy/effectful
on 8a63c15 help sign in
effectful/tests/Main.hs
137 lines 3.9 kB history raw
1module Main (main) where
3import Control.Concurrent.Async.Lifted
4import Control.Monad.IO.Class
5import Test.Tasty
6import Test.Tasty.HUnit
7import qualified Control.Monad.Catch as E
8import qualified Control.Exception.Lifted as LE
9import qualified UnliftIO.Exception as UE
11import Effectful
12import Effectful.State
14main :: IO ()
15main = defaultMain $ testGroup "effectful"
16 [ testGroup "state"
17 [ testCase "runState & execState" test_runState
18 , testCase "evalState" test_evalState
19 , testCase "stateM" test_stateM
20 , testCase "deep stack" test_deepStack
21 , testCase "exceptions" test_exceptions
22 , testCase "concurrency" test_concurrentState
23 ]
24 ]
26test_runState :: Assertion
27test_runState = runEffIO $ do
28 (end, len) <- runState (0::Int) . execState collatzStart $ collatz
29 assertEqual_ "correct end" 1 end
30 assertEqual_ "correct len" collatzLength len
32test_evalState :: Assertion
33test_evalState = runEffIO $ do
34 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
35 assertEqual_ "correct len" collatzLength len
37test_stateM :: Assertion
38test_stateM = runEffIO $ do
39 (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")
40 assertEqual_ "correct a" "hi" a
41 assertEqual_ "correct b" "hi!!!" b
43test_deepStack :: Assertion
44test_deepStack = runEffIO $ do
45 n <- evalState () . execState (0::Int) $ do
46 evalState () . evalState () $ do
47 evalState () $ do
48 evalState () . evalState () . evalState () $ do
49 modify @Int (+1)
50 modify @Int (+2)
51 modify @Int (+4)
52 modify @Int (+8)
53 assertEqual_ "n" 15 n
55test_exceptions :: Assertion
56test_exceptions = runEffIO $ do
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
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
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
84 action :: State Int :> es => Eff es ()
85 action = do
86 modify @Int (+1)
87 _ <- E.throwM Ex
88 modify @Int (+2)
90test_concurrentState :: Assertion
91test_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
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
106----------------------------------------
107-- Helpers
109data Ex = Ex deriving (Eq, Show)
110instance E.Exception Ex
112runEffIO :: Eff '[IOE] a -> IO a
113runEffIO = runEff . runIOE
115assertEqual_ :: (Eq a, Show a, IOE :> es) => String -> a -> a -> Eff es ()
116assertEqual_ msg expected given = liftIO $ assertEqual msg expected given
118----------------------------------------
120collatzStart :: Integer
121collatzStart = 9780657630
123collatzLength :: Int
124collatzLength = 1132
126-- | Tests multiple 'State'S, 'put', 'get' and 'modify'.
127collatz :: (State Integer :> es, State Int :> es) => Eff es ()
128collatz = get @Integer >>= \case
129 1 -> pure ()
130 n -> if even n
131 then do put $ n `div` 2
132 modify @Int (+1)
133 collatz
134 else do put $ 3*n + 1
135 modify @Int (+1)
136 collatz
137{-# NOINLINE collatz #-}