@@ -20,14 +20,6 @@
21{-# OPTIONS_GHC -fno-warn-orphans #-}
21{-# OPTIONS_GHC -fno-warn-orphans #-}
23−-- Notice to those working on this test suite:
24−-- It doesn't appear to be possible to use --match to run a particular test, in
25−-- this situation the test may hang before reaching our code. This seems to
26−-- happen when the test is not the first test in the block. As a workaround, you
27−-- can just comment out the other tests. Also, using `xit` will cause the same
28−-- issue. `xit` tests must be the last tests in the session, or the session will
29−-- hang in the following test.
31import Prelude hiding (fail)
23import Prelude hiding (fail)
32import Control.Concurrent
24import Control.Concurrent
33import qualified Control.Concurrent.Async as Async
25import qualified Control.Concurrent.Async as Async
@@ -154,13 +146,13 @@ main = do
154 withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
146 withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
155 let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
147 let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
156 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
148 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
157− hspec (tests withDebugging wdConfig [(chromeCaps', "chrome")] selenium) `finally` _selenium_stopServer selenium
149+ hspec (tests withDebugging wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium
159−tests :: Bool -> WD.WDConfig -> [(Capabilities, String)] -> Selenium -> Spec
151+tests :: Bool -> WD.WDConfig -> [Capabilities] -> Selenium -> Spec
160tests withDebugging wdConfig caps _selenium = do
152tests withDebugging wdConfig caps _selenium = do
161 let putStrLnDebug :: MonadIO m => Text -> m ()
153 let putStrLnDebug :: MonadIO m => Text -> m ()
162 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
154 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
163− session' t = sessionWith wdConfig t . using caps
155+ session' = sessionWith wdConfig "" . using (map (,"") caps)
164 runWD m = runWDOptions (WdOptions False) $ do
156 runWD m = runWDOptions (WdOptions False) $ do
165 putStrLnDebug "before"
157 putStrLnDebug "before"
@@ -172,7 +164,7 @@ tests withDebugging wdConfig caps _selenium = do
172 testWidget = testWidgetDebug True withDebugging
164 testWidget = testWidgetDebug True withDebugging
173 testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
165 testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
174 testWidget' = testWidgetDebug' True withDebugging
166 testWidget' = testWidgetDebug' True withDebugging
175− session' "text" $ do
167+ describe "text" $ session' $ do
176 it "works" $ runWD $ do
168 it "works" $ runWD $ do
177 testWidgetStatic (checkBodyText "hello world") $ do
169 testWidgetStatic (checkBodyText "hello world") $ do
178 text "hello world"
170 text "hello world"
@@ -233,7 +225,7 @@ tests withDebugging wdConfig caps _selenium = do
233 click <- button ""
225 click <- button ""
234 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
226 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
236− session' "element" $ do
228+ describe "element" $ session' $ do
237 it "works with domEvent Click" $ runWD $ do
229 it "works with domEvent Click" $ runWD $ do
238 clickedRef <- liftIO $ newRef False
230 clickedRef <- liftIO $ newRef False
239 testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do
231 testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do
@@ -297,8 +289,8 @@ tests withDebugging wdConfig caps _selenium = do
297 let click = domEvent Click e
289 let click = domEvent Click e
298 return ()
290 return ()
300− session' "inputElement" $ do
292+ describe "inputElement" $ do
301− describe "static renderer" $ do
293+ describe "static renderer" $ session' $ do
302 it "sets value attribute" $ runWD $ do
294 it "sets value attribute" $ runWD $ do
303 let checkStatic = do
295 let checkStatic = do
304 e <- findElemWithRetry $ WD.ByTag "input"
296 e <- findElemWithRetry $ WD.ByTag "input"
@@ -355,7 +347,7 @@ tests withDebugging wdConfig caps _selenium = do
355 & inputElementConfig_initialChecked .~ False
347 & inputElementConfig_initialChecked .~ False
356 & inputElementConfig_setChecked .~ (True <$ pb)
348 & inputElementConfig_setChecked .~ (True <$ pb)
358− describe "hydration" $ do
350+ describe "hydration" $ session' $ do
359 it "doesn't wipe user input when switching over" $ runWD $ do
351 it "doesn't wipe user input when switching over" $ runWD $ do
360 inputRef <- newRef ("hello " :: Text)
352 inputRef <- newRef ("hello " :: Text)
361 testWidget'
353 testWidget'
@@ -593,7 +585,8 @@ tests withDebugging wdConfig caps _selenium = do
593 el "p" $ dynText $ _inputElement_value e
585 el "p" $ dynText $ _inputElement_value e
594 performEvent_ $ consRef valRef <$> updated (_inputElement_value e)
586 performEvent_ $ consRef valRef <$> updated (_inputElement_value e)
595 performEvent_ $ consRef inputRef <$> _inputElement_input e
587 performEvent_ $ consRef inputRef <$> _inputElement_input e
596− describe "hydration/immediate" $ do
589+ describe "hydration/immediate" $ session' $ do
597 it "captures user input after switchover" $ runWD $ do
590 it "captures user input after switchover" $ runWD $ do
598 inputRef :: IORef Text <- newRef ""
591 inputRef :: IORef Text <- newRef ""
599 let checkValue = do
592 let checkValue = do
@@ -673,8 +666,8 @@ tests withDebugging wdConfig caps _selenium = do
673 names <- liftJSM $ traverse File.getName fs
666 names <- liftJSM $ traverse File.getName fs
674 liftIO $ writeRef filesRef names
667 liftIO $ writeRef filesRef names
676− session' "textAreaElement" $ do
669+ describe "textAreaElement" $ do
677− describe "static renderer" $ do
670+ describe "static renderer" $ session' $ do
678 it "sets value attribute" $ runWD $ do
671 it "sets value attribute" $ runWD $ do
679 let checkStatic = do
672 let checkStatic = do
680 e <- findElemWithRetry $ WD.ByTag "textarea"
673 e <- findElemWithRetry $ WD.ByTag "textarea"
@@ -697,7 +690,7 @@ tests withDebugging wdConfig caps _selenium = do
697 & textAreaElementConfig_initialValue .~ "test"
690 & textAreaElementConfig_initialValue .~ "test"
698 & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)
691 & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)
700− describe "hydration" $ do
693+ describe "hydration" $ session' $ do
701 it "doesn't wipe user input when switching over" $ runWD $ do
694 it "doesn't wipe user input when switching over" $ runWD $ do
702 inputRef <- newRef ("" :: Text)
695 inputRef <- newRef ("" :: Text)
703 testWidget'
696 testWidget'
@@ -846,7 +839,7 @@ tests withDebugging wdConfig caps _selenium = do
846 e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
839 e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
847 el "p" $ dynText $ _textAreaElement_value e
840 el "p" $ dynText $ _textAreaElement_value e
849− describe "hydration/immediate" $ do
842+ describe "hydration/immediate" $ session' $ do
850 it "captures user input after switchover" $ runWD $ do
843 it "captures user input after switchover" $ runWD $ do
851 inputRef :: IORef Text <- newRef ""
844 inputRef :: IORef Text <- newRef ""
852 let checkValue = do
845 let checkValue = do
@@ -888,13 +881,13 @@ tests withDebugging wdConfig caps _selenium = do
888 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
881 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
889 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
882 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
891− session' "selectElement" $ do
884+ describe "selectElement" $ do
892 let options :: DomBuilder t m => m ()
885 let options :: DomBuilder t m => m ()
893 options = do
886 options = do
894 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
887 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
895 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
888 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
896 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
889 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
897− describe "hydration" $ do
890+ describe "hydration" $ session' $ do
898 it "sets initial value correctly" $ runWD $ do
891 it "sets initial value correctly" $ runWD $ do
899 inputRef <- newRef ("" :: Text)
892 inputRef <- newRef ("" :: Text)
900 let setup = do
893 let setup = do
@@ -968,7 +961,7 @@ tests withDebugging wdConfig caps _selenium = do
968 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
961 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
969 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
962 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
971− describe "hydration/immediate" $ do
964+ describe "hydration/immediate" $ session' $ do
972 it "captures user input after switchover" $ runWD $ do
965 it "captures user input after switchover" $ runWD $ do
973 inputRef :: IORef Text <- newRef ""
966 inputRef :: IORef Text <- newRef ""
974 let checkValue = do
967 let checkValue = do
@@ -1014,7 +1007,7 @@ tests withDebugging wdConfig caps _selenium = do
1014 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
1007 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
1015 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
1008 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
1017− session' "prerender" $ do
1010+ describe "prerender" $ session' $ do
1018 it "works in simple case" $ runWD $ do
1011 it "works in simple case" $ runWD $ do
1019 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
1012 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
1020 prerender_ (text "One") (text "Two")
1013 prerender_ (text "One") (text "Two")
@@ -1083,7 +1076,7 @@ tests withDebugging wdConfig caps _selenium = do
1083 prerender_ (pure ()) (liftIO $ trigger "Client")
1076 prerender_ (pure ()) (liftIO $ trigger "Client")
1084 textNode $ TextNodeConfig "Initial" $ Just e
1077 textNode $ TextNodeConfig "Initial" $ Just e
1086− session' "namespaces" $ do
1079+ describe "namespaces" $ session' $ do
1087 it "dyn can be nested in namespaced widget" $ runWD $ do
1080 it "dyn can be nested in namespaced widget" $ runWD $ do
1088 testWidget (pure ()) (checkTextInTag "svg" "one") $ do
1081 testWidget (pure ()) (checkTextInTag "svg" "one") $ do
1089 let svgRootCfg = def
1082 let svgRootCfg = def
@@ -1092,7 +1085,7 @@ tests withDebugging wdConfig caps _selenium = do
1092 void $ element "svg" svgRootCfg $ do
1085 void $ element "svg" svgRootCfg $ do
1093 dyn_ $ text "one" <$ pure ()
1086 dyn_ $ text "one" <$ pure ()
1095− session' "runWithReplace" $ do
1088+ describe "runWithReplace" $ session' $ do
1096 it "works" $ runWD $ do
1089 it "works" $ runWD $ do
1097 replaceChan :: Chan Text <- liftIO newChan
1090 replaceChan :: Chan Text <- liftIO newChan
1098 let setup = findElemWithRetry $ WD.ByTag "div"
1091 let setup = findElemWithRetry $ WD.ByTag "div"
@@ -1290,7 +1283,7 @@ tests withDebugging wdConfig caps _selenium = do
1290 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
1283 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
1291 text "|after"
1284 text "|after"
1293− session' "traverseDMapWithKeyWithAdjust" $ do
1286+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do
1294 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
1287 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
1295 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
1288 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
1296 elClass "span" "key" $ text $ textKey k
1289 elClass "span" "key" $ text $ textKey k
@@ -1393,7 +1386,7 @@ tests withDebugging wdConfig caps _selenium = do
1393 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1386 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1394 liftIO $ dmap `H.shouldBe` keyMap
1387 liftIO $ dmap `H.shouldBe` keyMap
1396− session' "traverseIntMapWithKeyWithAdjust" $ do
1389+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do
1397 let textKeyInt k = "key" <> T.pack (show k)
1390 let textKeyInt k = "key" <> T.pack (show k)
1398 intMap = IntMap.fromList
1391 intMap = IntMap.fromList
1399 [ (1, "one")
1392 [ (1, "one")
@@ -1500,7 +1493,7 @@ tests withDebugging wdConfig caps _selenium = do
1500 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1493 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1501 liftIO $ dmap `H.shouldBe` intMap
1494 liftIO $ dmap `H.shouldBe` intMap
1503− session' "traverseDMapWithKeyWithAdjustWithMove" $ do
1496+ describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do
1504 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
1497 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
1505 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do
1498 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do
1506 elClass "span" "key" $ text $ textKey2 k
1499 elClass "span" "key" $ text $ textKey2 k
@@ -1580,8 +1573,8 @@ tests withDebugging wdConfig caps _selenium = do
1580 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
1573 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
1581 liftIO $ assertEqual "DMap" initMap dmap
1574 liftIO $ assertEqual "DMap" initMap dmap
1583− session' "hydrating invalid HTML" $ do
1576+ describe "hydrating invalid HTML" $ session' $ do
1584− xit "can hydrate list in paragraph" $ runWD $ do
1577+ it "can hydrate list in paragraph" $ runWD $ do
1585 let preSwitchover = do
1578 let preSwitchover = do
1586 checkBodyText "before\ninner\nafter"
1579 checkBodyText "before\ninner\nafter"
1587 -- Two <p> tags should be present
1580 -- Two <p> tags should be present
@@ -1610,7 +1603,7 @@ tests withDebugging wdConfig caps _selenium = do
1610 -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.
1603 -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.
1611 -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.
1604 -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.
1612 -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.
1605 -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.
1613− session' "dropdown" $ do
1606+ describe "dropdown" $ session' $ do
1614 let doTest expectedOpts (initialValue :: Text) = do
1607 let doTest expectedOpts (initialValue :: Text) = do
1615 let doCheck = do
1608 let doCheck = do
1616 es <- findElemsWithRetry $ WD.ByTag "option"
1609 es <- findElemsWithRetry $ WD.ByTag "option"