@@ -28,7 +28,6 @@ import Data.Functor.Misc
28import Data.GADT.Compare.TH
28import Data.GADT.Compare.TH
29import Data.GADT.Show.TH
29import Data.GADT.Show.TH
30import Data.IORef
30import Data.IORef
32import Data.Maybe (fromMaybe, fromJust)
31import Data.Maybe (fromMaybe, fromJust)
33import Data.Proxy
32import Data.Proxy
34import Data.Text (Text)
33import Data.Text (Text)
@@ -45,28 +44,21 @@ import System.IO.Silently
45import System.IO.Temp
44import System.IO.Temp
46import System.Process
45import System.Process
47import System.Timeout
46import System.Timeout
48−import Test.HUnit
47+import Test.HUnit (assertEqual, assertFailure)
49−import Test.Hspec
48+import Test.Hspec (hspec, it, describe, beforeAll, shouldBe)
50import Test.WebDriver (WD)
49import Test.WebDriver (WD)
52import qualified Data.ByteString.Lazy as LBS
51import qualified Data.ByteString.Lazy as LBS
53import qualified Data.Dependent.Map as DMap
52import qualified Data.Dependent.Map as DMap
54import qualified Data.Text as T
53import qualified Data.Text as T
55import qualified Data.Text.Encoding as TE
54import 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
60import qualified GHCJS.DOM.File as File
55import 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
64import qualified Network.Wai.Handler.Warp as Warp
56import qualified Network.Wai.Handler.Warp as Warp
65import qualified System.FilePath as FilePath
57import qualified System.FilePath as FilePath
66import qualified Test.WebDriver as WD
58import qualified Test.WebDriver as WD
68testTimeLimit :: Int
60testTimeLimit :: Int
69−testTimeLimit = 3 * 1000 * 1000
61+testTimeLimit = 5 * 1000 * 1000
71chromeConfig :: WD.WDConfig
63chromeConfig :: WD.WDConfig
72chromeConfig = WD.useBrowser (WD.chrome { WD.chromeBinary = Just "/run/current-system/sw/bin/chromium", WD.chromeOptions = ["--headless"]}) WD.defaultConfig
64chromeConfig = 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
85instance ArgDict DKey where
77instance ArgDict DKey where
86 type ConstraintsFor DKey c = (c Int, c Char, c Bool)
78 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))
87 argDict = \case
80 argDict = \case
88 Key_Int -> Dict
81 Key_Int -> Dict
89 Key_Char -> Dict
82 Key_Char -> Dict
90 Key_Bool -> Dict
83 Key_Bool -> Dict
84+ argDict' = undefined -- Missing constraints?
92textKey :: DKey a -> Text
86textKey :: DKey a -> Text
93textKey = \case
87textKey = \case
@@ -155,8 +149,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
155 el "div" $ do
149 el "div" $ do
156 el "span" $ text "hello world"
150 el "span" $ text "hello world"
159− it "updates after postBuild" $ do
152+ it "updates after postBuild" $ do -- TODO I think these two tests are broken
160 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
153 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
161 after <- delay 0 =<< getPostBuild
154 after <- delay 0 =<< getPostBuild
162 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
155 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
@@ -171,14 +164,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
171 WD.click =<< WD.findElem (WD.ByTag "button")
164 WD.click =<< WD.findElem (WD.ByTag "button")
172 liftIO $ threadDelay 100000 -- wait for update
165 liftIO $ threadDelay 100000 -- wait for update
173 checkBodyText "after"
166 checkBodyText "after"
174− testWidget (pure ()) checkUpdated $ prerender (pure ()) $ do
167+ testWidget (pure ()) checkUpdated $ prerender_ (pure ()) $ do
175 click <- button ""
168 click <- button ""
176 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
169 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
178− it "works when given differing results of prerender" $ do
179− testWidgetStatic (pure ()) $ do
180− text =<< prerender (pure "One") (pure "Two")
182 describe "element" $ do
171 describe "element" $ do
183 it "works with domEvent Click" $ do
172 it "works with domEvent Click" $ do
184 clickedRef <- newIORef False
173 clickedRef <- newIORef False
@@ -194,10 +183,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
194 WD.findElem (WD.ById "first") >>= WD.click
183 WD.findElem (WD.ById "first") >>= WD.click
195 WD.findElem (WD.ById "second") >>= WD.click
184 WD.findElem (WD.ById "second") >>= WD.click
196 testWidget (pure ()) clickBoth $ do
185 testWidget (pure ()) clickBoth $ do
197− (firstDivEl, _) <- el' "div" $ prerender (pure ()) $ do
186+ (firstDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
198 void $ elAttr "span" ("id" =: "first") $ text "hello world"
187 void $ elAttr "span" ("id" =: "first") $ text "hello world"
199 performEvent_ $ liftIO (writeIORef firstClickedRef True) <$ domEvent Click firstDivEl
188 performEvent_ $ liftIO (writeIORef firstClickedRef True) <$ domEvent Click firstDivEl
200− (secondDivEl, _) <- el' "div" $ prerender (pure ()) $ do
189+ (secondDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
201 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
190 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
202 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
191 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
203 & initialAttributes .~ "id" =: "second"
192 & initialAttributes .~ "id" =: "second"
@@ -214,14 +203,13 @@ main = hspec $ beforeAll startSeleniumServer $ do
214 WD.click e
203 WD.click e
215 s1 <- WD.isSelected e
204 s1 <- WD.isSelected e
216 pure (s0, s1)
205 pure (s0, s1)
217− clicked <- testWidget (pure ()) click $ prerender (pure ()) $ do
206+ clicked <- testWidget (pure ()) click $ prerender_ (pure ()) $ do
218 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
207 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
219 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
208 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
220 & elementConfig_eventSpec .~ (addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> preventDefault) def)
209 & elementConfig_eventSpec .~ (addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> preventDefault) def)
221 & initialAttributes .~ "type" =: "checkbox"
210 & initialAttributes .~ "type" =: "checkbox"
222 void $ element "input" conf $ text "hello world"
211 void $ element "input" conf $ text "hello world"
223 assertEqual "Click not prevented" (False, False) clicked
212 assertEqual "Click not prevented" (False, False) clicked
225 it "can add/update/remove attributes" $ do
213 it "can add/update/remove attributes" $ do
226 let checkInitialAttrs = do
214 let checkInitialAttrs = do
227 e <- WD.findElem $ WD.ByTag "div"
215 e <- WD.findElem $ WD.ByTag "div"
@@ -244,7 +232,6 @@ main = hspec $ beforeAll startSeleniumServer $ do
244 (e, ()) <- element "div" conf $ text "hello world"
232 (e, ()) <- element "div" conf $ text "hello world"
245 let click = domEvent Click e
233 let click = domEvent Click e
246 return ()
234 return ()
248 -- TODO check this is the correct solution
235 -- TODO check this is the correct solution
249 it "has ssr attribute, removes ssr attribute" $ do
236 it "has ssr attribute, removes ssr attribute" $ do
250 let checkSSRAttr = do
237 let checkSSRAttr = do
@@ -253,27 +240,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
254 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
241 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
256− it "can't misuse raw elements" $ do
257− clicked <- newIORef False
259− e <- WD.findElem $ WD.ByTag "div"
260− liftIO $ readIORef clicked >>= flip shouldBe True
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
273 describe "inputElement" $ do
243 describe "inputElement" $ do
274 describe "hydration" $ do
244 describe "hydration" $ do
275 it "doesn't wipe user input when switching over" $ do
245 it "doesn't wipe user input when switching over" $ do
276− inputRef <- newIORef ""
246+ inputRef <- newIORef ("" :: Text)
277 testWidget'
247 testWidget'
279 e <- WD.findElem $ WD.ByTag "input"
249 e <- WD.findElem $ WD.ByTag "input"
@@ -290,7 +260,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
290 click <- button "save"
260 click <- button "save"
291 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
261 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
292 it "captures user input after switchover" $ do
262 it "captures user input after switchover" $ do
293− inputRef <- newIORef ""
263+ inputRef <- newIORef ("" :: Text)
294 let checkValue = do
264 let checkValue = do
295 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
265 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
296 WD.click <=< WD.findElem $ WD.ByTag "button"
266 WD.click <=< WD.findElem $ WD.ByTag "button"
@@ -325,8 +295,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
325 e <- inputElement def
295 e <- inputElement def
326 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
296 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
327 it "sets value appropriately" $ do
297 it "sets value appropriately" $ do
328− valueByUIRef <- newIORef ""
298+ valueByUIRef <- newIORef ("" :: Text)
329− valueRef <- newIORef ""
299+ valueRef <- newIORef ("" :: Text)
330 setValueChan :: Chan Text <- newChan
300 setValueChan :: Chan Text <- newChan
331 let checkValue = do
301 let checkValue = do
332 liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
302 liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
@@ -342,8 +312,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
342 readIORef valueByUIRef >>= flip shouldBe "hello"
312 readIORef valueByUIRef >>= flip shouldBe "hello"
343 readIORef valueRef >>= flip shouldBe "world"
313 readIORef valueRef >>= flip shouldBe "world"
344 testWidget (pure ()) checkValue $ do
314 testWidget (pure ()) checkValue $ do
345− setValue <- triggerEventWithChan setValueChan
315+ update <- triggerEventWithChan setValueChan
346− e <- inputElement $ def & inputElementConfig_setValue .~ setValue
316+ e <- inputElement $ def & inputElementConfig_setValue .~ update
347 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
317 performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
348 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
318 performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
349 it "sets checked appropriately" $ do
319 it "sets checked appropriately" $ do
@@ -384,7 +354,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
384 testWidget (pure ()) uploadFile $ do
354 testWidget (pure ()) uploadFile $ do
385 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
355 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
386 click <- button "save"
356 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
388 names <- liftJSM $ traverse File.getName fs
358 names <- liftJSM $ traverse File.getName fs
389 liftIO $ writeIORef filesRef names
359 liftIO $ writeIORef filesRef names
@@ -396,7 +366,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
396 WD.click <=< WD.findElem $ WD.ByTag "button"
366 WD.click <=< WD.findElem $ WD.ByTag "button"
397 input <- liftIO $ readIORef inputRef
367 input <- liftIO $ readIORef inputRef
398 liftIO $ input `shouldBe` "hello world"
368 liftIO $ input `shouldBe` "hello world"
399− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
369+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
400 e <- inputElement def
370 e <- inputElement def
401 click <- button "save"
371 click <- button "save"
402 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
372 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
@@ -408,7 +378,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
408 WD.click e
378 WD.click e
409 liftIO $ threadDelay 100000
379 liftIO $ threadDelay 100000
410 liftIO $ readIORef focusRef >>= flip shouldBe True
380 liftIO $ readIORef focusRef >>= flip shouldBe True
411− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
381+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
412 e <- inputElement def
382 e <- inputElement def
413 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
383 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
414 it "sets value appropriately" $ do
384 it "sets value appropriately" $ do
@@ -428,11 +398,12 @@ main = hspec $ beforeAll startSeleniumServer $ do
428 threadDelay 100000
398 threadDelay 100000
429 readIORef valueByUIRef >>= flip shouldBe "hello"
399 readIORef valueByUIRef >>= flip shouldBe "hello"
430 readIORef valueRef >>= flip shouldBe "world"
400 readIORef valueRef >>= flip shouldBe "world"
431− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
401+ testWidget (pure ()) checkValue $ do
432− setValue <- triggerEventWithChan setValueChan
402+ update <- triggerEventWithChan setValueChan
403+ prerender_ (pure ()) $ do
433− e <- inputElement $ def & inputElementConfig_setValue .~ setValue
404+ e <- inputElement $ def & inputElementConfig_setValue .~ update
434− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
405+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
435− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
406+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
436 it "sets checked appropriately" $ do
407 it "sets checked appropriately" $ do
437 checkedByUIRef <- newIORef False
408 checkedByUIRef <- newIORef False
438 checkedRef <- newIORef False
409 checkedRef <- newIORef False
@@ -451,13 +422,14 @@ main = hspec $ beforeAll startSeleniumServer $ do
451 threadDelay 100000
422 threadDelay 100000
452 readIORef checkedByUIRef >>= flip shouldBe True
423 readIORef checkedByUIRef >>= flip shouldBe True
453 readIORef checkedRef >>= flip shouldBe False
424 readIORef checkedRef >>= flip shouldBe False
454− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
425+ testWidget (pure ()) checkValue $ do
455 setChecked <- triggerEventWithChan setCheckedChan
426 setChecked <- triggerEventWithChan setCheckedChan
427+ prerender_ (pure ()) $ do
456− e <- inputElement $ def
428+ e <- inputElement $ def
457− & initialAttributes .~ "type" =: "checkbox"
429+ & initialAttributes .~ "type" =: "checkbox"
458− & inputElementConfig_setChecked .~ setChecked
430+ & inputElementConfig_setChecked .~ setChecked
459− performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
431+ performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
460− performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
432+ performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
461 it "captures file uploads" $ do
433 it "captures file uploads" $ do
462 filesRef :: IORef [Text] <- newIORef []
434 filesRef :: IORef [Text] <- newIORef []
463 let uploadFile = do
435 let uploadFile = do
@@ -468,17 +440,17 @@ main = hspec $ beforeAll startSeleniumServer $ do
468 liftIO $ removeFile path
440 liftIO $ removeFile path
469 input <- liftIO $ readIORef filesRef
441 input <- liftIO $ readIORef filesRef
470 liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
442 liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
471− testWidget (pure ()) uploadFile $ prerender (pure ()) $ do
443+ testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
472 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
444 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
473 click <- button "save"
445 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
475 names <- liftJSM $ traverse File.getName fs
447 names <- liftJSM $ traverse File.getName fs
476 liftIO $ writeIORef filesRef names
448 liftIO $ writeIORef filesRef names
478 describe "textAreaElement" $ do
450 describe "textAreaElement" $ do
479 describe "hydration" $ do
451 describe "hydration" $ do
480 it "doesn't wipe user input when switching over" $ do
452 it "doesn't wipe user input when switching over" $ do
481− inputRef <- newIORef ""
453+ inputRef <- newIORef ("" :: Text)
482 testWidget'
454 testWidget'
484 e <- WD.findElem $ WD.ByTag "textarea"
456 e <- WD.findElem $ WD.ByTag "textarea"
@@ -495,7 +467,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
495 click <- button "save"
467 click <- button "save"
496 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
468 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
497 it "captures user input after switchover" $ do
469 it "captures user input after switchover" $ do
498− inputRef <- newIORef ""
470+ inputRef <- newIORef ("" :: Text)
499 let checkValue = do
471 let checkValue = do
500 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
472 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
501 WD.click <=< WD.findElem $ WD.ByTag "button"
473 WD.click <=< WD.findElem $ WD.ByTag "button"
@@ -560,7 +532,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
560 WD.click <=< WD.findElem $ WD.ByTag "button"
532 WD.click <=< WD.findElem $ WD.ByTag "button"
561 input <- liftIO $ readIORef inputRef
533 input <- liftIO $ readIORef inputRef
562 liftIO $ input `shouldBe` "hello world"
534 liftIO $ input `shouldBe` "hello world"
563− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
535+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
564 e <- textAreaElement def
536 e <- textAreaElement def
565 click <- button "save"
537 click <- button "save"
566 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
538 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
@@ -572,7 +544,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
572 WD.click e
544 WD.click e
573 liftIO $ threadDelay 100000
545 liftIO $ threadDelay 100000
574 liftIO $ readIORef focusRef >>= flip shouldBe True
546 liftIO $ readIORef focusRef >>= flip shouldBe True
575− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
547+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
576 e <- textAreaElement def
548 e <- textAreaElement def
577 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_textAreaElement_hasFocus e)
549 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_textAreaElement_hasFocus e)
578 it "sets value appropriately" $ do
550 it "sets value appropriately" $ do
@@ -592,11 +564,12 @@ main = hspec $ beforeAll startSeleniumServer $ do
592 threadDelay 100000
564 threadDelay 100000
593 readIORef valueByUIRef >>= flip shouldBe "hello"
565 readIORef valueByUIRef >>= flip shouldBe "hello"
594 readIORef valueRef >>= flip shouldBe "world"
566 readIORef valueRef >>= flip shouldBe "world"
595− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
567+ testWidget (pure ()) checkValue $ do
596 setValue' <- triggerEventWithChan setValueChan
568 setValue' <- triggerEventWithChan setValueChan
569+ prerender_ (pure ()) $ do
597− e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
570+ e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
598− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e
571+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e
599− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
572+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
601 describe "selectElement" $ do
574 describe "selectElement" $ do
602 let options :: DomBuilder t m => m ()
575 let options :: DomBuilder t m => m ()
@@ -606,7 +579,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
606 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
579 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
607 describe "hydration" $ do
580 describe "hydration" $ do
608 it "sets initial value correctly" $ do
581 it "sets initial value correctly" $ do
609− inputRef <- newIORef ""
582+ inputRef <- newIORef ("" :: Text)
610 let setup = do
583 let setup = do
611 e <- WD.findElem $ WD.ByTag "select"
584 e <- WD.findElem $ WD.ByTag "select"
612 assertAttr e "value" (Just "three")
585 assertAttr e "value" (Just "three")
@@ -624,7 +597,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
624 liftIO . writeIORef inputRef <=< sample $ current $ _selectElement_value e
597 liftIO . writeIORef inputRef <=< sample $ current $ _selectElement_value e
625 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
598 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
626 it "captures user input after switchover" $ do
599 it "captures user input after switchover" $ do
627− inputRef <- newIORef ""
600+ inputRef <- newIORef ("" :: Text)
628 let checkValue = do
601 let checkValue = do
629 e <- WD.findElem $ WD.ByTag "select"
602 e <- WD.findElem $ WD.ByTag "select"
630 assertAttr e "value" (Just "one")
603 assertAttr e "value" (Just "one")
@@ -691,7 +664,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
691 WD.click <=< WD.findElem $ WD.ById "two"
664 WD.click <=< WD.findElem $ WD.ById "two"
692 WD.click <=< WD.findElem $ WD.ByTag "button"
665 WD.click <=< WD.findElem $ WD.ByTag "button"
693 liftIO $ readIORef inputRef >>= flip shouldBe "two"
666 liftIO $ readIORef inputRef >>= flip shouldBe "two"
694− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
667+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
695 (e, ()) <- selectElement def options
668 (e, ()) <- selectElement def options
696 click <- button "save"
669 click <- button "save"
697 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
670 performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
@@ -703,7 +676,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
703 WD.click e
676 WD.click e
704 liftIO $ threadDelay 100000
677 liftIO $ threadDelay 100000
705 liftIO $ readIORef focusRef >>= flip shouldBe True
678 liftIO $ readIORef focusRef >>= flip shouldBe True
706− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
679+ testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
707 (e, ()) <- selectElement def options
680 (e, ()) <- selectElement def options
708 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_selectElement_hasFocus e)
681 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_selectElement_hasFocus e)
709 it "sets value appropriately" $ do
682 it "sets value appropriately" $ do
@@ -722,116 +695,36 @@ main = hspec $ beforeAll startSeleniumServer $ do
722 threadDelay 100000
695 threadDelay 100000
723 readIORef valueByUIRef >>= flip shouldBe "two"
696 readIORef valueByUIRef >>= flip shouldBe "two"
724 readIORef valueRef >>= flip shouldBe "three"
697 readIORef valueRef >>= flip shouldBe "three"
725− testWidget (pure ()) checkValue $ prerender (pure ()) $ do
698+ testWidget (pure ()) checkValue $ do
726 setValue' <- triggerEventWithChan setValueChan
699 setValue' <- triggerEventWithChan setValueChan
700+ prerender_ (pure ()) $ do
727− (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
701+ (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
728− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e
702+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e
729− performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)
703+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)
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
739− describe "placeRawElement" $ 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
746− prerender (pure ()) $ placeRawElement =<< createRawElement
748− it "is placed correctly in the DOM in immediate mode" $ do
749− testWidget (pure ()) checkOrder $ prerender (pure ()) $ do
751− placeRawElement =<< createRawElement
753− it "is placed correctly in the DOM in hydration mode" $ do
754− testWidget (pure ()) checkOrder $ do
756− mElement <- prerender (pure Nothing) $ Just <$> createRawElement
757− traverse_ placeRawElement mElement
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
765− let htmlElement = DOM.uncheckedCastTo DOM.HTMLElement raw
766− liftJSM $ htmlElement `EventM.on` Events.click $ do
767− liftIO $ writeIORef clickedRef True
769− clicked <- readIORef clickedRef
770− assertEqual "Not clicked" True clicked
772− describe "wrapRawElement" $ do
773− it "modifies attributes" $ do
774− modifyAttrsChan :: Chan (Map AttributeName (Maybe Text)) <- newChan
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
784− wrapRawElement raw $ RawElementConfig
785− { _rawElementConfig_modifyAttributes = Just modifyAttrs
786− , _rawElementConfig_eventSpec = (def :: EventSpec GhcjsDomSpace EventResult)
789− it "works with eventFlags" $ do
790− clickedRef <- newIORef False
792− liftIO $ readIORef clickedRef >>= flip shouldBe False
793− WD.findElem (WD.ById "normal") >>= WD.click
795− readIORef clickedRef >>= flip shouldBe True
796− writeIORef clickedRef False
797− WD.findElem (WD.ById "raw") >>= WD.click
800− readIORef clickedRef >>= flip shouldBe False
801− testWidget (pure ()) clickBoth $ prerender (pure ()) $ do
802− (e, _) <- el' "div" $ do
803− raw <- createRawElement
805− wrapRawElement raw $ RawElementConfig
806− { _rawElementConfig_modifyAttributes = Nothing
807− , _rawElementConfig_eventSpec = addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> stopPropagation) (def :: EventSpec GhcjsDomSpace EventResult)
809− elAttr "div" ("id" =: "normal") $ text "normal"
810− performEvent_ $ liftIO (writeIORef clickedRef True) <$ domEvent Click e
812 describe "prerender" $ do
705 describe "prerender" $ do
813 it "works in simple case" $ do
706 it "works in simple case" $ do
814 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
707 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
815− prerender (text "One") (text "Two")
708+ prerender_ (text "One") (text "Two")
816 it "removes element correctly" $ do
709 it "removes element correctly" $ do
817 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
710 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
818− prerender (el "span" $ text "One") (text "Two")
711+ prerender_ (el "span" $ text "One") (text "Two")
819 it "can be nested in server widget" $ do
712 it "can be nested in server widget" $ do
820 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
713 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
821− prerender (prerender (text "One") (text "Two")) (text "Three")
714+ prerender_ (prerender_ (text "One") (text "Two")) (text "Three")
822 it "can be nested in client widget" $ do
715 it "can be nested in client widget" $ do
823 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
716 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
824− prerender (text "One") (prerender (text "Two") (text "Three"))
717+ prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
825− it "works with prerender siblings" $ do
718+ it "works with prerender_ siblings" $ do
826 testWidget
719 testWidget
827 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
720 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
828 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
721 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
829− prerender (divId "a1" $ text "One") (divId "a2" $ text "Two")
722+ prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
830− prerender (divId "b1" $ text "Three") (divId "b2" $ text "Four")
723+ prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
831− prerender (divId "c1" $ text "Five") (divId "c2" $ text "Six")
724+ prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
832 it "works inside other element" $ do
725 it "works inside other element" $ do
833 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
726 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
834− el "div" $ prerender (text "One") (text "Two")
727+ el "div" $ prerender_ (text "One") (text "Two")
835 it "places fences and removes them" $ do
728 it "places fences and removes them" $ do
836 testWidget'
729 testWidget'
@@ -839,25 +732,47 @@ main = hspec $ beforeAll startSeleniumServer $ do
839 filterM (\s -> maybe False (\t -> "prerender" `T.isPrefixOf` t) <$> WD.attr s "type") scripts
732 filterM (\s -> maybe False (\t -> "prerender" `T.isPrefixOf` t) <$> WD.attr s "type") scripts
841 (traverse_ elementShouldBeRemoved)
734 (traverse_ elementShouldBeRemoved)
842− (el "span" $ prerender (text "One") (text "Two"))
735+ (el "span" $ prerender_ (text "One") (text "Two"))
843−-- it "postBuild works on server side" $ do
736+ it "postBuild works on server side" $ do
844−-- pbRef <- newIORef False
737+ lock :: MVar () <- newEmptyMVar
845−-- testWidgetStatic (pure ()) $ do
738+ testWidget (liftIO $ takeMVar lock) (pure ()) $ do
846−-- prerender (do
739+ prerender_ (do
847−-- pb <- getPostBuild
740+ pb <- getPostBuild
848−-- performEvent_ $ liftIO (writeIORef pbRef True) <$ pb) blank
741+ performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
849−-- readIORef pbRef >>= (`shouldBe` True)
850 it "postBuild works on client side" $ do
742 it "postBuild works on client side" $ do
851− pbRef <- newIORef False
743+ lock :: MVar () <- newEmptyMVar
852− testWidgetStatic (pure ()) $ do
744+ testWidget (pure ()) (liftIO $ takeMVar lock) $ do
853− prerender blank $ do
745+ prerender_ blank $ do
854 pb <- getPostBuild
746 pb <- getPostBuild
855− performEvent_ $ liftIO (writeIORef pbRef True) <$ pb
747+ performEvent_ $ liftIO (putMVar lock ()) <$ pb
856− readIORef pbRef >>= (`shouldBe` True)
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")
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
858 describe "runWithReplace" $ do
773 describe "runWithReplace" $ do
859 it "works" $ do
774 it "works" $ do
860− replaceChan <- newChan
775+ replaceChan :: Chan Text <- newChan
861 let setup = WD.findElem $ WD.ByTag "div"
776 let setup = WD.findElem $ WD.ByTag "div"
862 check ssr = do
777 check ssr = do
863 -- Check that the original element still exists and has the correct text
778 -- Check that the original element still exists and has the correct text
@@ -870,13 +785,12 @@ main = hspec $ beforeAll startSeleniumServer $ do
870 testWidget' setup check $ do
785 testWidget' setup check $ do
871 replace <- triggerEventWithChan replaceChan
786 replace <- triggerEventWithChan replaceChan
872 pb <- getPostBuild
787 pb <- getPostBuild
873− runWithReplace (el "div" $ text "one") $ leftmost
788+ void $ runWithReplace (el "div" $ text "one") $ leftmost
874 [ el "div" (text "two") <$ pb
789 [ el "div" (text "two") <$ pb
875 , el "span" . text <$> replace
790 , el "span" . text <$> replace
878 it "can be nested in initial widget" $ do
792 it "can be nested in initial widget" $ do
879− replaceChan <- newChan
793+ replaceChan :: Chan Text <- newChan
880 let setup = WD.findElem $ WD.ByTag "div"
794 let setup = WD.findElem $ WD.ByTag "div"
881 check ssr = do
795 check ssr = do
882 -- Check that the original element still exists and has the correct text
796 -- Check that the original element still exists and has the correct text
@@ -889,11 +803,10 @@ main = hspec $ beforeAll startSeleniumServer $ do
889 testWidget' setup check $ void $ flip runWithReplace never $ do
803 testWidget' setup check $ void $ flip runWithReplace never $ do
890 replace <- triggerEventWithChan replaceChan
804 replace <- triggerEventWithChan replaceChan
891 pb <- getPostBuild
805 pb <- getPostBuild
892− runWithReplace (el "div" $ text "one") $ leftmost
806+ void $ runWithReplace (el "div" $ text "one") $ leftmost
893 [ el "div" (text "two") <$ pb
807 [ el "div" (text "two") <$ pb
894 , el "span" . text <$> replace
808 , el "span" . text <$> replace
897 it "can be nested in postBuild widget" $ do
810 it "can be nested in postBuild widget" $ do
898 replaceChan <- newChan
811 replaceChan <- newChan
899 let setup = WD.findElem $ WD.ByTag "div"
812 let setup = WD.findElem $ WD.ByTag "div"
@@ -909,20 +822,34 @@ main = hspec $ beforeAll startSeleniumServer $ do
909 pb <- getPostBuild
822 pb <- getPostBuild
910 runWithReplace (pure ()) $ ffor pb $ \() -> do
823 runWithReplace (pure ()) $ ffor pb $ \() -> do
911 replace <- triggerEventWithChan replaceChan
824 replace <- triggerEventWithChan replaceChan
912− pb <- getPostBuild
825+ pb' <- getPostBuild
913− runWithReplace (el "div" $ text "one") $ leftmost
826+ void $ runWithReplace (el "div" $ text "one") $ leftmost
914− [ el "div" (text "two") <$ pb
827+ [ el "div" (text "two") <$ pb'
915 , el "span" . text <$> replace
828 , el "span" . text <$> replace
917− return ()
830+ it "postBuild works in replaced widget" $ do
831+ replaceChan <- newChan
832+ pbLock <- newEmptyMVar
835+ writeChan replaceChan ()
838+ testWidget (pure ()) check $ void $ do
839+ replace <- triggerEventWithChan replaceChan
840+ runWithReplace (pure ()) $ ffor replace $ \() -> do
842+ performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
918− it "can be nested in event widget" $ do
843+ it "can be nested in event widget" $ do -- Test is broken, I think
919− replaceChan1 <- newChan
844+ replaceChan1 :: Chan Text <- newChan
920− replaceChan2 <- newChan
845+ replaceChan2 :: Chan Text <- newChan
846+ lock :: MVar () <- newEmptyMVar
921 let check = do
847 let check = do
922 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
848 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
923 liftIO $ do
849 liftIO $ do
924 writeChan replaceChan1 "one"
850 writeChan replaceChan1 "one"
925 threadDelay 100000
851 threadDelay 100000
926 one <- WD.findElem $ WD.ByTag "div"
853 one <- WD.findElem $ WD.ByTag "div"
927 WD.getText one >>= liftIO . flip shouldBe "pb"
854 WD.getText one >>= liftIO . flip shouldBe "pb"
928 liftIO $ do
855 liftIO $ do
@@ -935,11 +862,11 @@ main = hspec $ beforeAll startSeleniumServer $ do
935 runWithReplace (pure ()) $ ffor replace1 $ \r1 -> do
862 runWithReplace (pure ()) $ ffor replace1 $ \r1 -> do
936 replace2 <- triggerEventWithChan replaceChan2
863 replace2 <- triggerEventWithChan replaceChan2
937 pb <- getPostBuild
864 pb <- getPostBuild
865+ performEvent_ $ liftIO (putMVar lock ()) <$ pb
938− runWithReplace (el "div" $ text r1) $ leftmost
866+ void $ runWithReplace (el "div" $ text r1) $ leftmost
939 [ el "span" . text <$> replace2
867 [ el "span" . text <$> replace2
940 , el "div" (text "pb") <$ pb
868 , el "div" (text "pb") <$ pb
943 it "works in immediate mode (RHS of prerender)" $ do
870 it "works in immediate mode (RHS of prerender)" $ do
944 replaceChan :: Chan Text <- newChan
871 replaceChan :: Chan Text <- newChan
945 let check = do
872 let check = do
@@ -952,9 +879,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
952 elementShouldBeRemoved one
879 elementShouldBeRemoved one
953 shouldContainText "pb" =<< WD.findElem (WD.ByTag "span")
880 shouldContainText "pb" =<< WD.findElem (WD.ByTag "span")
954 testWidget (pure ()) check $ void $ do
881 testWidget (pure ()) check $ void $ do
955− prerender blank $ do
956− replace <- triggerEventWithChan replaceChan
882+ replace <- triggerEventWithChan replaceChan
957− pb <- getPostBuild
883+ prerender_ blank $ do
958 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
884 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
959 it "works with postBuild in immediate mode (RHS of prerender)" $ do
885 it "works with postBuild in immediate mode (RHS of prerender)" $ do
960 replaceChan :: Chan Text <- newChan
886 replaceChan :: Chan Text <- newChan
@@ -968,8 +894,8 @@ main = hspec $ beforeAll startSeleniumServer $ do
968 elementShouldBeRemoved two
894 elementShouldBeRemoved two
969 shouldContainText "three" =<< WD.findElem (WD.ByTag "span")
895 shouldContainText "three" =<< WD.findElem (WD.ByTag "span")
970 testWidget (pure ()) check $ void $ do
896 testWidget (pure ()) check $ void $ do
971− prerender blank $ do
972− replace <- triggerEventWithChan replaceChan
897+ replace <- triggerEventWithChan replaceChan
898+ prerender_ blank $ do
973 pb <- getPostBuild
899 pb <- getPostBuild
974 void $ runWithReplace (el "div" $ text "one") $ leftmost
900 void $ runWithReplace (el "div" $ text "one") $ leftmost
975 [ el "div" (text "two") <$ pb
901 [ el "div" (text "two") <$ pb
@@ -977,7 +903,7 @@ main = hspec $ beforeAll startSeleniumServer $ do
979 describe "traverseDMapWithKeyWithAdjust" $ do
905 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)
981 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
907 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
982 elClass "span" "key" $ text $ textKey k
908 elClass "span" "key" $ text $ textKey k
983 elClass "span" "value" $ text $ T.pack $ has @Show k $ show v
909 elClass "span" "value" $ text $ T.pack $ has @Show k $ show v
@@ -1041,17 +967,19 @@ main = hspec $ beforeAll startSeleniumServer $ do
1041 it "can delete/update/insert when built in prerender" $ do
967 it "can delete/update/insert when built in prerender" $ do
1042 chan <- newChan
968 chan <- newChan
1043 let check = do
969 let check = do
1044− getAndCheckInitialItems keyMap
970+ _ <- getAndCheckInitialItems keyMap
1045 checkRemoval chan Key_Int
971 checkRemoval chan Key_Int
1046 checkReplace chan Key_Char 'B'
972 checkReplace chan Key_Char 'B'
1047 checkInsert chan Key_Bool True
973 checkInsert chan Key_Bool True
1048− testWidget (pure ()) check $ prerender (pure ()) $ void $ do
974+ testWidget (pure ()) check $ do
975+ replace <- triggerEventWithChan chan
976+ prerender_ (pure ()) $ do
1049− (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
977+ (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
1050− liftIO $ dmap `shouldBe` keyMap
978+ liftIO $ dmap `shouldBe` keyMap
1051 it "can delete/update/insert when built in immediate mode" $ do
979 it "can delete/update/insert when built in immediate mode" $ do
1052 chan <- newChan
980 chan <- newChan
1053 let check = do
981 let check = do
1054− getAndCheckInitialItems keyMap
982+ _ <- getAndCheckInitialItems keyMap
1055 checkRemoval chan Key_Int
983 checkRemoval chan Key_Int
1056 checkReplace chan Key_Char 'B'
984 checkReplace chan Key_Char 'B'
1057 checkInsert chan Key_Bool True
985 checkInsert chan Key_Bool True
@@ -1064,13 +992,13 @@ main = hspec $ beforeAll startSeleniumServer $ do
1064 it "handles postBuild correctly in prerender" $ do
992 it "handles postBuild correctly in prerender" $ do
1065 chan <- newChan
993 chan <- newChan
1066 let check = do
994 let check = do
1067− getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
995+ _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
1068 checkRemoval chan Key_Int
996 checkRemoval chan Key_Int
1069 checkInsert chan Key_Char 'B'
997 checkInsert chan Key_Char 'B'
1070 checkReplace chan Key_Bool True
998 checkReplace chan Key_Bool True
1071 testWidget (pure ()) check $ do
999 testWidget (pure ()) check $ do
1072 replace <- triggerEventWithChan chan
1000 replace <- triggerEventWithChan chan
1073− prerender (pure ()) $ void $ do
1001+ prerender_ (pure ()) $ void $ do
1074 pb <- getPostBuild
1002 pb <- getPostBuild
1075 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1003 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1076 liftIO $ dmap `shouldBe` keyMap
1004 liftIO $ dmap `shouldBe` keyMap
@@ -1085,10 +1013,10 @@ startSeleniumServer = do
1085 _ <- forkIO $ print =<< waitForProcess ph
1013 _ <- forkIO $ print =<< waitForProcess ph
1086 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
1014 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
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)
1089triggerEventWithChan chan = do
1017triggerEventWithChan chan = do
1090 (e, trigger) <- newTriggerEvent
1018 (e, trigger) <- newTriggerEvent
1091− prerender (pure ()) $ void $ liftIO $ forkIO $ forever $ trigger =<< readChan chan
1019+ prerender_ (pure ()) $ void $ liftIO $ forkIO $ forever $ trigger =<< readChan chan
1094assertAttr :: WD.Element -> Text -> Maybe Text -> WD ()
1022assertAttr :: WD.Element -> Text -> Maybe Text -> WD ()
@@ -1098,7 +1026,7 @@ elementShouldBeRemoved :: WD.Element -> WD ()
1098elementShouldBeRemoved e = do
1026elementShouldBeRemoved e = do
1099 try (WD.getText e) >>= \case
1027 try (WD.getText e) >>= \case
1100 Left (WD.FailedCommand WD.StaleElementReference _) -> return ()
1028 Left (WD.FailedCommand WD.StaleElementReference _) -> return ()
1101− Left e -> throwM e
1029+ Left err -> throwM err
1102 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
1030 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
1104shouldContainText :: Text -> WD.Element -> WD ()
1032shouldContainText :: Text -> WD.Element -> WD ()
@@ -1108,7 +1036,7 @@ checkBodyText :: Text -> WD ()
1108checkBodyText = checkTextInTag "body"
1036checkBodyText = checkTextInTag "body"
1110checkTextInTag :: Text -> Text -> WD ()
1038checkTextInTag :: 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
1113checkTextInId :: Text -> Text -> WD ()
1041checkTextInId :: Text -> Text -> WD ()
1114checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expected
1042checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expected
@@ -1116,7 +1044,7 @@ checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expecte
1116divId :: DomBuilder t m => Text -> m a -> m a
1044divId :: DomBuilder t m => Text -> m a -> m a
1117divId i = elAttr "div" ("id" =: i)
1045divId i = elAttr "div" ("id" =: i)
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)
1121testWidgetStatic
1049testWidgetStatic