@@ -0,0 +1,101 @@
1+module Main (main) where
2+
3+import Control.Monad.Catch
4+import Control.Monad.IO.Class
5+import Test.Tasty
6+import Test.Tasty.HUnit
7+
8+import Effective
9+import Effective.State
10+
11+main :: IO ()
12+main = defaultMain $ testGroup "effective"
13+ [ testGroup "state"
14+ [ testCase "runState & execState" test_runState
15+ , testCase "evalState" test_evalState
16+ , testCase "stateM" test_stateM
17+ , testCase "deep stack" test_deepStack
18+ , testCase "exceptions" test_exceptions
19+ ]
20+ ]
21+
22+test_runState :: Assertion
23+test_runState = runEffIO $ do
24+ (end, len) <- runState (0::Int) . execState collatzStart $ collatz
25+ assertEqual_ "correct end" 1 end
26+ assertEqual_ "correct len" collatzLength len
27+
28+test_evalState :: Assertion
29+test_evalState = runEffIO $ do
30+ len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
31+ assertEqual_ "correct len" collatzLength len
32+
33+test_stateM :: Assertion
34+test_stateM = runEffIO $ do
35+ (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")
36+ assertEqual_ "correct a" "hi" a
37+ assertEqual_ "correct b" "hi!!!" b
38+
39+test_deepStack :: Assertion
40+test_deepStack = runEffIO $ do
41+ n <- evalState () . execState (0::Int) $ do
42+ evalState () . evalState () $ do
43+ evalState () $ do
44+ evalState () . evalState () . evalState () $ do
45+ modify @Int (+1)
46+ modify @Int (+2)
47+ modify @Int (+4)
48+ modify @Int (+8)
49+ assertEqual_ "n" 15 n
50+
51+test_exceptions :: Assertion
52+test_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
63+ where
64+ action :: State Int :> es => Eff es ()
65+ action = do
66+ modify @Int (+1)
67+ _ <- throwM Ex
68+ modify @Int (+2)
69+
70+----------------------------------------
71+-- Helpers
72+
73+data Ex = Ex deriving (Eq, Show)
74+instance Exception Ex
75+
76+runEffIO :: Eff '[IOE] a -> IO a
77+runEffIO = runEff . runIOE
78+
79+assertEqual_ :: (Eq a, Show a, IOE :> es) => String -> a -> a -> Eff es ()
80+assertEqual_ msg expected given = liftIO $ assertEqual msg expected given
81+
82+----------------------------------------
83+
84+collatzStart :: Integer
85+collatzStart = 9780657630
86+
87+collatzLength :: Int
88+collatzLength = 1132
89+
90+-- | Tests multiple 'State'S, 'put', 'get' and 'modify'.
91+collatz :: (State Integer :> es, State Int :> es) => Eff es ()
92+collatz = get @Integer >>= \case
93+ 1 -> pure ()
94+ n -> if even n
95+ then do put $ n `div` 2
96+ modify @Int (+1)
97+ collatz
98+ else do put $ 3*n + 1
99+ modify @Int (+1)
100+ collatz
101+{-# NOINLINE collatz #-}