git.iko.soy/reflex
on develop help sign in
Move testsuite to HSpec
4c38730leon.smith@obsidian.systems
reflex.cabal+1
compare with develop
unifiedsplit
@@ -277,6 +277,7 @@ test-suite DebugCycles
277 , deepseq
277 , deepseq
278 , dependent-map
278 , dependent-map
279 , dependent-sum
279 , dependent-sum
280+ , hspec
280 , lens
281 , lens
281 , mtl
282 , mtl
282 , these
283 , these
test/DebugCycles.hs+44−51
@@ -27,6 +27,7 @@ import Data.Align
27import Reflex
27import Reflex
28import Reflex.EventWriter.Base
28import Reflex.EventWriter.Base
29import Test.Run
29import Test.Run
30+import Test.Hspec
30import Reflex.Spider.Internal (EventLoopException)
31import Reflex.Spider.Internal (EventLoopException)
31import Data.Witherable (Filterable)
32import Data.Witherable (Filterable)
32
33
@@ -36,7 +37,7 @@ import Data.These.Lens
36
37
37type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
38type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
38
39
39−connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
40+connectDyn :: Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
40connectDyn e (d, d') = do
41connectDyn e (d, d') = do
41 dd <- holdDyn d (d' <$ e)
42 dd <- holdDyn d (d' <$ e)
42 return $ join dd
43 return $ join dd
@@ -85,8 +86,8 @@ connectButton click e = do
85 d <- hold never (e <$ click)
86 d <- hold never (e <$ click)
86 return (switch d)
87 return (switch d)
87
88
88−switchLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
89+switchLoop01 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
89−switchLoop (e1, e2) = do
90+switchLoop01 (e1, e2) = do
90 rec
91 rec
91 e' <- connectButton e2 (updated d)
92 e' <- connectButton e2 (updated d)
92 d <- count (align e' e1)
93 d <- count (align e' e1)
@@ -103,76 +104,68 @@ mergeLoop (e1, e2) = do
103 c <- count e1
104 c <- count e1
104 tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
105 tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
105
106
106−switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
107+switchLoop02 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
107−switchLoop' (e1, e2) = do
108+switchLoop02 (e1, e2) = do
108 rec
109 rec
109 e' <- connectButton e2 (updated d)
110 e' <- connectButton e2 (updated d)
110 d <- count (leftmost [e', e1])
111 d <- count (leftmost [e', e1])
111 return $ updated d
112 return $ updated d
112
113
113−switchLoop2 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
114+switchLoop03 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
114−switchLoop2 (e1, e2) = do
115+switchLoop03 (e1, e2) = do
115 rec
116 rec
116 e' <- connectButton e2 (addHeight $ updated d)
117 e' <- connectButton e2 (addHeight $ updated d)
117 d <- count (align e' e1)
118 d <- count (align e' e1)
118 return $ updated d
119 return $ updated d
119
120
120−staticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
121+staticLoop01 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
121−staticLoop (e1, e2) = do
122+staticLoop01 (e1, e2) = do
122 rec
123 rec
123 d <- foldDyn (+) (0 :: Int) (1 <$ align e1 (updated d))
124 d <- foldDyn (+) (0 :: Int) (1 <$ align e1 (updated d))
124 return $ updated d
125 return $ updated d
125
126
126−staticLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
127+staticLoop02 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
127−staticLoop' (e1, e2) = do
128+staticLoop02 (e1, e2) = do
128 rec
129 rec
129 d <- foldDyn (+) (0 :: Int) (leftmost [e1, updated d])
130 d <- foldDyn (+) (0 :: Int) (leftmost [e1, updated d])
130 return $ updated d
131 return $ updated d
131
132
132buildStaticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
133buildStaticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
133buildStaticLoop (e1, e2) = switchHold never buildLoop
134buildStaticLoop (e1, e2) = switchHold never buildLoop
134− where buildLoop = pushAlways (const $ staticLoop (e1, e2)) e2
135+ where buildLoop = pushAlways (const $ staticLoop01 (e1, e2)) e2
135
136
136splitThese :: Filterable f => f (These a b) -> (f a, f b)
137splitThese :: Filterable f => f (These a b) -> (f a, f b)
137splitThese f = (mapMaybe (preview here) f, mapMaybe (preview there) f)
138splitThese f = (mapMaybe (preview here) f, mapMaybe (preview there) f)
138
139
139−pattern RunTestCaseFlag = "--run-test"
140−
141−runTest :: (String, TestCase) -> IO ()
142−runTest (name, TestCase test) = do
143− putStrLn ("Test: " <> name)
144− mError <- timeout (milliseconds 5) $
145− run `catch` \(e :: EventLoopException) -> pure (show e)
146− case mError of
147− Just err -> putStrLn err
148− Nothing -> error "timed out (loop not detected)"
149− where
150− run = do
151− r <- runApp' (test . splitThese) (Just <$> occs)
152− error (name <> ": unexpected success " <> show r)
153− occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
154− milliseconds = (*1000)
155−
156−newtype TestCase = TestCase { unTest :: forall t m. (Widget t m, Adjustable t m) => (Event t Int, Event t ()) -> m (Event t Int) }
157−
158−tests :: [(String, TestCase)]
159−tests =
160− [ ("switchLoop'", TestCase switchLoop')
161− , ("switchLoop", TestCase switchLoop)
162− , ("mergeLoop", TestCase mergeLoop)
163−
164−
165− -- , ("switchLoop2", TestCase switchLoop2)
166−
167− -- , ("staticLoop'", TestCase staticLoop')
168− -- , ("staticLoop", TestCase staticLoop)
169− -- ("buildStaticLoop", TestCase buildStaticLoop)
170− -- , ("buildSwitchLoop", TestCase $ buildLoop switchLoop)
171−
172− -- ("coincidenceLoop", TestCase coincidenceLoop)
173− -- , ("dynLoop", TestCase dynLoop)
174− -- , ("buildCoincidenceLoop", TestCase $ buildLoop coincidenceLoop)
175− ]
176−
177main :: IO ()
140main :: IO ()
178−main = traverse_ runTest tests
141+main = hspec $ do
142+ describe "DebugCycles" $ do
143+ it "throws EventLoopException on switchLoop01" $ do
144+ check switchLoop01
145+ it "throws EventLoopException on switchLoop02" $ do
146+ check switchLoop02
147+ it "throws EventLoopException on switchLoop03" $ do
148+ check switchLoop03
149+ it "throws EventLoopException on buildSwitchLoop" $ do
150+ check $ buildLoop switchLoop01
151+ xit "throws EventLoopException on mergeLoop" $ do
152+ check mergeLoop
153+ xit "throws EventLoopException on staticLoop01" $ do
154+ check staticLoop01
155+ xit "throws EventLoopException on staticLoop02" $ do
156+ check staticLoop02
157+ xit "throws EventLoopException on buildStaticLoop" $ do
158+ check buildStaticLoop
159+ xit "throws EventLoopException on coincidenceLoop" $ do
160+ check coincidenceLoop
161+ xit "throws EventLoopException on dynLoop" $ do
162+ check dynLoop
163+ xit "throws EventLoopException on buildCoincidenceLoop" $ do
164+ check $ buildLoop coincidenceLoop
165+ where
166+ milliseconds = (*1000)
167+ occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
168+ check test = do
169+ let action = timeout (milliseconds 50) $ do
170+ runApp' (test . splitThese) (Just <$> occs)
171+ action `shouldThrow` (const True :: Selector EventLoopException)