git.iko.soy/effectful
on 4f77232 help sign in
effectful/tests/StateTests.hs
141 lines 4.0 kB history raw
1module StateTests (stateTests) where
3import Test.Tasty
4import Test.Tasty.HUnit
5import qualified Control.Monad.Catch as E
6import qualified Control.Exception.Lifted as LE
7import qualified UnliftIO.Exception as UE
9import Effectful.Interpreter
10import Effectful.State.Dynamic
11import Effectful.Monad
12import qualified Utils as U
14stateTests :: TestTree
15stateTests = testGroup "State"
16 [ testCase "runState & execState" test_runState
17 , testCase "evalState" test_evalState
18 , testCase "stateM" test_stateM
19 , testCase "deep stack" test_deepStack
20 , testCase "exceptions" test_exceptions
21 , testCase "local effects" test_localEffects
22 ]
24test_runState :: Assertion
25test_runState = runIOE $ do
26 (end, len) <- runState (0::Int) . execState collatzStart $ collatz
27 U.assertEqual "correct end" 1 end
28 U.assertEqual "correct len" collatzLength len
30test_evalState :: Assertion
31test_evalState = runIOE $ do
32 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
33 U.assertEqual "correct len" collatzLength len
35test_stateM :: Assertion
36test_stateM = runIOE $ do
37 (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")
38 U.assertEqual "correct a" "hi" a
39 U.assertEqual "correct b" "hi!!!" b
41test_deepStack :: Assertion
42test_deepStack = runIOE $ do
43 n <- evalState () . execState (0::Int) $ do
44 evalState () . evalState () $ do
45 evalState () $ do
46 evalState () . evalState () . evalState () $ do
47 modify @Int (+1)
48 modify @Int (+2)
49 modify @Int (+4)
50 modify @Int (+8)
51 U.assertEqual "n" 15 n
53test_exceptions :: Assertion
54test_exceptions = runIOE $ do
55 testTry "exceptions" E.try
56 testCatch "exceptions" E.catch
57 testTry "lifted-base" LE.try
58 testCatch "lifted-base" LE.catch
59 testTry "unliftio" UE.try
60 testCatch "unliftio" UE.catch
61 where
62 testTry
63 :: String
64 -> (forall a es. IOE :> es => Eff es a -> Eff es (Either U.Ex a))
65 -> Eff '[IOE] ()
66 testTry lib tryImpl = do
67 e <- tryImpl $ runState (0::Int) action
68 U.assertEqual (lib ++ " - exception caught") e (Left U.Ex)
69 s <- execState (0::Int) $ tryImpl action
70 U.assertEqual (lib ++ " - state partially updated") s 1
72 testCatch
73 :: String
74 -> (forall a es. IOE :> es => Eff es a -> (U.Ex -> Eff es a) -> Eff es a)
75 -> Eff '[IOE] ()
76 testCatch lib catchImpl = do
77 s <- execState (0::Int) $ do
78 _ <- (evalState () action) `catchImpl` \U.Ex -> modify @Int (+4)
79 modify @Int (+8)
80 U.assertEqual (lib ++ " - state correctly updated") s 13
82 action :: State Int :> es => Eff es ()
83 action = do
84 modify @Int (+1)
85 _ <- E.throwM U.Ex
86 modify @Int (+2)
88test_localEffects :: Assertion
89test_localEffects = runIOE $ do
90 x <- runHasInt 0 $ do
91 putInt 1
92 execState () $ do
93 putInt 2
94 execState () $ do
95 putInt expected
96 getInt
97 U.assertEqual "correct x" expected x
98 where
99 expected :: Int
100 expected = 4
101----------------------------------------
102-- Helpers
104data HasInt :: Effect where
105 GetInt :: HasInt m Int
106 PutInt :: Int -> HasInt m ()
108getInt :: HasInt :> es => Eff es Int
109getInt = send GetInt
111putInt :: HasInt :> es => Int -> Eff es ()
112putInt = send . PutInt
114runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a
115runHasInt n =
116 -- reinterpret with redundant local effects
117 reinterpret (evalState () . evalState n . evalState True) $ \case
118 GetInt -> get
119 PutInt i -> put i
121----------------------------------------
122-- Helpers
124collatzStart :: Integer
125collatzStart = 9780657630
127collatzLength :: Int
128collatzLength = 1132
130-- | Tests multiple 'State'S, 'put', 'get' and 'modify'.
131collatz :: (State Integer :> es, State Int :> es) => Eff es ()
132collatz = get @Integer >>= \case
133 1 -> pure ()
134 n -> if even n
135 then do put $ n `div` 2
136 modify @Int (+1)
137 collatz
138 else do put $ 3*n + 1
139 modify @Int (+1)
140 collatz
141{-# NOINLINE collatz #-}