@@ -28,7 +28,6 @@ import Data.Functor.Misc
2828import Data.GADT.Compare.TH
2929import Data.GADT.Show.TH
3030import Data.IORef
31−import Data.Map (Map)
3231import Data.Maybe (fromMaybe, fromJust)
3332import Data.Proxy
3433import Data.Text (Text)
@@ -45,28 +44,21 @@ import System.IO.Silently
4544import System.IO.Temp
4645import System.Process
4746import System.Timeout
48−import Test.HUnit
49−import Test.Hspec
47+import Test.HUnit (assertEqual, assertFailure)
48+import Test.Hspec (hspec, it, describe, beforeAll, shouldBe)
5049import Test.WebDriver (WD)
5150
5251import qualified Data.ByteString.Lazy as LBS
5352import qualified Data.Dependent.Map as DMap
5453import qualified Data.Text as T
5554import qualified Data.Text.Encoding as TE
56−import qualified GHCJS.DOM as DOM
57−import qualified GHCJS.DOM.Document as Document
58−import qualified GHCJS.DOM.Element as Element
59−import qualified GHCJS.DOM.EventM as EventM
6055import qualified GHCJS.DOM.File as File
61−import qualified GHCJS.DOM.GlobalEventHandlers as Events
62−import qualified GHCJS.DOM.Node as Node
63−import qualified GHCJS.DOM.Types as DOM
6456import qualified Network.Wai.Handler.Warp as Warp
6557import qualified System.FilePath as FilePath
6658import qualified Test.WebDriver as WD
6759
6860testTimeLimit :: Int
69−testTimeLimit = 3 * 1000 * 1000
61+testTimeLimit = 5 * 1000 * 1000
7062
7163chromeConfig :: WD.WDConfig
7264chromeConfig = WD.useBrowser (WD.chrome { WD.chromeBinary = Just "/run/current-system/sw/bin/chromium", WD.chromeOptions = ["--headless"]}) WD.defaultConfig
@@ -84,10 +76,12 @@ data DKey a where
8476
8577instance ArgDict DKey where
8678 type ConstraintsFor DKey c = (c Int, c Char, c Bool)
79+ type ConstraintsFor' DKey c g = (c (g Int), c (g Char), c (g Bool))
8780 argDict = \case
8881 Key_Int -> Dict
8982 Key_Char -> Dict
9083 Key_Bool -> Dict
84+ argDict' = undefined -- Missing constraints?
9185
9286textKey :: DKey a -> Text
9387textKey = \case
@@ -155,8 +149,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
155149 el "div" $ do
156150 el "span" $ text "hello world"
157151 text ""
158−
159− it "updates after postBuild" $ do
152+ it "updates after postBuild" $ do -- TODO I think these two tests are broken
160153 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
161154 after <- delay 0 =<< getPostBuild
162155 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
@@ -171,14 +164,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
171164 WD.click =<< WD.findElem (WD.ByTag "button")
172165 liftIO $ threadDelay 100000 -- wait for update
173166 checkBodyText "after"
174− testWidget (pure ()) checkUpdated $ prerender (pure ()) $ do
167+ testWidget (pure ()) checkUpdated $ prerender_ (pure ()) $ do
175168 click <- button ""
176169 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
177170
178− it "works when given differing results of prerender" $ do
179− testWidgetStatic (pure ()) $ do
180− text =<< prerender (pure "One") (pure "Two")
181−
182171 describe "element" $ do
183172 it "works with domEvent Click" $ do
184173 clickedRef <- newIORef False
@@ -194,10 +183,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
194183 WD.findElem (WD.ById "first") >>= WD.click
195184 WD.findElem (WD.ById "second") >>= WD.click
196185 testWidget (pure ()) clickBoth $ do
197− (firstDivEl, _) <- el' "div" $ prerender (pure ()) $ do
186+ (firstDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
198187 void $ elAttr "span" ("id" =: "first") $ text "hello world"
199188 performEvent_ $ liftIO (writeIORef firstClickedRef True) <$ domEvent Click firstDivEl
200− (secondDivEl, _) <- el' "div" $ prerender (pure ()) $ do
189+ (secondDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
201190 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
202191 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
203192 & initialAttributes .~ "id" =: "second"
@@ -214,14 +203,13 @@ main = hspec $ beforeAll startSeleniumServer $ do
214203 WD.click e
215204 s1 <- WD.isSelected e
216205 pure (s0, s1)
217− clicked <- testWidget (pure ()) click $ prerender (pure ()) $ do
206+ clicked <- testWidget (pure ()) click $ prerender_ (pure ()) $ do
218207 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
219208 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
220209 & elementConfig_eventSpec .~ (addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> preventDefault) def)
221210 & initialAttributes .~ "type" =: "checkbox"
222211 void $ element "input" conf $ text "hello world"
223212 assertEqual "Click not prevented" (False, False) clicked
224−
225213 it "can add/update/remove attributes" $ do
226214 let checkInitialAttrs = do
227215 e <- WD.findElem $ WD.ByTag "div"
@@ -244,7 +232,6 @@ main = hspec $ beforeAll startSeleniumServer $ do
244232 (e, ()) <- element "div" conf $ text "hello world"
245233 let click = domEvent Click e
246234 return ()
247−
248235 -- TODO check this is the correct solution
249236 it "has ssr attribute, removes ssr attribute" $ do
250237 let checkSSRAttr = do
@@ -253,27 +240,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
253240 pure e
254241 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
255242
256− it "can't misuse raw elements" $ do
257− clicked <- newIORef False
258− let check = do
259− e <- WD.findElem $ WD.ByTag "div"
260− liftIO $ readIORef clicked >>= flip shouldBe True
261− WD.click e
262− liftIO $ do
263− threadDelay 100000
264− readIORef clicked >>= flip shouldBe False
265− testWidget (pure ()) check $ do
266− (e, _) <- el' "div" $ text "hello"
267− prerender (pure ()) $ do
268− let e' = DOM.uncheckedCastTo DOM.HTMLElement (_element_raw e)
269− liftJSM $ e' `EventM.on` Events.click $ do
270− liftIO $ writeIORef clicked True
271− pure ()
272−
273243 describe "inputElement" $ do
274244 describe "hydration" $ do
275245 it "doesn't wipe user input when switching over" $ do
276− inputRef <- newIORef ""
246+ inputRef <- newIORef ("" :: Text)
277247 testWidget'
278248 (do
279249 e <- WD.findElem $ WD.ByTag "input"
@@ -290,7 +260,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
290260 click <- button "save"
291261 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
292262 it "captures user input after switchover" $ do
293− inputRef <- newIORef ""
263+ inputRef <- newIORef ("" :: Text)
294264 let checkValue = do
295265 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
296266 WD.click <=< WD.findElem $ WD.ByTag "button"
@@ -325,8 +295,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
325295 e <- inputElement def
326296 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
327297 it "sets value appropriately" $ do
328− valueByUIRef <- newIORef ""
329− valueRef <- newIORef ""
298+ valueByUIRef <- newIORef ("" :: Text)
299+ valueRef <- newIORef ("" :: Text)
330300 setValueChan :: Chan Text <- newChan
331301 let checkValue = do
332302 liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
@@ -342,8 +312,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
342312 readIORef valueByUIRef >>= flip shouldBe "hello"
343313 readIORef valueRef >>= flip shouldBe "world"
344314 testWidget (pure ()) checkValue $ do
345− setValue <- triggerEventWithChan setValueChan
346− e <- inputElement $ def & inputElementConfig_setValue .~ setValue
315+ update <- triggerEventWithChan setValueChan
316+ e <- inputElement $ def & inputElementConfig_setValue .~ update
347317 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
348318 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
349319 it "sets checked appropriately" $ do
@@ -384,7 +354,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
384354 testWidget (pure ()) uploadFile $ do
385355 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
386356 click <- button "save"
387− prerender (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
357+ prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
388358 names <- liftJSM $ traverse File.getName fs
389359 liftIO $ writeIORef filesRef names
390360
@@ -396,7 +366,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
396366 WD.click <=< WD.findElem $ WD.ByTag "button"
397367 input <- liftIO $ readIORef inputRef
398368 liftIO $ input `shouldBe` "hello world"
399− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
369+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
400370 e <- inputElement def
401371 click <- button "save"
402372 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
@@ -408,7 +378,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
408378 WD.click e
409379 liftIO $ threadDelay 100000
410380 liftIO $ readIORef focusRef >>= flip shouldBe True
411− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
381+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
412382 e <- inputElement def
413383 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
414384 it "sets value appropriately" $ do
@@ -428,11 +398,12 @@ main = hspec $ beforeAll startSeleniumServer $ do
428398 threadDelay 100000
429399 readIORef valueByUIRef >>= flip shouldBe "hello"
430400 readIORef valueRef >>= flip shouldBe "world"
431− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
432− setValue <- triggerEventWithChan setValueChan
433− e <- inputElement $ def & inputElementConfig_setValue .~ setValue
434− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
435− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
401+ testWidget (pure ()) checkValue $ do
402+ update <- triggerEventWithChan setValueChan
403+ prerender_ (pure ()) $ do
404+ e <- inputElement $ def & inputElementConfig_setValue .~ update
405+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
406+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
436407 it "sets checked appropriately" $ do
437408 checkedByUIRef <- newIORef False
438409 checkedRef <- newIORef False
@@ -451,13 +422,14 @@ main = hspec $ beforeAll startSeleniumServer $ do
451422 threadDelay 100000
452423 readIORef checkedByUIRef >>= flip shouldBe True
453424 readIORef checkedRef >>= flip shouldBe False
454− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
425+ testWidget (pure ()) checkValue $ do
455426 setChecked <- triggerEventWithChan setCheckedChan
456− e <- inputElement $ def
457− & initialAttributes .~ "type" =: "checkbox"
458− & inputElementConfig_setChecked .~ setChecked
459− performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
460− performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
427+ prerender_ (pure ()) $ do
428+ e <- inputElement $ def
429+ & initialAttributes .~ "type" =: "checkbox"
430+ & inputElementConfig_setChecked .~ setChecked
431+ performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
432+ performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
461433 it "captures file uploads" $ do
462434 filesRef :: IORef [Text] <- newIORef []
463435 let uploadFile = do
@@ -468,17 +440,17 @@ main = hspec $ beforeAll startSeleniumServer $ do
468440 liftIO $ removeFile path
469441 input <- liftIO $ readIORef filesRef
470442 liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
471− testWidget (pure ()) uploadFile $ prerender (pure ()) $ do
443+ testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
472444 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
473445 click <- button "save"
474− prerender (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
446+ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
475447 names <- liftJSM $ traverse File.getName fs
476448 liftIO $ writeIORef filesRef names
477449
478450 describe "textAreaElement" $ do
479451 describe "hydration" $ do
480452 it "doesn't wipe user input when switching over" $ do
481− inputRef <- newIORef ""
453+ inputRef <- newIORef ("" :: Text)
482454 testWidget'
483455 (do
484456 e <- WD.findElem $ WD.ByTag "textarea"
@@ -495,7 +467,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
495467 click <- button "save"
496468 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
497469 it "captures user input after switchover" $ do
498− inputRef <- newIORef ""
470+ inputRef <- newIORef ("" :: Text)
499471 let checkValue = do
500472 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
501473 WD.click <=< WD.findElem $ WD.ByTag "button"
@@ -560,7 +532,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
560532 WD.click <=< WD.findElem $ WD.ByTag "button"
561533 input <- liftIO $ readIORef inputRef
562534 liftIO $ input `shouldBe` "hello world"
563− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
535+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
564536 e <- textAreaElement def
565537 click <- button "save"
566538 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
@@ -572,7 +544,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
572544 WD.click e
573545 liftIO $ threadDelay 100000
574546 liftIO $ readIORef focusRef >>= flip shouldBe True
575− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
547+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
576548 e <- textAreaElement def
577549 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_textAreaElement_hasFocus e)
578550 it "sets value appropriately" $ do
@@ -592,11 +564,12 @@ main = hspec $ beforeAll startSeleniumServer $ do
592564 threadDelay 100000
593565 readIORef valueByUIRef >>= flip shouldBe "hello"
594566 readIORef valueRef >>= flip shouldBe "world"
595− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
567+ testWidget (pure ()) checkValue $ do
596568 setValue' <- triggerEventWithChan setValueChan
597− e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
598− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e
599− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
569+ prerender_ (pure ()) $ do
570+ e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
571+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e
572+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
600573
601574 describe "selectElement" $ do
602575 let options :: DomBuilder t m => m ()
@@ -606,7 +579,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
606579 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
607580 describe "hydration" $ do
608581 it "sets initial value correctly" $ do
609− inputRef <- newIORef ""
582+ inputRef <- newIORef ("" :: Text)
610583 let setup = do
611584 e <- WD.findElem $ WD.ByTag "select"
612585 assertAttr e "value" (Just "three")
@@ -624,7 +597,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
624597 liftIO . writeIORef inputRef <=< sample $ current $ _selectElement_value e
625598 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
626599 it "captures user input after switchover" $ do
627− inputRef <- newIORef ""
600+ inputRef <- newIORef ("" :: Text)
628601 let checkValue = do
629602 e <- WD.findElem $ WD.ByTag "select"
630603 assertAttr e "value" (Just "one")
@@ -691,7 +664,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
691664 WD.click <=< WD.findElem $ WD.ById "two"
692665 WD.click <=< WD.findElem $ WD.ByTag "button"
693666 liftIO $ readIORef inputRef >>= flip shouldBe "two"
694− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
667+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
695668 (e, ()) <- selectElement def options
696669 click <- button "save"
697670 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
@@ -703,7 +676,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
703676 WD.click e
704677 liftIO $ threadDelay 100000
705678 liftIO $ readIORef focusRef >>= flip shouldBe True
706− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
679+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
707680 (e, ()) <- selectElement def options
708681 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_selectElement_hasFocus e)
709682 it "sets value appropriately" $ do
@@ -722,116 +695,36 @@ main = hspec $ beforeAll startSeleniumServer $ do
722695 threadDelay 100000
723696 readIORef valueByUIRef >>= flip shouldBe "two"
724697 readIORef valueRef >>= flip shouldBe "three"
725− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
698+ testWidget (pure ()) checkValue $ do
726699 setValue' <- triggerEventWithChan setValueChan
727− (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
728− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e
729− performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)
730−
731− let createRawElement :: DOM.MonadJSM m => m DOM.Element
732− createRawElement = do
733− doc <- DOM.currentDocumentUnchecked
734− div <- Document.createElement doc ("div" :: Text)
735− Element.setAttribute div ("id" :: Text) ("raw" :: Text)
736− text <- Document.createTextNode doc ("two" :: Text)
737− Node.appendChild div text
738− pure div
739− describe "placeRawElement" $ do
740− let checkOrder = do
741− shouldContainText "two" <=< WD.findElem $ WD.ByTag "div"
742− shouldContainText "one\ntwo\nthree" <=< WD.findElem $ WD.ByTag "body"
743− it "is placed correctly in the DOM at switchover" $ do
744− testWidget (pure ()) checkOrder $ do
745− text "one"
746− prerender (pure ()) $ placeRawElement =<< createRawElement
747− text "three"
748− it "is placed correctly in the DOM in immediate mode" $ do
749− testWidget (pure ()) checkOrder $ prerender (pure ()) $ do
750− text "one"
751− placeRawElement =<< createRawElement
752− text "three"
753− it "is placed correctly in the DOM in hydration mode" $ do
754− testWidget (pure ()) checkOrder $ do
755− text "one"
756− mElement <- prerender (pure Nothing) $ Just <$> createRawElement
757− traverse_ placeRawElement mElement
758− text "three"
759− it "can be clicked" $ do
760− clickedRef <- newIORef False
761− let check = WD.click <=< WD.findElem $ WD.ByTag "div"
762− testWidget (pure ()) check $ prerender (pure ()) $ do
763− raw <- createRawElement
764− placeRawElement raw
765− let htmlElement = DOM.uncheckedCastTo DOM.HTMLElement raw
766− liftJSM $ htmlElement `EventM.on` Events.click $ do
767− liftIO $ writeIORef clickedRef True
768− return ()
769− clicked <- readIORef clickedRef
770− assertEqual "Not clicked" True clicked
771−
772− describe "wrapRawElement" $ do
773− it "modifies attributes" $ do
774− modifyAttrsChan :: Chan (Map AttributeName (Maybe Text)) <- newChan
775− let check = do
776− div <- WD.findElem $ WD.ByTag "div"
777− assertAttr div "test" Nothing
778− liftIO $ writeChan modifyAttrsChan ("test" =: Just "test")
779− assertAttr div "test" (Just "test")
780− testWidget (pure ()) check $ prerender (pure ()) $ do
781− modifyAttrs <- triggerEventWithChan modifyAttrsChan
782− raw <- createRawElement
783− placeRawElement raw
784− wrapRawElement raw $ RawElementConfig
785− { _rawElementConfig_modifyAttributes = Just modifyAttrs
786− , _rawElementConfig_eventSpec = (def :: EventSpec GhcjsDomSpace EventResult)
787− }
788− return ()
789− it "works with eventFlags" $ do
790− clickedRef <- newIORef False
791− let clickBoth = do
792− liftIO $ readIORef clickedRef >>= flip shouldBe False
793− WD.findElem (WD.ById "normal") >>= WD.click
794− liftIO $ do
795− readIORef clickedRef >>= flip shouldBe True
796− writeIORef clickedRef False
797− WD.findElem (WD.ById "raw") >>= WD.click
798− liftIO $ do
799− threadDelay 100000
800− readIORef clickedRef >>= flip shouldBe False
801− testWidget (pure ()) clickBoth $ prerender (pure ()) $ do
802− (e, _) <- el' "div" $ do
803− raw <- createRawElement
804− placeRawElement raw
805− wrapRawElement raw $ RawElementConfig
806− { _rawElementConfig_modifyAttributes = Nothing
807− , _rawElementConfig_eventSpec = addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> stopPropagation) (def :: EventSpec GhcjsDomSpace EventResult)
808− }
809− elAttr "div" ("id" =: "normal") $ text "normal"
810− performEvent_ $ liftIO (writeIORef clickedRef True) <$ domEvent Click e
700+ prerender_ (pure ()) $ do
701+ (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
702+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e
703+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)
811704
812705 describe "prerender" $ do
813706 it "works in simple case" $ do
814707 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
815− prerender (text "One") (text "Two")
708+ prerender_ (text "One") (text "Two")
816709 it "removes element correctly" $ do
817710 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
818− prerender (el "span" $ text "One") (text "Two")
711+ prerender_ (el "span" $ text "One") (text "Two")
819712 it "can be nested in server widget" $ do
820713 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
821− prerender (prerender (text "One") (text "Two")) (text "Three")
714+ prerender_ (prerender_ (text "One") (text "Two")) (text "Three")
822715 it "can be nested in client widget" $ do
823716 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
824− prerender (text "One") (prerender (text "Two") (text "Three"))
825− it "works with prerender siblings" $ do
717+ prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
718+ it "works with prerender_ siblings" $ do
826719 testWidget
827720 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
828721 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
829− prerender (divId "a1" $ text "One") (divId "a2" $ text "Two")
830− prerender (divId "b1" $ text "Three") (divId "b2" $ text "Four")
831− prerender (divId "c1" $ text "Five") (divId "c2" $ text "Six")
722+ prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
723+ prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
724+ prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
832725 it "works inside other element" $ do
833726 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
834− el "div" $ prerender (text "One") (text "Two")
727+ el "div" $ prerender_ (text "One") (text "Two")
835728 it "places fences and removes them" $ do
836729 testWidget'
837730 (do
@@ -839,25 +732,47 @@ main = hspec $ beforeAll startSeleniumServer $ do
839732 filterM (\s -> maybe False (\t -> "prerender" `T.isPrefixOf` t) <$> WD.attr s "type") scripts
840733 )
841734 (traverse_ elementShouldBeRemoved)
842− (el "span" $ prerender (text "One") (text "Two"))
843−-- it "postBuild works on server side" $ do
844−-- pbRef <- newIORef False
845−-- testWidgetStatic (pure ()) $ do
846−-- prerender (do
847−-- pb <- getPostBuild
848−-- performEvent_ $ liftIO (writeIORef pbRef True) <$ pb) blank
849−-- readIORef pbRef >>= (`shouldBe` True)
735+ (el "span" $ prerender_ (text "One") (text "Two"))
736+ it "postBuild works on server side" $ do
737+ lock :: MVar () <- newEmptyMVar
738+ testWidget (liftIO $ takeMVar lock) (pure ()) $ do
739+ prerender_ (do
740+ pb <- getPostBuild
741+ performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
850742 it "postBuild works on client side" $ do
851− pbRef <- newIORef False
852− testWidgetStatic (pure ()) $ do
853− prerender blank $ do
743+ lock :: MVar () <- newEmptyMVar
744+ testWidget (pure ()) (liftIO $ takeMVar lock) $ do
745+ prerender_ blank $ do
854746 pb <- getPostBuild
855− performEvent_ $ liftIO (writeIORef pbRef True) <$ pb
856− readIORef pbRef >>= (`shouldBe` True)
747+ performEvent_ $ liftIO (putMVar lock ()) <$ pb
748+ it "result Dynamic is updated *after* switchover" $ do
749+ let static = shouldContainText "PostBuild" =<< WD.findElem (WD.ByTag "body")
750+ check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
751+ testWidget static check $ void $ do
752+ d <- prerender (pure "Initial") (pure "Client")
753+ pb <- getPostBuild
754+ initial <- sample $ current d
755+ textNode $ TextNodeConfig initial $ Just $ leftmost [updated d, "PostBuild" <$ pb]
756+ -- This essentially checks that the client IO runs *after* switchover/postBuild,
757+ -- thus can't create conflicting DOM
758+ it "can't exploit IO to break hydration" $ do
759+ let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
760+ testWidgetStatic static $ void $ do
761+ ref <- liftIO $ newIORef "Initial"
762+ prerender_ (pure ()) (liftIO $ writeIORef ref "Client")
763+ text <=< liftIO $ readIORef ref
764+ -- As above, so below
765+ it "can't exploit triggerEvent to break hydration" $ do
766+ let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
767+ check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
768+ testWidget static check $ void $ do
769+ (e, trigger) <- newTriggerEvent
770+ prerender_ (pure ()) (liftIO $ trigger "Client")
771+ textNode $ TextNodeConfig "Initial" $ Just e
857772
858773 describe "runWithReplace" $ do
859774 it "works" $ do
860− replaceChan <- newChan
775+ replaceChan :: Chan Text <- newChan
861776 let setup = WD.findElem $ WD.ByTag "div"
862777 check ssr = do
863778 -- Check that the original element still exists and has the correct text
@@ -870,13 +785,12 @@ main = hspec $ beforeAll startSeleniumServer $ do
870785 testWidget' setup check $ do
871786 replace <- triggerEventWithChan replaceChan
872787 pb <- getPostBuild
873− runWithReplace (el "div" $ text "one") $ leftmost
788+ void $ runWithReplace (el "div" $ text "one") $ leftmost
874789 [ el "div" (text "two") <$ pb
875790 , el "span" . text <$> replace
876791 ]
877− return ()
878792 it "can be nested in initial widget" $ do
879− replaceChan <- newChan
793+ replaceChan :: Chan Text <- newChan
880794 let setup = WD.findElem $ WD.ByTag "div"
881795 check ssr = do
882796 -- Check that the original element still exists and has the correct text
@@ -889,11 +803,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
889803 testWidget' setup check $ void $ flip runWithReplace never $ do
890804 replace <- triggerEventWithChan replaceChan
891805 pb <- getPostBuild
892− runWithReplace (el "div" $ text "one") $ leftmost
806+ void $ runWithReplace (el "div" $ text "one") $ leftmost
893807 [ el "div" (text "two") <$ pb
894808 , el "span" . text <$> replace
895809 ]
896− return ()
897810 it "can be nested in postBuild widget" $ do
898811 replaceChan <- newChan
899812 let setup = WD.findElem $ WD.ByTag "div"
@@ -909,20 +822,34 @@ main = hspec $ beforeAll startSeleniumServer $ do
909822 pb <- getPostBuild
910823 runWithReplace (pure ()) $ ffor pb $ \() -> do
911824 replace <- triggerEventWithChan replaceChan
912− pb <- getPostBuild
913− runWithReplace (el "div" $ text "one") $ leftmost
914− [ el "div" (text "two") <$ pb
825+ pb' <- getPostBuild
826+ void $ runWithReplace (el "div" $ text "one") $ leftmost
827+ [ el "div" (text "two") <$ pb'
915828 , el "span" . text <$> replace
916829 ]
917− return ()
918− it "can be nested in event widget" $ do
919− replaceChan1 <- newChan
920− replaceChan2 <- newChan
830+ it "postBuild works in replaced widget" $ do
831+ replaceChan <- newChan
832+ pbLock <- newEmptyMVar
833+ let check = do
834+ liftIO $ do
835+ writeChan replaceChan ()
836+ threadDelay 100000
837+ takeMVar pbLock
838+ testWidget (pure ()) check $ void $ do
839+ replace <- triggerEventWithChan replaceChan
840+ runWithReplace (pure ()) $ ffor replace $ \() -> do
841+ pb <- getPostBuild
842+ performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
843+ it "can be nested in event widget" $ do -- Test is broken, I think
844+ replaceChan1 :: Chan Text <- newChan
845+ replaceChan2 :: Chan Text <- newChan
846+ lock :: MVar () <- newEmptyMVar
921847 let check = do
922848 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
923849 liftIO $ do
924850 writeChan replaceChan1 "one"
925851 threadDelay 100000
852+ takeMVar lock
926853 one <- WD.findElem $ WD.ByTag "div"
927854 WD.getText one >>= liftIO . flip shouldBe "pb"
928855 liftIO $ do
@@ -935,11 +862,11 @@ main = hspec $ beforeAll startSeleniumServer $ do
935862 runWithReplace (pure ()) $ ffor replace1 $ \r1 -> do
936863 replace2 <- triggerEventWithChan replaceChan2
937864 pb <- getPostBuild
938− runWithReplace (el "div" $ text r1) $ leftmost
865+ performEvent_ $ liftIO (putMVar lock ()) <$ pb
866+ void $ runWithReplace (el "div" $ text r1) $ leftmost
939867 [ el "span" . text <$> replace2
940868 , el "div" (text "pb") <$ pb
941869 ]
942− return ()
943870 it "works in immediate mode (RHS of prerender)" $ do
944871 replaceChan :: Chan Text <- newChan
945872 let check = do
@@ -952,9 +879,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
952879 elementShouldBeRemoved one
953880 shouldContainText "pb" =<< WD.findElem (WD.ByTag "span")
954881 testWidget (pure ()) check $ void $ do
955− prerender blank $ do
956− replace <- triggerEventWithChan replaceChan
957− pb <- getPostBuild
882+ replace <- triggerEventWithChan replaceChan
883+ prerender_ blank $ do
958884 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
959885 it "works with postBuild in immediate mode (RHS of prerender)" $ do
960886 replaceChan :: Chan Text <- newChan
@@ -968,8 +894,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
968894 elementShouldBeRemoved two
969895 shouldContainText "three" =<< WD.findElem (WD.ByTag "span")
970896 testWidget (pure ()) check $ void $ do
971− prerender blank $ do
972− replace <- triggerEventWithChan replaceChan
897+ replace <- triggerEventWithChan replaceChan
898+ prerender_ blank $ do
973899 pb <- getPostBuild
974900 void $ runWithReplace (el "div" $ text "one") $ leftmost
975901 [ el "div" (text "two") <$ pb
@@ -977,7 +903,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
977903 ]
978904
979905 describe "traverseDMapWithKeyWithAdjust" $ do
980− let widget :: TestWidget js t m => DKey a -> Identity a -> m (Identity a)
906+ let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
981907 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
982908 elClass "span" "key" $ text $ textKey k
983909 elClass "span" "value" $ text $ T.pack $ has @Show k $ show v
@@ -1041,17 +967,19 @@ main = hspec $ beforeAll startSeleniumServer $ do
1041967 it "can delete/update/insert when built in prerender" $ do
1042968 chan <- newChan
1043969 let check = do
1044− getAndCheckInitialItems keyMap
970+ _ <- getAndCheckInitialItems keyMap
1045971 checkRemoval chan Key_Int
1046972 checkReplace chan Key_Char 'B'
1047973 checkInsert chan Key_Bool True
1048− testWidget (pure ()) check $ prerender (pure ()) $ void $ do
1049− (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
1050− liftIO $ dmap `shouldBe` keyMap
974+ testWidget (pure ()) check $ do
975+ replace <- triggerEventWithChan chan
976+ prerender_ (pure ()) $ do
977+ (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
978+ liftIO $ dmap `shouldBe` keyMap
1051979 it "can delete/update/insert when built in immediate mode" $ do
1052980 chan <- newChan
1053981 let check = do
1054− getAndCheckInitialItems keyMap
982+ _ <- getAndCheckInitialItems keyMap
1055983 checkRemoval chan Key_Int
1056984 checkReplace chan Key_Char 'B'
1057985 checkInsert chan Key_Bool True
@@ -1064,13 +992,13 @@ main = hspec $ beforeAll startSeleniumServer $ do
1064992 it "handles postBuild correctly in prerender" $ do
1065993 chan <- newChan
1066994 let check = do
1067− getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
995+ _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
1068996 checkRemoval chan Key_Int
1069997 checkInsert chan Key_Char 'B'
1070998 checkReplace chan Key_Bool True
1071999 testWidget (pure ()) check $ do
10721000 replace <- triggerEventWithChan chan
1073− prerender (pure ()) $ void $ do
1001+ prerender_ (pure ()) $ void $ do
10741002 pb <- getPostBuild
10751003 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
10761004 liftIO $ dmap `shouldBe` keyMap
@@ -1085,10 +1013,10 @@ startSeleniumServer = do
10851013 _ <- forkIO $ print =<< waitForProcess ph
10861014 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
10871015
1088−triggerEventWithChan :: (TriggerEvent t m, Prerender js m) => Chan a -> m (Event t a)
1016+triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender t m) => Chan a -> m (Event t a)
10891017triggerEventWithChan chan = do
10901018 (e, trigger) <- newTriggerEvent
1091− prerender (pure ()) $ void $ liftIO $ forkIO $ forever $ trigger =<< readChan chan
1019+ prerender_ (pure ()) $ void $ liftIO $ forkIO $ forever $ trigger =<< readChan chan
10921020 pure e
10931021
10941022assertAttr :: WD.Element -> Text -> Maybe Text -> WD ()
@@ -1098,7 +1026,7 @@ elementShouldBeRemoved :: WD.Element -> WD ()
10981026elementShouldBeRemoved e = do
10991027 try (WD.getText e) >>= \case
11001028 Left (WD.FailedCommand WD.StaleElementReference _) -> return ()
1101− Left e -> throwM e
1029+ Left err -> throwM err
11021030 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
11031031
11041032shouldContainText :: Text -> WD.Element -> WD ()
@@ -1108,7 +1036,7 @@ checkBodyText :: Text -> WD ()
11081036checkBodyText = checkTextInTag "body"
11091037
11101038checkTextInTag :: Text -> Text -> WD ()
1111−checkTextInTag tag expected = WD.findElem (WD.ByTag tag) >>= shouldContainText expected
1039+checkTextInTag t expected = WD.findElem (WD.ByTag t) >>= shouldContainText expected
11121040
11131041checkTextInId :: Text -> Text -> WD ()
11141042checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expected
@@ -1116,7 +1044,7 @@ checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expecte
11161044divId :: DomBuilder t m => Text -> m a -> m a
11171045divId i = elAttr "div" ("id" =: i)
11181046
1119−type TestWidget js t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender js m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadFix m, MonadIO m)
1047+type TestWidget n t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadIO m)
11201048
11211049testWidgetStatic
11221050 :: WD b