git.iko.soy/effectful
on 209f615 help sign in
effectful/tests/Main.hs
167 lines 4.7 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.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 = runEffIO $ 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 = runEffIO $ do
36 len <- evalState (0::Int) . evalState collatzStart $ collatz *> get @Int
37 assertEqual_ "correct len" collatzLength len
39test_stateM :: Assertion
40test_stateM = runEffIO $ 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 = runEffIO $ 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 = runEffIO $ 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 = runEffIO . runHasInt x $ do
94 replicateConcurrently_ 2 $ do
95 r <- goDownward 0
96 assertEqual_ "x = n" x r
97 where
98 x :: Int
99 x = 1000000
101 goDownward :: HasInt :> es => Int -> Eff es Int
102 goDownward acc = getInt >>= \case
103 0 -> pure acc
104 n -> do
105 putInt $ n - 1
106 goDownward $ acc + 1
108test_localEffects :: Assertion
109test_localEffects = runEffIO $ do
110 x <- runHasInt 0 $ do
111 putInt 1
112 execState () $ do
113 putInt 2
114 execState () $ do
115 putInt 4
116 getInt
117 assertEqual_ "correct x" 4 x
119runHasInt :: Int -> Eff (HasInt : es) a -> Eff es a
120runHasInt n =
121 -- reinterpret with redundant local effects
122 reinterpret (evalState () . evalState n . evalState True) $ \case
123 GetInt -> get
124 PutInt i -> put i
126data HasInt :: Effect where
127 GetInt :: HasInt m Int
128 PutInt :: Int -> HasInt m ()
130getInt :: HasInt :> es => Eff es Int
131getInt = send GetInt
133putInt :: HasInt :> es => Int -> Eff es ()
134putInt = send . PutInt
136----------------------------------------
137-- Helpers
139data Ex = Ex deriving (Eq, Show)
140instance E.Exception Ex
142runEffIO :: Eff '[IOE] a -> IO a
143runEffIO = runEff . runIOE
145assertEqual_ :: (Eq a, Show a, IOE :> es) => String -> a -> a -> Eff es ()
146assertEqual_ msg expected given = liftIO $ assertEqual msg expected given
148----------------------------------------
150collatzStart :: Integer
151collatzStart = 9780657630
153collatzLength :: Int
154collatzLength = 1132
156-- | Tests multiple 'State'S, 'put', 'get' and 'modify'.
157collatz :: (State Integer :> es, State Int :> es) => Eff es ()
158collatz = get @Integer >>= \case
159 1 -> pure ()
160 n -> if even n
161 then do put $ n `div` 2
162 modify @Int (+1)
163 collatz
164 else do put $ 3*n + 1
165 modify @Int (+1)
166 collatz
167{-# NOINLINE collatz #-}