@@ -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
@@ -145,7 +137,7 @@ deriving instance MonadFail WD
146main :: IO ()
138main :: IO ()
148− unshareNetwork
140+ unshareNetork
149 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"
141 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"
150 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
142 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
151 withSeleniumServer $ \selenium -> do
143 withSeleniumServer $ \selenium -> do
@@ -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"
@@ -169,10 +161,10 @@ tests withDebugging wdConfig caps _selenium = do
169 testWidgetStatic :: WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
161 testWidgetStatic :: WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
170 testWidgetStatic = testWidgetStaticDebug withDebugging
162 testWidgetStatic = testWidgetStaticDebug withDebugging
171 testWidget :: WD () -> WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
163 testWidget :: WD () -> WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b
172− testWidget = testWidgetDebug True withDebugging
164+ testWidget = testWidgetDebug 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' 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"
@@ -321,54 +313,20 @@ tests withDebugging wdConfig caps _selenium = do
321 & inputElementConfig_initialValue .~ "test"
313 & inputElementConfig_initialValue .~ "test"
322 & inputElementConfig_setValue .~ ("test-updated" <$ pb)
314 & inputElementConfig_setValue .~ ("test-updated" <$ pb)
324− it "sets checked attr appropriately" $ runWD $ do
325− setCheckedChan <- liftIO newChan
326− let checkStatic = do
327− e <- findElemWithRetry $ WD.ByTag "input"
328− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
331− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
333− WD.click e -- Click to uncheck
334− WD.attr e "checked" `shouldBeWithRetryM` Nothing
335− liftIO $ writeChan setCheckedChan True -- Programatically check the checkbox
336− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
337− testWidget' checkStatic checkValue $ do
338− setChecked <- triggerEventWithChan setCheckedChan
339− _ <- inputElement $ def
340− & initialAttributes .~ "type" =: "checkbox"
341− & inputElementConfig_initialChecked .~ True
342− & inputElementConfig_setChecked .~ setChecked
344− it "sets checked attr appropriately at postbuild" $ runWD $ do
345− let checkStatic = do
346− e <- findElemWithRetry $ WD.ByTag "input"
347− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
350− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
351− testWidget' checkStatic checkValue $ do
353− _ <- inputElement $ def
354− & initialAttributes .~ "type" =: "checkbox"
355− & inputElementConfig_initialChecked .~ False
356− & inputElementConfig_setChecked .~ (True <$ pb)
358− describe "hydration" $ do
316+ describe "hydration" $ session' $ do
359 it "doesn't wipe user input when switching over" $ runWD $ do
317 it "doesn't wipe user input when switching over" $ runWD $ do
360− inputRef <- newRef ("hello " :: Text)
318+ inputRef <- newRef ("" :: Text)
361 testWidget'
319 testWidget'
363 e <- findElemWithRetry $ WD.ByTag "input"
321 e <- findElemWithRetry $ WD.ByTag "input"
364− WD.sendKeys "world" e
322+ WD.sendKeys "hello world" e
366 (\e -> do
324 (\e -> do
367 WD.attr e "value" `shouldBeWithRetryM` Just "hello world"
325 WD.attr e "value" `shouldBeWithRetryM` Just "hello world"
368 WD.click =<< findElemWithRetry (WD.ByTag "button")
326 WD.click =<< findElemWithRetry (WD.ByTag "button")
369 readRef inputRef `shouldBeWithRetryM` "hello world"
327 readRef inputRef `shouldBeWithRetryM` "hello world"
371− e <- inputElement $ def & inputElementConfig_initialValue .~ "hello "
329+ e <- inputElement def
372 click <- button "save"
330 click <- button "save"
373 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
331 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
374 it "captures user input after switchover" $ runWD $ do
332 it "captures user input after switchover" $ runWD $ do
@@ -425,49 +383,24 @@ tests withDebugging wdConfig caps _selenium = do
425 checkedByUIRef <- newRef False
383 checkedByUIRef <- newRef False
426 checkedRef <- newRef False
384 checkedRef <- newRef False
427 setCheckedChan <- liftIO newChan
385 setCheckedChan <- liftIO newChan
428− let checkStatic = do
429− e <- findElemWithRetry $ WD.ByTag "input"
430− WD.attr e "checked" `shouldBeWithRetryM` Nothing
432− checkValue e = do
386+ let checkValue = do
433 readRef checkedByUIRef `shouldBeWithRetryM` False
387 readRef checkedByUIRef `shouldBeWithRetryM` False
434 readRef checkedRef `shouldBeWithRetryM` False
388 readRef checkedRef `shouldBeWithRetryM` False
435− WD.attr e "checked" `shouldBeWithRetryM` Nothing
389+ e <- findElemWithRetry $ WD.ByTag "input"
436 WD.moveToCenter e
390 WD.moveToCenter e
437 WD.click e
391 WD.click e
438 readRef checkedByUIRef `shouldBeWithRetryM` True
392 readRef checkedByUIRef `shouldBeWithRetryM` True
439 readRef checkedRef `shouldBeWithRetryM` True
393 readRef checkedRef `shouldBeWithRetryM` True
440− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
441 liftIO $ writeChan setCheckedChan False
394 liftIO $ writeChan setCheckedChan False
442 readRef checkedByUIRef `shouldBeWithRetryM` True
395 readRef checkedByUIRef `shouldBeWithRetryM` True
443 readRef checkedRef `shouldBeWithRetryM` False
396 readRef checkedRef `shouldBeWithRetryM` False
444− WD.attr e "checked" `shouldBeWithRetryM` Nothing
445− testWidget' checkStatic checkValue $ do
397+ testWidget (pure ()) checkValue $ do
446 setChecked <- triggerEventWithChan setCheckedChan
398 setChecked <- triggerEventWithChan setCheckedChan
447 e <- inputElement $ def
399 e <- inputElement $ def
448 & initialAttributes .~ "type" =: "checkbox"
400 & initialAttributes .~ "type" =: "checkbox"
449 & inputElementConfig_setChecked .~ setChecked
401 & inputElementConfig_setChecked .~ setChecked
450 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
402 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
451 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
403 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
452− it "respects user updates to checked which happen before hydration" $ runWD $ do
453− checkedByUIRef <- newRef False
454− checkedRef <- newRef False
455− let checkStatic = do
456− e <- findElemWithRetry $ WD.ByTag "input"
457− WD.attr e "checked" `shouldBeWithRetryM` Nothing
460− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
463− WD.attr e "checked" `shouldBeWithRetryM` Just "true"
464− readRef checkedByUIRef `shouldBeWithRetryM` True
465− readRef checkedRef `shouldBeWithRetryM` True
466− testWidget' checkStatic checkValue $ do
467− e <- inputElement $ def
468− & initialAttributes .~ "type" =: "checkbox"
469− performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
470− performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
471 it "captures file uploads" $ runWD $ do
404 it "captures file uploads" $ runWD $ do
472 filesRef :: IORef [Text] <- newRef []
405 filesRef :: IORef [Text] <- newRef []
473 let uploadFile = do
406 let uploadFile = do
@@ -483,117 +416,8 @@ tests withDebugging wdConfig caps _selenium = do
483 prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
416 prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
484 names <- liftJSM $ traverse File.getName fs
417 names <- liftJSM $ traverse File.getName fs
485 liftIO $ writeRef filesRef names
418 liftIO $ writeRef filesRef names
486− it "fires _input event if the user altered the value before hydration" $ runWD $ do
419+
487− input <- newRef ("" :: Text)
488− update <- newRef ("" :: Text)
489− let checkStatic = do
490− e <- findElemWithRetry $ WD.ByTag "input"
491− WD.attr e "value" `shouldBeWithRetryM` Just ""
492− WD.sendKeys "test" e
493− WD.attr e "value" `shouldBeWithRetryM` Just "test"
495− checkHydrated e = do
496− WD.attr e "value" `shouldBeWithRetryM` Just "test"
497− readRef input `shouldBeWithRetryM` "test"
498− readRef update `shouldBeWithRetryM` "test"
499− testWidget' checkStatic checkHydrated $ do
500− e <- inputElement def
501− performEvent_ $ liftIO . writeRef input <$> _inputElement_input e
502− performEvent_ $ liftIO . writeRef update <$> updated (_inputElement_value e)
503− it "does not fire _input event when the value is updated at postBuild" $ runWD $ do
504− input <- newRef (Nothing :: Maybe Text)
505− let checkStatic = do
506− e <- findElemWithRetry $ WD.ByTag "input"
507− WD.attr e "value" `shouldBeWithRetryM` Just "pb"
509− checkHydrated e = do
510− WD.attr e "value" `shouldBeWithRetryM` Just "pb"
511− readRef input `shouldBeWithRetryM` Nothing
512− testWidget' checkStatic checkHydrated $ do
514− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
515− performEvent_ $ liftIO . writeRef input . Just <$> _inputElement_input e
516− it "SSR produces correct DOM based on inputElement values when setValue happens at postBuild" $ runWD $ do
518− input <- findElemWithRetry $ WD.ByTag "input"
519− WD.attr input "value" `shouldBeWithRetryM` Just "pb"
520− p <- findElemWithRetry (WD.ByTag "p")
521− shouldContainText "pb" p
522− testWidget checkBoth checkBoth $ do
524− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
525− el "p" $ dynText $ _inputElement_value e
526− it "does not fail when both setValue AND user updated value happen before switchover" $ runWD $ do
527− let checkStatic = do
528− input <- findElemWithRetry $ WD.ByTag "input"
529− h2_value <- findElemWithRetry (WD.ByTag "h2")
530− h3_input <- findElemWithRetry (WD.ByTag "h3")
531− WD.attr input "value" `shouldBeWithRetryM` Just "pb"
532− shouldContainText "pb" h2_value
533− shouldContainText "" h3_input
534− WD.sendKeys "abc" input
535− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
536− shouldContainText "pb" h2_value
537− shouldContainText "" h3_input
538− pure (input, h2_value, h3_input)
539− checkHydrated (input, h2_value, h3_input) = do
540− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
541− shouldContainText "pbabc" h3_input
542− shouldContainText "pbabc pb" h2_value
544− testWidget' checkStatic checkHydrated $ do
546− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
547− el "h1" $ dynText $ _inputElement_value e
548− el "h2" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ updated $ _inputElement_value e
549− el "h3" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ _inputElement_input e
550− it "value is correct when both setValue AND user updated value happen before switchover" $ runWD $ do
551− let checkStatic = do
552− input <- findElemWithRetry $ WD.ByTag "input"
553− p <- findElemWithRetry (WD.ByTag "p")
554− WD.attr input "value" `shouldBeWithRetryM` Just "pb"
555− shouldContainText "pb" p
556− WD.sendKeys "abc" input
557− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
558− shouldContainText "pb" p -- It won't be updated yet
560− checkHydrated (input, p) = do
561− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
562− shouldContainText "pbabc" p
564− testWidget' checkStatic checkHydrated $ do
566− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
567− el "p" $ dynText $ _inputElement_value e
568− it "input event and (updated value) fire correctly when both setValue AND user updated value happen before switchover" $ runWD $ do
569− valRef <- newRef ([] :: [Text])
570− inputRef <- newRef ([] :: [Text])
571− let consRef ref a = liftIO $ atomicModifyRef ref $ \as -> (a:as, ())
573− input <- findElemWithRetry $ WD.ByTag "input"
574− p <- findElemWithRetry (WD.ByTag "p")
575− WD.attr input "value" `shouldBeWithRetryM` Just "pb"
576− shouldContainText "pb" p
577− WD.sendKeys "abc" input
578− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
579− shouldContainText "pb" p -- It won't be updated yet
580− readRef inputRef `shouldBeWithRetryM` [] -- Should never fire input ref during SSR
581− readRef valRef `shouldBeWithRetryM` ["pb"]
583− checkHydrated (input, p) = do
584− readRef inputRef `shouldBeWithRetryM` ["pbabc"]
585− readRef valRef `shouldBeWithRetryM` ["pbabc", "pb"]
586− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"
587− shouldContainText "pbabc" p
589− testWidget' checkStatic checkHydrated $ do
590− liftIO $ writeRef valRef []
592− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)
593− el "p" $ dynText $ _inputElement_value e
594− performEvent_ $ consRef valRef <$> updated (_inputElement_value e)
595− performEvent_ $ consRef inputRef <$> _inputElement_input e
596− describe "hydration/immediate" $ do
420+ describe "hydration/immediate" $ session' $ do
597 it "captures user input after switchover" $ runWD $ do
421 it "captures user input after switchover" $ runWD $ do
598 inputRef :: IORef Text <- newRef ""
422 inputRef :: IORef Text <- newRef ""
599 let checkValue = do
423 let checkValue = do
@@ -673,8 +497,8 @@ tests withDebugging wdConfig caps _selenium = do
673 names <- liftJSM $ traverse File.getName fs
497 names <- liftJSM $ traverse File.getName fs
674 liftIO $ writeRef filesRef names
498 liftIO $ writeRef filesRef names
676− session' "textAreaElement" $ do
500+ describe "textAreaElement" $ do
677− describe "static renderer" $ do
501+ describe "static renderer" $ session' $ do
678 it "sets value attribute" $ runWD $ do
502 it "sets value attribute" $ runWD $ do
679 let checkStatic = do
503 let checkStatic = do
680 e <- findElemWithRetry $ WD.ByTag "textarea"
504 e <- findElemWithRetry $ WD.ByTag "textarea"
@@ -697,7 +521,7 @@ tests withDebugging wdConfig caps _selenium = do
697 & textAreaElementConfig_initialValue .~ "test"
521 & textAreaElementConfig_initialValue .~ "test"
698 & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)
522 & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)
700− describe "hydration" $ do
524+ describe "hydration" $ session' $ do
701 it "doesn't wipe user input when switching over" $ runWD $ do
525 it "doesn't wipe user input when switching over" $ runWD $ do
702 inputRef <- newRef ("" :: Text)
526 inputRef <- newRef ("" :: Text)
703 testWidget'
527 testWidget'
@@ -763,90 +587,8 @@ tests withDebugging wdConfig caps _selenium = do
763 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
587 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
764 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
588 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
765 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
589 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
766− it "fires _input event if the user altered the value before hydration" $ runWD $ do
767− textarea <- newRef ("" :: Text)
768− update <- newRef ("" :: Text)
769− let checkStatic = do
770− e <- findElemWithRetry $ WD.ByTag "textarea"
771− WD.attr e "value" `shouldBeWithRetryM` Just ""
772− WD.sendKeys "test" e
773− WD.attr e "value" `shouldBeWithRetryM` Just "test"
775− checkHydrated e = do
776− WD.attr e "value" `shouldBeWithRetryM` Just "test"
777− readRef textarea `shouldBeWithRetryM` "test"
778− readRef update `shouldBeWithRetryM` "test"
779− testWidget' checkStatic checkHydrated $ do
780− e <- textAreaElement def
781− performEvent_ $ liftIO . writeRef textarea <$> _textAreaElement_input e
782− performEvent_ $ liftIO . writeRef update <$> updated (_textAreaElement_value e)
783− it "does not fire _input event when the value is updated at postBuild" $ runWD $ do
784− textarea <- newRef (Nothing :: Maybe Text)
785− let checkStatic = do
786− e <- findElemWithRetry $ WD.ByTag "textarea"
787− WD.attr e "value" `shouldBeWithRetryM` Just "pb"
789− checkHydrated e = do
790− WD.attr e "value" `shouldBeWithRetryM` Just "pb"
791− readRef textarea `shouldBeWithRetryM` Nothing
792− testWidget' checkStatic checkHydrated $ do
794− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
795− performEvent_ $ liftIO . writeRef textarea . Just <$> _textAreaElement_input e
796− it "SSR produces correct DOM based on textAreaElement values when setValue happens at postBuild" $ runWD $ do
798− textarea <- findElemWithRetry $ WD.ByTag "textarea"
799− WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"
800− p <- findElemWithRetry (WD.ByTag "p")
801− shouldContainText "pb" p
802− testWidget checkBoth checkBoth $ do
804− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
805− el "p" $ dynText $ _textAreaElement_value e
806− it "does not fail when both setValue AND user updated value happen before switchover" $ runWD $ do
807− let checkStatic = do
808− textarea <- findElemWithRetry $ WD.ByTag "textarea"
809− h2_value <- findElemWithRetry (WD.ByTag "h2")
810− h3_input <- findElemWithRetry (WD.ByTag "h3")
811− WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"
812− shouldContainText "pb" h2_value
813− shouldContainText "" h3_input
814− WD.sendKeys "abc" textarea
815− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
816− shouldContainText "pb" h2_value
817− shouldContainText "" h3_input
818− pure (textarea, h2_value, h3_input)
819− checkHydrated (textarea, h2_value, h3_input) = do
820− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
821− shouldContainText "pbabc" h3_input
822− shouldContainText "pbabc pb" h2_value
824− testWidget' checkStatic checkHydrated $ do
826− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
827− el "h1" $ dynText $ _textAreaElement_value e
828− el "h2" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ updated $ _textAreaElement_value e
829− el "h3" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ _textAreaElement_input e
830− it "value is correct when both setValue AND user updated value happen before switchover" $ runWD $ do
831− let checkStatic = do
832− textarea <- findElemWithRetry $ WD.ByTag "textarea"
833− p <- findElemWithRetry (WD.ByTag "p")
834− WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"
835− shouldContainText "pb" p
836− WD.sendKeys "abc" textarea
837− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
838− shouldContainText "pb" p -- It won't be updated yet
840− checkHydrated (textarea, p) = do
841− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"
842− shouldContainText "pbabc" p
844− testWidget' checkStatic checkHydrated $ do
846− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)
847− el "p" $ dynText $ _textAreaElement_value e
849− describe "hydration/immediate" $ do
591+ describe "hydration/immediate" $ session' $ do
850 it "captures user input after switchover" $ runWD $ do
592 it "captures user input after switchover" $ runWD $ do
851 inputRef :: IORef Text <- newRef ""
593 inputRef :: IORef Text <- newRef ""
852 let checkValue = do
594 let checkValue = do
@@ -888,13 +630,13 @@ tests withDebugging wdConfig caps _selenium = do
888 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
630 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
889 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
631 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
891− session' "selectElement" $ do
633+ describe "selectElement" $ do
892 let options :: DomBuilder t m => m ()
634 let options :: DomBuilder t m => m ()
893 options = do
635 options = do
894 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
636 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
895 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
637 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
896 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
638 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
897− describe "hydration" $ do
639+ describe "hydration" $ session' $ do
898 it "sets initial value correctly" $ runWD $ do
640 it "sets initial value correctly" $ runWD $ do
899 inputRef <- newRef ("" :: Text)
641 inputRef <- newRef ("" :: Text)
900 let setup = do
642 let setup = do
@@ -968,7 +710,7 @@ tests withDebugging wdConfig caps _selenium = do
968 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
710 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
969 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
711 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
971− describe "hydration/immediate" $ do
713+ describe "hydration/immediate" $ session' $ do
972 it "captures user input after switchover" $ runWD $ do
714 it "captures user input after switchover" $ runWD $ do
973 inputRef :: IORef Text <- newRef ""
715 inputRef :: IORef Text <- newRef ""
974 let checkValue = do
716 let checkValue = do
@@ -1014,7 +756,7 @@ tests withDebugging wdConfig caps _selenium = do
1014 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
756 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
1015 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
757 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
1017− session' "prerender" $ do
759+ describe "prerender" $ session' $ do
1018 it "works in simple case" $ runWD $ do
760 it "works in simple case" $ runWD $ do
1019 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
761 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
1020 prerender_ (text "One") (text "Two")
762 prerender_ (text "One") (text "Two")
@@ -1083,7 +825,7 @@ tests withDebugging wdConfig caps _selenium = do
1083 prerender_ (pure ()) (liftIO $ trigger "Client")
825 prerender_ (pure ()) (liftIO $ trigger "Client")
1084 textNode $ TextNodeConfig "Initial" $ Just e
826 textNode $ TextNodeConfig "Initial" $ Just e
1086− session' "namespaces" $ do
828+ describe "namespaces" $ session' $ do
1087 it "dyn can be nested in namespaced widget" $ runWD $ do
829 it "dyn can be nested in namespaced widget" $ runWD $ do
1088 testWidget (pure ()) (checkTextInTag "svg" "one") $ do
830 testWidget (pure ()) (checkTextInTag "svg" "one") $ do
1089 let svgRootCfg = def
831 let svgRootCfg = def
@@ -1092,7 +834,7 @@ tests withDebugging wdConfig caps _selenium = do
1092 void $ element "svg" svgRootCfg $ do
834 void $ element "svg" svgRootCfg $ do
1093 dyn_ $ text "one" <$ pure ()
835 dyn_ $ text "one" <$ pure ()
1095− session' "runWithReplace" $ do
837+ describe "runWithReplace" $ session' $ do
1096 it "works" $ runWD $ do
838 it "works" $ runWD $ do
1097 replaceChan :: Chan Text <- liftIO newChan
839 replaceChan :: Chan Text <- liftIO newChan
1098 let setup = findElemWithRetry $ WD.ByTag "div"
840 let setup = findElemWithRetry $ WD.ByTag "div"
@@ -1266,9 +1008,7 @@ tests withDebugging wdConfig caps _selenium = do
1266 _ <- runWithReplace (text "inner1" *> comment "replace-end-0") $ text "inner2" <$ replace
1008 _ <- runWithReplace (text "inner1" *> comment "replace-end-0") $ text "inner2" <$ replace
1267 text "|after"
1009 text "|after"
1268 void $ runWithReplace blank $ el "p" blank <$ replace -- Signal tag for end of test
1010 void $ runWithReplace blank $ el "p" blank <$ replace -- Signal tag for end of test
1269− -- TODO This test actually causes a hydration failure, but it wasn't
1270− -- previously detected, so I've marked it pending
1271− xit "ignores missing ending bracketing comments" $ runWD $ do
1011+ it "ignores missing ending bracketing comments" $ runWD $ do
1272 replaceChan :: Chan () <- liftIO newChan
1012 replaceChan :: Chan () <- liftIO newChan
1274 preSwitchover = do
1014 preSwitchover = do
@@ -1290,7 +1030,7 @@ tests withDebugging wdConfig caps _selenium = do
1290 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
1030 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
1291 text "|after"
1031 text "|after"
1293− session' "traverseDMapWithKeyWithAdjust" $ do
1033+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do
1294 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
1034 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
1295 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
1035 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
1296 elClass "span" "key" $ text $ textKey k
1036 elClass "span" "key" $ text $ textKey k
@@ -1393,7 +1133,7 @@ tests withDebugging wdConfig caps _selenium = do
1393 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1133 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1394 liftIO $ dmap `H.shouldBe` keyMap
1134 liftIO $ dmap `H.shouldBe` keyMap
1396− session' "traverseIntMapWithKeyWithAdjust" $ do
1136+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do
1397 let textKeyInt k = "key" <> T.pack (show k)
1137 let textKeyInt k = "key" <> T.pack (show k)
1398 intMap = IntMap.fromList
1138 intMap = IntMap.fromList
1399 [ (1, "one")
1139 [ (1, "one")
@@ -1500,7 +1240,7 @@ tests withDebugging wdConfig caps _selenium = do
1500 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1240 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1501 liftIO $ dmap `H.shouldBe` intMap
1241 liftIO $ dmap `H.shouldBe` intMap
1503− session' "traverseDMapWithKeyWithAdjustWithMove" $ do
1243+ describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do
1504 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
1244 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
1505 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do
1245 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do
1506 elClass "span" "key" $ text $ textKey2 k
1246 elClass "span" "key" $ text $ textKey2 k
@@ -1580,8 +1320,8 @@ tests withDebugging wdConfig caps _selenium = do
1580 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
1320 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
1581 liftIO $ assertEqual "DMap" initMap dmap
1321 liftIO $ assertEqual "DMap" initMap dmap
1583− session' "hydrating invalid HTML" $ do
1323+ describe "hydrating invalid HTML" $ session' $ do
1584− xit "can hydrate list in paragraph" $ runWD $ do
1324+ it "can hydrate list in paragraph" $ runWD $ do
1585 let preSwitchover = do
1325 let preSwitchover = do
1586 checkBodyText "before\ninner\nafter"
1326 checkBodyText "before\ninner\nafter"
1587 -- Two <p> tags should be present
1327 -- Two <p> tags should be present
@@ -1598,8 +1338,7 @@ tests withDebugging wdConfig caps _selenium = do
1598 shouldContainText "before\ninner\nafter" p1
1338 shouldContainText "before\ninner\nafter" p1
1599 elementShouldBeRemoved ol
1339 elementShouldBeRemoved ol
1600 elementShouldBeRemoved p2
1340 elementShouldBeRemoved p2
1601− -- Don't fail fatally when hydration encounters the invalid DOM
1602− testWidgetDebug' False withDebugging preSwitchover check $ do
1341+ testWidget' preSwitchover check $ do
1603 -- This is deliberately invalid HTML, the browser will interpret it as
1342 -- This is deliberately invalid HTML, the browser will interpret it as
1604 -- <p>before</p><ol>inner</ol>after<p></p>
1343 -- <p>before</p><ol>inner</ol>after<p></p>
1605 el "p" $ do
1344 el "p" $ do
@@ -1610,7 +1349,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.
1349 -- 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.
1350 -- 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.
1351 -- 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
1352+ describe "dropdown" $ session' $ do
1614 let doTest expectedOpts (initialValue :: Text) = do
1353 let doTest expectedOpts (initialValue :: Text) = do
1615 let doCheck = do
1354 let doCheck = do
1616 es <- findElemsWithRetry $ WD.ByTag "option"
1355 es <- findElemsWithRetry $ WD.ByTag "option"
@@ -1725,12 +1464,11 @@ testWidgetStaticDebug
1725 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1464 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1726 -- ^ Widget we are testing
1465 -- ^ Widget we are testing
1728−testWidgetStaticDebug withDebugging w = testWidgetDebug True withDebugging (void w) w
1467+testWidgetStaticDebug withDebugging w = testWidgetDebug withDebugging (void w) w
1730-- | TODO: do something about JSExceptions not causing tests to fail
1469-- | TODO: do something about JSExceptions not causing tests to fail
1731testWidgetDebug
1470testWidgetDebug
1734 -> WD ()
1472 -> WD ()
1735 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
1473 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
@@ -1738,16 +1476,12 @@ testWidgetDebug
1738 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1476 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1739 -- ^ Widget we are testing
1477 -- ^ Widget we are testing
1741−testWidgetDebug hardFailure withDebugging beforeJS afterSwitchover =
1479+testWidgetDebug withDebugging beforeJS afterSwitchover =
1742− testWidgetDebug' hardFailure withDebugging beforeJS (const afterSwitchover)
1480+ testWidgetDebug' withDebugging beforeJS (const afterSwitchover)
1744−data HydrationFailedException = HydrationFailedException deriving Show
1745−instance Exception HydrationFailedException
1747-- | TODO: do something about JSExceptions not causing tests to fail
1482-- | TODO: do something about JSExceptions not causing tests to fail
1748testWidgetDebug'
1483testWidgetDebug'
1752 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
1486 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
1753 -> (a -> WD b)
1487 -> (a -> WD b)
@@ -1755,7 +1489,7 @@ testWidgetDebug'
1755 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1489 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1756 -- ^ Widget we are testing (contents of body)
1490 -- ^ Widget we are testing (contents of body)
1758−testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget = do
1492+testWidgetDebug' withDebugging beforeJS afterSwitchover bodyWidget = do
1759 let putStrLnDebug :: MonadIO m => Text -> m ()
1493 let putStrLnDebug :: MonadIO m => Text -> m ()
1760 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
1494 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
1761 staticApp = do
1495 staticApp = do
@@ -1767,7 +1501,6 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =
1767 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp
1501 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp
1768 putStrLnDebug "rendered static"
1502 putStrLnDebug "rendered static"
1769 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
1503 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
1770− onFailure <- if hardFailure then (`throwTo` HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()
1771 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
1504 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
1772 let entryPoint = do
1505 let entryPoint = do
1773 putStrLnDebug "taking waitBeforeJS"
1506 putStrLnDebug "taking waitBeforeJS"
@@ -1779,7 +1512,7 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =
1779 liftIO $ putMVar waitUntilSwitchover ()
1512 liftIO $ putMVar waitUntilSwitchover ()
1780 putStrLnDebug "put waitUntilSwitchover"
1513 putStrLnDebug "put waitUntilSwitchover"
1781 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"
1514 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"
1782− mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchOverAction blank bodyWidget
1515+ mainHydrationWidgetWithSwitchoverAction switchOverAction blank bodyWidget
1783 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"
1516 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"
1784 syncPoint
1517 syncPoint
1785 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do
1518 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do