git.iko.soy/effectful
on 1c9dced help sign in
effectful/tests/Main.hs
166 lines 4.7 kB history raw
1module Main (main) where
3import Control.Monad.IO.Class
4import Test.Tasty
5import Test.Tasty.HUnit
6import qualified Control.Monad.Catch as E
7import qualified Control.Exception.Lifted as LE
8import qualified UnliftIO.Exception as UE
10import Effectful.Async
11import Effectful.Interpreter
12import Effectful.State.Dynamic
13import Effectful.Monad
15main :: IO ()
16main = defaultMain $ testGroup "effectful"
17 [ testGroup "state"
18 [ testCase "runState & execState" test_runState
19 , testCase "evalState" test_evalState
20 , testCase "stateM" test_stateM
21 , testCase "deep stack" test_deepStack
22 , testCase "exceptions" test_exceptions
23 , testCase "concurrency" test_concurrentState
24 , testCase "local effects" test_localEffects
25 ]
26 ]
28test_runState :: Assertion
29test_runState = runIOE $ do
30 (end, len) <- runState (0::Int) . execState collatzStart $ collatz
31 assertEqual_ "correct end" 1 end
32 assertEqual_ "correct len" collatzLength len
34test_evalState :: Assertion
35test_evalState = runIOE $ do
36 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
37 assertEqual_ "correct len" collatzLength len
39test_stateM :: Assertion
40test_stateM = runIOE $ do
41 (a, b) <- runState "hi" . stateM $ \s -> pure (s, s ++ "!!!")
42 assertEqual_ "correct a" "hi" a
43 assertEqual_ "correct b" "hi!!!" b
45test_deepStack :: Assertion
46test_deepStack = runIOE $ do
47 n <- evalState () . execState (0::Int) $ do
48 evalState () . evalState () $ do
49 evalState () $ do
50 evalState () . evalState () . evalState () $ do
51 modify @Int (+1)
52 modify @Int (+2)
53 modify @Int (+4)
54 modify @Int (+8)
55 assertEqual_ "n" 15 n
57test_exceptions :: Assertion
58test_exceptions = runIOE $ do
59 testTry "exceptions" E.try
60 testCatch "exceptions" E.catch
61 testTry "lifted-base" LE.try
62 testCatch "lifted-base" LE.catch
63 testTry "unliftio" UE.try
64 testCatch "unliftio" UE.catch
65 where
66 testTry
67 :: String
68 -> (forall a es. IOE :> es => Eff es a -> Eff es (Either Ex a))
69 -> Eff '[IOE] ()
70 testTry lib tryImpl = do
71 e <- tryImpl $ runState (0::Int) action
72 assertEqual_ (lib ++ " - exception caught") e (Left Ex)
73 s <- execState (0::Int) $ tryImpl action
74 assertEqual_ (lib ++ " - state partially updated") s 1
76 testCatch
77 :: String
78 -> (forall a es. IOE :> es => Eff es a -> (Ex -> Eff es a) -> Eff es a)
79 -> Eff '[IOE] ()
80 testCatch lib catchImpl = do
81 s <- execState (0::Int) $ do
82 _ <- (evalState () action) `catchImpl` \Ex -> modify @Int (+4)
83 modify @Int (+8)
84 assertEqual_ (lib ++ " - state correctly updated") s 13
86 action :: State Int :> es => Eff es ()
87 action = do
88 modify @Int (+1)
89 _ <- E.throwM Ex
90 modify @Int (+2)
92test_concurrentState :: Assertion
93test_concurrentState = runIOE . evalState x $ do
94 runAsyncE . replicateConcurrently_ 2 $ do
95 r <- goDownward 0
96 assertEqual_ "x = n" x r
97 where
98 x :: Int
99 x = 1000000
101 goDownward :: State Int :> es => Int -> Eff es Int
102 goDownward acc = do
103 end <- state @Int $ \case
104 0 -> (True, 0)
105 n -> (False, n - 1)
106 if end
107 then pure acc
108 else goDownward $ acc + 1
110test_localEffects :: Assertion
111test_localEffects = runIOE $ do
112 x <- runHasInt 0 $ do
113 putInt 1
114 execState () $ do
115 putInt 2
116 execState () $ do
117 putInt 4
118 getInt
119 assertEqual_ "correct x" 4 x
121runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a
122runHasInt n =
123 -- reinterpret with redundant local effects
124 reinterpret (evalState () . evalState n . evalState True) $ \case
125 GetInt -> get
126 PutInt i -> put i
128data HasInt :: Effect where
129 GetInt :: HasInt m Int
130 PutInt :: Int -> HasInt m ()
132getInt :: HasInt :> es => Eff es Int
133getInt = send GetInt
135putInt :: HasInt :> es => Int -> Eff es ()
136putInt = send . PutInt
138----------------------------------------
139-- Helpers
141data Ex = Ex deriving (Eq, Show)
142instance E.Exception Ex
144assertEqual_ :: (Eq a, Show a, IOE :> es) => String -> a -> a -> Eff es ()
145assertEqual_ msg expected given = liftIO $ assertEqual msg expected given
147----------------------------------------
149collatzStart :: Integer
150collatzStart = 9780657630
152collatzLength :: Int
153collatzLength = 1132
155-- | Tests multiple 'State'S, 'put', 'get' and 'modify'.
156collatz :: (State Integer :> es, State Int :> es) => Eff es ()
157collatz = get @Integer >>= \case
158 1 -> pure ()
159 n -> if even n
160 then do put $ n `div` 2
161 modify @Int (+1)
162 collatz
163 else do put $ 3*n + 1
164 modify @Int (+1)
165 collatz
166{-# NOINLINE collatz #-}