@@ -20,14 +20,6 @@
2020
2121{-# OPTIONS_GHC -fno-warn-orphans #-}
2222
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.
30−
3123import Prelude hiding (fail)
3224import Control.Concurrent
3325import qualified Control.Concurrent.Async as Async
@@ -145,7 +137,7 @@ deriving instance MonadFail WD
145137
146138main :: IO ()
147139main = do
148− unshareNetwork
140+ unshareNetork
149141 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"
150142 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
151143 withSeleniumServer $ \selenium -> do
@@ -154,13 +146,13 @@ main = do
154146 withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
155147 let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
156148 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
158150
159−tests :: Bool -> WD.WDConfig -> [(Capabilities, String)] -> Selenium -> Spec
151+tests :: Bool -> WD.WDConfig -> [Capabilities] -> Selenium -> Spec
160152tests withDebugging wdConfig caps _selenium = do
161153 let putStrLnDebug :: MonadIO m => Text -> m ()
162154 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
163− session' t = sessionWith wdConfig t . using caps
155+ session' = sessionWith wdConfig "" . using (map (,"") caps)
164156 runWD m = runWDOptions (WdOptions False) $ do
165157 putStrLnDebug "before"
166158 r <- m
@@ -172,7 +164,7 @@ tests withDebugging wdConfig caps _selenium = do
172164 testWidget = testWidgetDebug True withDebugging
173165 testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
174166 testWidget' = testWidgetDebug' True withDebugging
175− session' "text" $ do
167+ describe "text" $ session' $ do
176168 it "works" $ runWD $ do
177169 testWidgetStatic (checkBodyText "hello world") $ do
178170 text "hello world"
@@ -233,7 +225,7 @@ tests withDebugging wdConfig caps _selenium = do
233225 click <- button ""
234226 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
235227
236− session' "element" $ do
228+ describe "element" $ session' $ do
237229 it "works with domEvent Click" $ runWD $ do
238230 clickedRef <- liftIO $ newRef False
239231 testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do
@@ -297,8 +289,8 @@ tests withDebugging wdConfig caps _selenium = do
297289 let click = domEvent Click e
298290 return ()
299291
300− session' "inputElement" $ do
301− describe "static renderer" $ do
292+ describe "inputElement" $ do
293+ describe "static renderer" $ session' $ do
302294 it "sets value attribute" $ runWD $ do
303295 let checkStatic = do
304296 e <- findElemWithRetry $ WD.ByTag "input"
@@ -355,7 +347,7 @@ tests withDebugging wdConfig caps _selenium = do
355347 & inputElementConfig_initialChecked .~ False
356348 & inputElementConfig_setChecked .~ (True <$ pb)
357349 pure ()
358− describe "hydration" $ do
350+ describe "hydration" $ session' $ do
359351 it "doesn't wipe user input when switching over" $ runWD $ do
360352 inputRef <- newRef ("hello " :: Text)
361353 testWidget'
@@ -593,7 +585,8 @@ tests withDebugging wdConfig caps _selenium = do
593585 el "p" $ dynText $ _inputElement_value e
594586 performEvent_ $ consRef valRef <$> updated (_inputElement_value e)
595587 performEvent_ $ consRef inputRef <$> _inputElement_input e
596− describe "hydration/immediate" $ do
588+
589+ describe "hydration/immediate" $ session' $ do
597590 it "captures user input after switchover" $ runWD $ do
598591 inputRef :: IORef Text <- newRef ""
599592 let checkValue = do
@@ -673,8 +666,8 @@ tests withDebugging wdConfig caps _selenium = do
673666 names <- liftJSM $ traverse File.getName fs
674667 liftIO $ writeRef filesRef names
675668
676− session' "textAreaElement" $ do
677− describe "static renderer" $ do
669+ describe "textAreaElement" $ do
670+ describe "static renderer" $ session' $ do
678671 it "sets value attribute" $ runWD $ do
679672 let checkStatic = do
680673 e <- findElemWithRetry $ WD.ByTag "textarea"
@@ -697,7 +690,7 @@ tests withDebugging wdConfig caps _selenium = do
697690 & textAreaElementConfig_initialValue .~ "test"
698691 & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)
699692 pure ()
700− describe "hydration" $ do
693+ describe "hydration" $ session' $ do
701694 it "doesn't wipe user input when switching over" $ runWD $ do
702695 inputRef <- newRef ("" :: Text)
703696 testWidget'
@@ -846,7 +839,7 @@ tests withDebugging wdConfig caps _selenium = do
846839 e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
847840 el "p" $ dynText $ _textAreaElement_value e
848841
849− describe "hydration/immediate" $ do
842+ describe "hydration/immediate" $ session' $ do
850843 it "captures user input after switchover" $ runWD $ do
851844 inputRef :: IORef Text <- newRef ""
852845 let checkValue = do
@@ -888,13 +881,13 @@ tests withDebugging wdConfig caps _selenium = do
888881 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
889882 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
890883
891− session' "selectElement" $ do
884+ describe "selectElement" $ do
892885 let options :: DomBuilder t m => m ()
893886 options = do
894887 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
895888 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
896889 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
897− describe "hydration" $ do
890+ describe "hydration" $ session' $ do
898891 it "sets initial value correctly" $ runWD $ do
899892 inputRef <- newRef ("" :: Text)
900893 let setup = do
@@ -968,7 +961,7 @@ tests withDebugging wdConfig caps _selenium = do
968961 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
969962 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
970963
971− describe "hydration/immediate" $ do
964+ describe "hydration/immediate" $ session' $ do
972965 it "captures user input after switchover" $ runWD $ do
973966 inputRef :: IORef Text <- newRef ""
974967 let checkValue = do
@@ -1014,7 +1007,7 @@ tests withDebugging wdConfig caps _selenium = do
10141007 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
10151008 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
10161009
1017− session' "prerender" $ do
1010+ describe "prerender" $ session' $ do
10181011 it "works in simple case" $ runWD $ do
10191012 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
10201013 prerender_ (text "One") (text "Two")
@@ -1083,7 +1076,7 @@ tests withDebugging wdConfig caps _selenium = do
10831076 prerender_ (pure ()) (liftIO $ trigger "Client")
10841077 textNode $ TextNodeConfig "Initial" $ Just e
10851078
1086− session' "namespaces" $ do
1079+ describe "namespaces" $ session' $ do
10871080 it "dyn can be nested in namespaced widget" $ runWD $ do
10881081 testWidget (pure ()) (checkTextInTag "svg" "one") $ do
10891082 let svgRootCfg = def
@@ -1092,7 +1085,7 @@ tests withDebugging wdConfig caps _selenium = do
10921085 void $ element "svg" svgRootCfg $ do
10931086 dyn_ $ text "one" <$ pure ()
10941087
1095− session' "runWithReplace" $ do
1088+ describe "runWithReplace" $ session' $ do
10961089 it "works" $ runWD $ do
10971090 replaceChan :: Chan Text <- liftIO newChan
10981091 let setup = findElemWithRetry $ WD.ByTag "div"
@@ -1290,7 +1283,7 @@ tests withDebugging wdConfig caps _selenium = do
12901283 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
12911284 text "|after"
12921285
1293− session' "traverseDMapWithKeyWithAdjust" $ do
1286+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do
12941287 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
12951288 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
12961289 elClass "span" "key" $ text $ textKey k
@@ -1393,7 +1386,7 @@ tests withDebugging wdConfig caps _selenium = do
13931386 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
13941387 liftIO $ dmap `H.shouldBe` keyMap
13951388
1396− session' "traverseIntMapWithKeyWithAdjust" $ do
1389+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do
13971390 let textKeyInt k = "key" <> T.pack (show k)
13981391 intMap = IntMap.fromList
13991392 [ (1, "one")
@@ -1500,7 +1493,7 @@ tests withDebugging wdConfig caps _selenium = do
15001493 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
15011494 liftIO $ dmap `H.shouldBe` intMap
15021495
1503− session' "traverseDMapWithKeyWithAdjustWithMove" $ do
1496+ describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do
15041497 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
15051498 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do
15061499 elClass "span" "key" $ text $ textKey2 k
@@ -1580,8 +1573,8 @@ tests withDebugging wdConfig caps _selenium = do
15801573 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
15811574 liftIO $ assertEqual "DMap" initMap dmap
15821575
1583− session' "hydrating invalid HTML" $ do
1584− xit "can hydrate list in paragraph" $ runWD $ do
1576+ describe "hydrating invalid HTML" $ session' $ do
1577+ it "can hydrate list in paragraph" $ runWD $ do
15851578 let preSwitchover = do
15861579 checkBodyText "before\ninner\nafter"
15871580 -- Two <p> tags should be present
@@ -1610,7 +1603,7 @@ tests withDebugging wdConfig caps _selenium = do
16101603 -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.
16111604 -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.
16121605 -- 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
16141607 let doTest expectedOpts (initialValue :: Text) = do
16151608 let doCheck = do
16161609 es <- findElemsWithRetry $ WD.ByTag "option"
@@ -1767,7 +1760,7 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =
17671760 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp
17681761 putStrLnDebug "rendered static"
17691762 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
1770− onFailure <- if hardFailure then (`throwTo` HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()
1763+ onFailure <- if hardFailure then (\tid -> throwTo tid HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()
17711764 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
17721765 let entryPoint = do
17731766 putStrLnDebug "taking waitBeforeJS"
@@ -1779,7 +1772,7 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =
17791772 liftIO $ putMVar waitUntilSwitchover ()
17801773 putStrLnDebug "put waitUntilSwitchover"
17811774 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"
1782− mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchOverAction blank bodyWidget
1775+ mainHydrationWidgetWithSwitchoverAction onFailure switchOverAction blank bodyWidget
17831776 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"
17841777 syncPoint
17851778 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do