@@ -1,4 +1,7 @@
11{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE StandaloneDeriving #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE UndecidableInstances #-}
25{-# LANGUAGE ConstraintKinds #-}
36{-# LANGUAGE CPP #-}
47{-# LANGUAGE FlexibleContexts #-}
@@ -45,9 +48,11 @@ import System.IO (stderr)
4548import System.IO.Silently
4649import System.IO.Temp
4750import System.Process
48−import System.Timeout
49−import Test.HUnit (assertEqual, assertFailure)
50−import Test.Hspec (Spec, parallel, hspec, it, describe, shouldBe)
51+import System.Timeout.Lifted
52+import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
53+import qualified Test.Hspec as H
54+import Test.Hspec.WebDriver hiding (runWD)
55+import qualified Test.Hspec.WebDriver as WD
5156import Test.WebDriver (WD)
5257
5358import qualified Data.ByteString.Lazy as LBS
@@ -59,6 +64,16 @@ import qualified GHCJS.DOM.File as File
5964import qualified Network.Wai.Handler.Warp as Warp
6065import qualified System.FilePath as FilePath
6166import qualified Test.WebDriver as WD
67+import qualified Test.WebDriver.Capabilities as WD
68+
69+-- TODO Remove orphan
70+deriving instance MonadRef WD
71+
72+assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
73+assertEqual a b = liftIO . HUnit.assertEqual a b
74+
75+assertFailure :: MonadIO m => String -> m ()
76+assertFailure = liftIO . HUnit.assertFailure
6277
6378testTimeLimit :: Int
6479testTimeLimit = 5 * 1000 * 1000
@@ -108,24 +123,30 @@ instance EqTag DKey Identity where
108123 eqTagged Key_Bool Key_Bool = (==)
109124
110125main :: IO ()
111−main = withSeleniumServer $ \selenium ->
112− hspec (parallel (tests selenium)) `finally` _selenium_stopServer selenium
126+main = withSeleniumServer $ \selenium -> do
127+ browserPath <- liftIO $ T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""
128+ when (T.null browserPath) $ fail "No browser found"
129+ let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
130+ chromeCaps' = WD.getCaps $ chromeConfig browserPath
131+ hspec (tests wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium
113132
114−tests :: Selenium -> Spec
115−tests _selenium = do
116− describe "text" $ do
117− it "works" $ do
133+tests :: WD.WDConfig -> [Capabilities] -> Selenium -> Spec
134+tests wdConfig caps _selenium = do
135+ let session' = sessionWith wdConfig "" . using (map (flip (,) "") caps)
136+ runWD = runWDOptions (WdOptions False)
137+ describe "text" $ session' $ do
138+ it "works" $ runWD $ do
118139 testWidgetStatic (checkBodyText "hello world") $ do
119140 text "hello world"
120− it "works with postBuild" $ do
141+ it "works with postBuild" $ runWD $ do
121142 testWidgetStatic (checkBodyText "pb") $ do
122143 pb <- getPostBuild
123144 void $ textNode $ TextNodeConfig "" $ Just $ "pb" <$ pb
124− it "works for adjacent text nodes" $ do
145+ it "works for adjacent text nodes" $ runWD $ do
125146 testWidgetStatic (checkBodyText "hello world") $ do
126147 text "hello "
127148 text "world"
128− it "works for empty adjacent text nodes" $ do
149+ it "works for empty adjacent text nodes" $ runWD $ do
129150 testWidgetStatic (checkBodyText "hello world") $ do
130151 pb <- getPostBuild
131152 text ""
@@ -134,37 +155,37 @@ tests _selenium = do
134155 _ <- textNode $ TextNodeConfig "abc" $ Just $ "" <$ pb
135156 _ <- textNode $ TextNodeConfig "" $ Just $ "world" <$ pb
136157 text ""
137− it "works when empty text nodes are the only children of an element" $ do
158+ it "works when empty text nodes are the only children of an element" $ runWD $ do
138159 testWidgetStatic (checkBodyText "hello world") $ do
139160 el "div" $ do
140161 text ""
141162 text ""
142163 text "hello world"
143− it "works when an empty text node is the first child before text" $ do
164+ it "works when an empty text node is the first child before text" $ runWD $ do
144165 testWidgetStatic (checkTextInTag "div" "hello world") $ do
145166 el "div" $ do
146167 text ""
147168 text "hello world"
148− it "works when an empty text node is the first child before element" $ do
169+ it "works when an empty text node is the first child before element" $ runWD $ do
149170 testWidgetStatic (checkTextInTag "div" "hello world") $ do
150171 el "div" $ do
151172 text ""
152173 el "span" $ text "hello world"
153− it "works when an empty text node is the last child" $ do
174+ it "works when an empty text node is the last child" $ runWD $ do
154175 testWidgetStatic (checkTextInTag "div" "hello world") $ do
155176 el "div" $ do
156177 el "span" $ text "hello world"
157178 text ""
158− it "updates after postBuild" $ do -- TODO I think these two tests are broken
179+ it "updates after postBuild" $ runWD $ do -- TODO I think these two tests are broken
159180 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
160181 after <- delay 0 =<< getPostBuild
161182 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
162− it "updates immediately after postBuild" $ do
183+ it "updates immediately after postBuild" $ runWD $ do
163184 testWidget (checkBodyText "pb") (checkBodyText "after") $ do
164185 pb <- getPostBuild
165186 after <- delay 0 pb
166187 void $ textNode $ TextNodeConfig "initial" $ Just $ leftmost ["pb" <$ pb, "after" <$ after]
167− it "updates in immediate mode" $ do
188+ it "updates in immediate mode" $ runWD $ do
168189 let checkUpdated = do
169190 checkBodyText "initial"
170191 WD.click =<< WD.findElem (WD.ByTag "button")
@@ -174,15 +195,15 @@ tests _selenium = do
174195 click <- button ""
175196 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
176197
177− describe "element" $ do
178− it "works with domEvent Click" $ do
179− clickedRef <- newRef False
198+ describe "element" $ session' $ do
199+ it "works with domEvent Click" $ runWD $ do
200+ clickedRef <- liftIO $ newRef False
180201 testWidget' (WD.findElem $ WD.ByTag "div") WD.click $ do
181202 (e, _) <- el' "div" $ text "hello world"
182203 performEvent_ $ liftIO (writeRef clickedRef True) <$ domEvent Click e
183− clicked <- readRef clickedRef
184− assertEqual "Not clicked" True clicked
185− it "works with eventFlags stopPropagation" $ do
204+ clicked <- liftIO $ readRef clickedRef
205+ liftIO $ assertEqual "Not clicked" True clicked
206+ it "works with eventFlags stopPropagation" $ runWD $ do
186207 firstClickedRef <- newRef False
187208 secondClickedRef <- newRef False
188209 let clickBoth = do
@@ -202,7 +223,7 @@ tests _selenium = do
202223 firstClicked <- readRef firstClickedRef
203224 secondClicked <- readRef secondClickedRef
204225 assertEqual "Click propagated when it should have stopped" (True, False) (firstClicked, secondClicked)
205− it "works with eventFlags preventDefault" $ do
226+ it "works with eventFlags preventDefault" $ runWD $ do
206227 let click = do
207228 e <- WD.findElem $ WD.ByTag "input"
208229 s0 <- WD.isSelected e
@@ -216,7 +237,7 @@ tests _selenium = do
216237 & initialAttributes .~ "type" =: "checkbox"
217238 void $ element "input" conf $ text "hello world"
218239 assertEqual "Click not prevented" (False, False) clicked
219− it "can add/update/remove attributes" $ do
240+ it "can add/update/remove attributes" $ runWD $ do
220241 let checkInitialAttrs = do
221242 e <- WD.findElem $ WD.ByTag "div"
222243 assertAttr e "const" (Just "const")
@@ -239,7 +260,7 @@ tests _selenium = do
239260 let click = domEvent Click e
240261 return ()
241262 -- TODO check this is the correct solution
242− it "has ssr attribute, removes ssr attribute" $ do
263+ it "has ssr attribute, removes ssr attribute" $ runWD $ do
243264 let checkSSRAttr = do
244265 e <- WD.findElem $ WD.ByTag "div"
245266 assertAttr e "ssr" (Just "")
@@ -247,8 +268,8 @@ tests _selenium = do
247268 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
248269
249270 describe "inputElement" $ do
250− describe "hydration" $ do
251− it "doesn't wipe user input when switching over" $ do
271+ describe "hydration" $ session' $ do
272+ it "doesn't wipe user input when switching over" $ runWD $ do
252273 inputRef <- newRef ("" :: Text)
253274 testWidget'
254275 (do
@@ -257,89 +278,86 @@ tests _selenium = do
257278 pure e)
258279 (\e -> do
259280 t <- WD.attr e "value"
260− liftIO $ t `shouldBe` Just "hello world"
281+ t `shouldBe` Just "hello world"
261282 WD.click <=< WD.findElem $ WD.ByTag "button"
262283 input <- liftIO $ readRef inputRef
263− liftIO $ input `shouldBe` "hello world"
284+ input `shouldBe` "hello world"
264285 ) $ do
265286 e <- inputElement def
266287 click <- button "save"
267288 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
268− it "captures user input after switchover" $ do
289+ it "captures user input after switchover" $ runWD $ do
269290 inputRef <- newRef ("" :: Text)
270291 let checkValue = do
271292 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
272293 WD.click <=< WD.findElem $ WD.ByTag "button"
273294 input <- liftIO $ readRef inputRef
274− liftIO $ input `shouldBe` "hello world"
295+ input `shouldBe` "hello world"
275296 testWidget (pure ()) checkValue $ do
276297 e <- inputElement def
277298 click <- button "save"
278299 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
279− it "sets focus appropriately" $ do
300+ it "sets focus appropriately" $ runWD $ do
280301 focusRef <- newRef False
281302 let checkValue = do
282− liftIO $ readRef focusRef >>= flip shouldBe False
303+ readRef focusRef >>= flip shouldBe False
283304 e <- WD.findElem $ WD.ByTag "input"
284305 WD.click e
285306 liftIO $ threadDelay 100000
286− liftIO $ readRef focusRef >>= flip shouldBe True
307+ readRef focusRef >>= flip shouldBe True
287308 testWidget (pure ()) checkValue $ do
288309 e <- inputElement def
289310 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
290− it "sets focus when focus occurs before hydration" $ do
311+ it "sets focus when focus occurs before hydration" $ runWD $ do
291312 focusRef <- newRef False
292313 let setup = do
293314 e <- WD.findElem $ WD.ByTag "input"
294315 WD.click e
295316 hasFocus <- (== e) <$> WD.activeElem
296− liftIO $ do
297− hasFocus `shouldBe` True
298− readRef focusRef >>= flip shouldBe False
299− check = liftIO $ readRef focusRef >>= flip shouldBe True
317+ hasFocus `shouldBe` True
318+ readRef focusRef >>= flip shouldBe False
319+ check = readRef focusRef >>= flip shouldBe True
300320 testWidget setup check $ do
301321 e <- inputElement def
302322 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
303− it "sets value appropriately" $ do
323+ it "sets value appropriately" $ runWD $ do
304324 valueByUIRef <- newRef ("" :: Text)
305325 valueRef <- newRef ("" :: Text)
306− setValueChan :: Chan Text <- newChan
326+ setValueChan :: Chan Text <- liftIO newChan
307327 let checkValue = do
308− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
309− liftIO $ readRef valueRef >>= flip shouldBe ""
328+ readRef valueByUIRef >>= flip shouldBe ""
329+ readRef valueRef >>= flip shouldBe ""
310330 e <- WD.findElem $ WD.ByTag "input"
311331 WD.sendKeys "hello" e
312− liftIO $ do
313− threadDelay 100000
314− readRef valueByUIRef >>= flip shouldBe "hello"
315− readRef valueRef >>= flip shouldBe "hello"
316− writeChan setValueChan "world"
317− threadDelay 100000
318− readRef valueByUIRef >>= flip shouldBe "hello"
319− readRef valueRef >>= flip shouldBe "world"
332+ liftIO $ threadDelay 100000
333+ readRef valueByUIRef >>= flip shouldBe "hello"
334+ readRef valueRef >>= flip shouldBe "hello"
335+ liftIO $ writeChan setValueChan "world"
336+ liftIO $ threadDelay 100000
337+ readRef valueByUIRef >>= flip shouldBe "hello"
338+ readRef valueRef >>= flip shouldBe "world"
320339 testWidget (pure ()) checkValue $ do
321340 update <- triggerEventWithChan setValueChan
322341 e <- inputElement $ def & inputElementConfig_setValue .~ update
323− performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
324− performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
325− it "sets checked appropriately" $ do
342+ performEvent_ $ liftIO . (writeRef valueByUIRef) <$> _inputElement_input e
343+ performEvent_ $ liftIO . (writeRef valueRef) <$> updated (value e)
344+ it "sets checked appropriately" $ runWD $ do
326345 checkedByUIRef <- newRef False
327346 checkedRef <- newRef False
328− setCheckedChan <- newChan
347+ setCheckedChan <- liftIO newChan
329348 let checkValue = do
330− liftIO $ readRef checkedByUIRef >>= flip shouldBe False
331− liftIO $ readRef checkedRef >>= flip shouldBe False
349+ readRef checkedByUIRef >>= flip shouldBe False
350+ readRef checkedRef >>= flip shouldBe False
332351 e <- WD.findElem $ WD.ByTag "input"
333352 WD.moveToCenter e
334353 WD.click e
335− liftIO $ do
336− threadDelay 100000
337− readRef checkedByUIRef >>= flip shouldBe True
338− readRef checkedRef >>= flip shouldBe True
339− writeChan setCheckedChan False
340− threadDelay 100000
341− readRef checkedByUIRef >>= flip shouldBe True
342− readRef checkedRef >>= flip shouldBe False
354+ liftIO $ threadDelay 100000
355+ readRef checkedByUIRef >>= flip shouldBe True
356+ readRef checkedRef >>= flip shouldBe True
357+ liftIO $ writeChan setCheckedChan False
358+ liftIO $ threadDelay 100000
359+ readRef checkedByUIRef >>= flip shouldBe True
360+ readRef checkedRef >>= flip shouldBe False
343361 testWidget (pure ()) checkValue $ do
344362 setChecked <- triggerEventWithChan setCheckedChan
345363 e <- inputElement $ def
@@ -347,7 +365,7 @@ tests _selenium = do
347365 & inputElementConfig_setChecked .~ setChecked
348366 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
349367 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
350− it "captures file uploads" $ do
368+ it "captures file uploads" $ runWD $ do
351369 filesRef :: IORef [Text] <- newRef []
352370 let uploadFile = do
353371 e <- WD.findElem $ WD.ByTag "input"
@@ -355,8 +373,8 @@ tests _selenium = do
355373 WD.sendKeys (T.pack path) e
356374 WD.click <=< WD.findElem $ WD.ByTag "button"
357375 liftIO $ removeFile path
358− input <- liftIO $ readRef filesRef
359− liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
376+ input <- readRef filesRef
377+ input `shouldBe` [T.pack $ FilePath.takeFileName path]
360378 testWidget (pure ()) uploadFile $ do
361379 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
362380 click <- button "save"
@@ -364,70 +382,68 @@ tests _selenium = do
364382 names <- liftJSM $ traverse File.getName fs
365383 liftIO $ writeRef filesRef names
366384
367− describe "hydration/immediate" $ do
368− it "captures user input after switchover" $ do
385+ describe "hydration/immediate" $ session' $ do
386+ it "captures user input after switchover" $ runWD $ do
369387 inputRef :: IORef Text <- newRef ""
370388 let checkValue = do
371389 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
372390 WD.click <=< WD.findElem $ WD.ByTag "button"
373− input <- liftIO $ readRef inputRef
374− liftIO $ input `shouldBe` "hello world"
391+ input <- readRef inputRef
392+ input `shouldBe` "hello world"
375393 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
376394 e <- inputElement def
377395 click <- button "save"
378396 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
379− it "sets focus appropriately" $ do
397+ it "sets focus appropriately" $ runWD $ do
380398 focusRef <- newRef False
381399 let checkValue = do
382− liftIO $ readRef focusRef >>= flip shouldBe False
400+ readRef focusRef >>= flip shouldBe False
383401 e <- WD.findElem $ WD.ByTag "input"
384402 WD.click e
385403 liftIO $ threadDelay 100000
386− liftIO $ readRef focusRef >>= flip shouldBe True
404+ readRef focusRef >>= flip shouldBe True
387405 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
388406 e <- inputElement def
389407 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
390− it "sets value appropriately" $ do
408+ it "sets value appropriately" $ runWD $ do
391409 valueByUIRef :: IORef Text <- newRef ""
392410 valueRef :: IORef Text <- newRef ""
393− setValueChan :: Chan Text <- newChan
411+ setValueChan :: Chan Text <- liftIO newChan
394412 let checkValue = do
395− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
396− liftIO $ readRef valueRef >>= flip shouldBe ""
413+ readRef valueByUIRef >>= flip shouldBe ""
414+ readRef valueRef >>= flip shouldBe ""
397415 e <- WD.findElem $ WD.ByTag "input"
398416 WD.sendKeys "hello" e
399− liftIO $ do
400− threadDelay 100000
401− readRef valueByUIRef >>= flip shouldBe "hello"
402− readRef valueRef >>= flip shouldBe "hello"
403− writeChan setValueChan "world"
404− threadDelay 100000
405− readRef valueByUIRef >>= flip shouldBe "hello"
406− readRef valueRef >>= flip shouldBe "world"
417+ liftIO $ threadDelay 100000
418+ readRef valueByUIRef >>= flip shouldBe "hello"
419+ readRef valueRef >>= flip shouldBe "hello"
420+ liftIO $ writeChan setValueChan "world"
421+ liftIO $ threadDelay 100000
422+ readRef valueByUIRef >>= flip shouldBe "hello"
423+ readRef valueRef >>= flip shouldBe "world"
407424 testWidget (pure ()) checkValue $ do
408425 update <- triggerEventWithChan setValueChan
409426 prerender_ (pure ()) $ do
410427 e <- inputElement $ def & inputElementConfig_setValue .~ update
411428 performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
412429 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
413− it "sets checked appropriately" $ do
430+ it "sets checked appropriately" $ runWD $ do
414431 checkedByUIRef <- newRef False
415432 checkedRef <- newRef False
416− setCheckedChan <- newChan
433+ setCheckedChan <- liftIO newChan
417434 let checkValue = do
418− liftIO $ readRef checkedByUIRef >>= flip shouldBe False
419− liftIO $ readRef checkedRef >>= flip shouldBe False
435+ readRef checkedByUIRef >>= flip shouldBe False
436+ readRef checkedRef >>= flip shouldBe False
420437 e <- WD.findElem $ WD.ByTag "input"
421438 WD.moveToCenter e
422439 WD.click e
423− liftIO $ do
424− threadDelay 100000
425− readRef checkedByUIRef >>= flip shouldBe True
426− readRef checkedRef >>= flip shouldBe True
427− writeChan setCheckedChan False
428− threadDelay 100000
429− readRef checkedByUIRef >>= flip shouldBe True
430− readRef checkedRef >>= flip shouldBe False
440+ liftIO $ threadDelay 100000
441+ readRef checkedByUIRef >>= flip shouldBe True
442+ readRef checkedRef >>= flip shouldBe True
443+ liftIO $ writeChan setCheckedChan False
444+ liftIO $ threadDelay 100000
445+ readRef checkedByUIRef >>= flip shouldBe True
446+ readRef checkedRef >>= flip shouldBe False
431447 testWidget (pure ()) checkValue $ do
432448 setChecked <- triggerEventWithChan setCheckedChan
433449 prerender_ (pure ()) $ do
@@ -436,7 +452,7 @@ tests _selenium = do
436452 & inputElementConfig_setChecked .~ setChecked
437453 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
438454 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
439− it "captures file uploads" $ do
455+ it "captures file uploads" $ runWD $ do
440456 filesRef :: IORef [Text] <- newRef []
441457 let uploadFile = do
442458 e <- WD.findElem $ WD.ByTag "input"
@@ -445,7 +461,7 @@ tests _selenium = do
445461 WD.click <=< WD.findElem $ WD.ByTag "button"
446462 liftIO $ removeFile path
447463 input <- liftIO $ readRef filesRef
448− liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
464+ input `shouldBe` [T.pack $ FilePath.takeFileName path]
449465 testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
450466 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
451467 click <- button "save"
@@ -454,8 +470,8 @@ tests _selenium = do
454470 liftIO $ writeRef filesRef names
455471
456472 describe "textAreaElement" $ do
457− describe "hydration" $ do
458− it "doesn't wipe user input when switching over" $ do
473+ describe "hydration" $ session' $ do
474+ it "doesn't wipe user input when switching over" $ runWD $ do
459475 inputRef <- newRef ("" :: Text)
460476 testWidget'
461477 (do
@@ -464,112 +480,109 @@ tests _selenium = do
464480 pure e)
465481 (\e -> do
466482 t <- WD.attr e "value"
467− liftIO $ t `shouldBe` Just "hello world"
483+ t `shouldBe` Just "hello world"
468484 WD.click <=< WD.findElem $ WD.ByTag "button"
469− input <- liftIO $ readRef inputRef
470− liftIO $ input `shouldBe` "hello world"
485+ input <- readRef inputRef
486+ input `shouldBe` "hello world"
471487 ) $ do
472488 e <- textAreaElement def
473489 click <- button "save"
474490 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
475− it "captures user input after switchover" $ do
491+ it "captures user input after switchover" $ runWD $ do
476492 inputRef <- newRef ("" :: Text)
477493 let checkValue = do
478494 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
479495 WD.click <=< WD.findElem $ WD.ByTag "button"
480− input <- liftIO $ readRef inputRef
481− liftIO $ input `shouldBe` "hello world"
496+ input <- readRef inputRef
497+ input `shouldBe` "hello world"
482498 testWidget (pure ()) checkValue $ do
483499 e <- textAreaElement def
484500 click <- button "save"
485501 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
486− it "sets focus appropriately" $ do
502+ it "sets focus appropriately" $ runWD $ do
487503 focusRef <- newRef False
488504 let checkValue = do
489− liftIO $ readRef focusRef >>= flip shouldBe False
505+ readRef focusRef >>= flip shouldBe False
490506 e <- WD.findElem $ WD.ByTag "textarea"
491507 WD.click e
492508 liftIO $ threadDelay 100000
493− liftIO $ readRef focusRef >>= flip shouldBe True
509+ readRef focusRef >>= flip shouldBe True
494510 testWidget (pure ()) checkValue $ do
495511 e <- textAreaElement def
496512 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
497− it "sets focus when focus occurs before hydration" $ do
513+ it "sets focus when focus occurs before hydration" $ runWD $ do
498514 focusRef <- newRef False
499515 let setup = do
500516 e <- WD.findElem $ WD.ByTag "textarea"
501517 WD.click e
502518 hasFocus <- (== e) <$> WD.activeElem
503− liftIO $ do
504− hasFocus `shouldBe` True
505− readRef focusRef >>= flip shouldBe False
506− check = liftIO $ readRef focusRef >>= flip shouldBe True
519+ hasFocus `shouldBe` True
520+ readRef focusRef >>= flip shouldBe False
521+ check = readRef focusRef >>= flip shouldBe True
507522 testWidget setup check $ do
508523 e <- textAreaElement def
509524 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
510− it "sets value appropriately" $ do
525+ it "sets value appropriately" $ runWD $ do
511526 valueByUIRef <- newRef ("" :: Text)
512527 valueRef <- newRef ("" :: Text)
513− setValueChan :: Chan Text <- newChan
528+ setValueChan :: Chan Text <- liftIO newChan
514529 let checkValue = do
515− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
516− liftIO $ readRef valueRef >>= flip shouldBe ""
530+ readRef valueByUIRef >>= flip shouldBe ""
531+ readRef valueRef >>= flip shouldBe ""
517532 e <- WD.findElem $ WD.ByTag "textarea"
518533 WD.sendKeys "hello" e
519− liftIO $ do
520− threadDelay 100000
521− readRef valueByUIRef >>= flip shouldBe "hello"
522− readRef valueRef >>= flip shouldBe "hello"
523− writeChan setValueChan "world"
524− threadDelay 100000
525− readRef valueByUIRef >>= flip shouldBe "hello"
526− readRef valueRef >>= flip shouldBe "world"
534+ liftIO $ threadDelay 100000
535+ readRef valueByUIRef >>= flip shouldBe "hello"
536+ readRef valueRef >>= flip shouldBe "hello"
537+ liftIO $ writeChan setValueChan "world"
538+ liftIO $ threadDelay 100000
539+ readRef valueByUIRef >>= flip shouldBe "hello"
540+ readRef valueRef >>= flip shouldBe "world"
527541 testWidget (pure ()) checkValue $ do
528542 setValue' <- triggerEventWithChan setValueChan
529543 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
530544 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
531545 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
532546
533− describe "hydration/immediate" $ do
534− it "captures user input after switchover" $ do
547+ describe "hydration/immediate" $ session' $ do
548+ it "captures user input after switchover" $ runWD $ do
535549 inputRef :: IORef Text <- newRef ""
536550 let checkValue = do
537551 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
538552 WD.click <=< WD.findElem $ WD.ByTag "button"
539553 input <- liftIO $ readRef inputRef
540− liftIO $ input `shouldBe` "hello world"
554+ input `shouldBe` "hello world"
541555 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
542556 e <- textAreaElement def
543557 click <- button "save"
544558 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
545− it "sets focus appropriately" $ do
559+ it "sets focus appropriately" $ runWD $ do
546560 focusRef <- newRef False
547561 let checkValue = do
548− liftIO $ readRef focusRef >>= flip shouldBe False
562+ readRef focusRef >>= flip shouldBe False
549563 e <- WD.findElem $ WD.ByTag "textarea"
550564 WD.click e
551565 liftIO $ threadDelay 100000
552− liftIO $ readRef focusRef >>= flip shouldBe True
566+ readRef focusRef >>= flip shouldBe True
553567 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
554568 e <- textAreaElement def
555569 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
556− it "sets value appropriately" $ do
570+ it "sets value appropriately" $ runWD $ do
557571 valueByUIRef :: IORef Text <- newRef ""
558572 valueRef :: IORef Text <- newRef ""
559− setValueChan :: Chan Text <- newChan
573+ setValueChan :: Chan Text <- liftIO newChan
560574 let checkValue = do
561− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
562− liftIO $ readRef valueRef >>= flip shouldBe ""
575+ readRef valueByUIRef >>= flip shouldBe ""
576+ readRef valueRef >>= flip shouldBe ""
563577 e <- WD.findElem $ WD.ByTag "textarea"
564578 WD.sendKeys "hello" e
565− liftIO $ do
566− threadDelay 100000
567− readRef valueByUIRef >>= flip shouldBe "hello"
568− readRef valueRef >>= flip shouldBe "hello"
569− writeChan setValueChan "world"
570− threadDelay 100000
571− readRef valueByUIRef >>= flip shouldBe "hello"
572− readRef valueRef >>= flip shouldBe "world"
579+ liftIO $ threadDelay 100000
580+ readRef valueByUIRef >>= flip shouldBe "hello"
581+ readRef valueRef >>= flip shouldBe "hello"
582+ liftIO $ writeChan setValueChan "world"
583+ liftIO $ threadDelay 100000
584+ readRef valueByUIRef >>= flip shouldBe "hello"
585+ readRef valueRef >>= flip shouldBe "world"
573586 testWidget (pure ()) checkValue $ do
574587 setValue' <- triggerEventWithChan setValueChan
575588 prerender_ (pure ()) $ do
@@ -583,8 +596,8 @@ tests _selenium = do
583596 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
584597 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
585598 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
586− describe "hydration" $ do
587− it "sets initial value correctly" $ do
599+ describe "hydration" $ session' $ do
600+ it "sets initial value correctly" $ runWD $ do
588601 inputRef <- newRef ("" :: Text)
589602 let setup = do
590603 e <- WD.findElem $ WD.ByTag "select"
@@ -593,16 +606,16 @@ tests _selenium = do
593606 pure e
594607 check e = do
595608 assertAttr e "value" (Just "two")
596− liftIO $ readRef inputRef >>= (`shouldBe` "three")
609+ readRef inputRef >>= (`shouldBe` "three")
597610 WD.click <=< WD.findElem $ WD.ByTag "button"
598611 assertAttr e "value" (Just "two")
599− liftIO $ readRef inputRef >>= (`shouldBe` "two")
612+ readRef inputRef >>= (`shouldBe` "two")
600613 testWidget' setup check $ do
601614 (e, ()) <- selectElement (def { _selectElementConfig_initialValue = "three" }) options
602615 click <- button "save"
603616 liftIO . writeRef inputRef <=< sample $ current $ _selectElement_value e
604617 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
605− it "captures user input after switchover" $ do
618+ it "captures user input after switchover" $ runWD $ do
606619 inputRef <- newRef ("" :: Text)
607620 let checkValue = do
608621 e <- WD.findElem $ WD.ByTag "select"
@@ -610,97 +623,94 @@ tests _selenium = do
610623 WD.click <=< WD.findElem $ WD.ById "two"
611624 assertAttr e "value" (Just "two")
612625 WD.click <=< WD.findElem $ WD.ByTag "button"
613− liftIO $ readRef inputRef >>= (`shouldBe` "two")
626+ readRef inputRef >>= (`shouldBe` "two")
614627 testWidget (pure ()) checkValue $ do
615628 (e, ()) <- selectElement def options
616629 click <- button "save"
617630 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
618− it "sets focus appropriately" $ do
631+ it "sets focus appropriately" $ runWD $ do
619632 focusRef <- newRef False
620633 let checkValue = do
621− liftIO $ readRef focusRef >>= flip shouldBe False
634+ readRef focusRef >>= flip shouldBe False
622635 e <- WD.findElem $ WD.ByTag "select"
623636 WD.click e
624637 liftIO $ threadDelay 100000
625− liftIO $ readRef focusRef >>= flip shouldBe True
638+ readRef focusRef >>= flip shouldBe True
626639 testWidget (pure ()) checkValue $ do
627640 (e, ()) <- selectElement def options
628641 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
629− it "sets focus when focus occurs before hydration" $ do
642+ it "sets focus when focus occurs before hydration" $ runWD $ do
630643 focusRef <- newRef False
631644 let setup = do
632645 e <- WD.findElem $ WD.ByTag "select"
633646 WD.click e
634647 hasFocus <- (== e) <$> WD.activeElem
635− liftIO $ do
636− hasFocus `shouldBe` True
637− readRef focusRef >>= flip shouldBe False
638− check = liftIO $ readRef focusRef >>= flip shouldBe True
648+ hasFocus `shouldBe` True
649+ readRef focusRef >>= flip shouldBe False
650+ check = readRef focusRef >>= flip shouldBe True
639651 testWidget setup check $ do
640652 (e, ()) <- selectElement def options
641653 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
642− it "sets value appropriately" $ do
654+ it "sets value appropriately" $ runWD $ do
643655 valueByUIRef <- newRef ("" :: Text)
644656 valueRef <- newRef ("" :: Text)
645− setValueChan :: Chan Text <- newChan
657+ setValueChan :: Chan Text <- liftIO newChan
646658 let checkValue = do
647659 e <- WD.findElem $ WD.ByTag "select"
648660 assertAttr e "value" (Just "one")
649− liftIO $ readRef valueByUIRef >>= flip shouldBe "one"
650− liftIO $ readRef valueRef >>= flip shouldBe "one"
661+ readRef valueByUIRef >>= flip shouldBe "one"
662+ readRef valueRef >>= flip shouldBe "one"
651663 WD.click <=< WD.findElem $ WD.ById "two"
652− liftIO $ do
653− threadDelay 100000
654− readRef valueByUIRef >>= flip shouldBe "two"
655− readRef valueRef >>= flip shouldBe "two"
656− writeChan setValueChan "three"
657− threadDelay 100000
658− readRef valueByUIRef >>= flip shouldBe "two"
659− readRef valueRef >>= flip shouldBe "three"
664+ liftIO $ threadDelay 100000
665+ readRef valueByUIRef >>= flip shouldBe "two"
666+ readRef valueRef >>= flip shouldBe "two"
667+ liftIO $ writeChan setValueChan "three"
668+ liftIO $ threadDelay 100000
669+ readRef valueByUIRef >>= flip shouldBe "two"
670+ readRef valueRef >>= flip shouldBe "three"
660671 testWidget (pure ()) checkValue $ do
661672 setValue' <- triggerEventWithChan setValueChan
662673 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
663674 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
664675 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
665676
666− describe "hydration/immediate" $ do
667− it "captures user input after switchover" $ do
677+ describe "hydration/immediate" $ session' $ do
678+ it "captures user input after switchover" $ runWD $ do
668679 inputRef :: IORef Text <- newRef ""
669680 let checkValue = do
670681 WD.click <=< WD.findElem $ WD.ById "two"
671682 WD.click <=< WD.findElem $ WD.ByTag "button"
672− liftIO $ readRef inputRef >>= flip shouldBe "two"
683+ readRef inputRef >>= flip shouldBe "two"
673684 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
674685 (e, ()) <- selectElement def options
675686 click <- button "save"
676687 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
677− it "sets focus appropriately" $ do
688+ it "sets focus appropriately" $ runWD $ do
678689 focusRef <- newRef False
679690 let checkValue = do
680− liftIO $ readRef focusRef >>= flip shouldBe False
691+ readRef focusRef >>= flip shouldBe False
681692 e <- WD.findElem $ WD.ByTag "select"
682693 WD.click e
683694 liftIO $ threadDelay 100000
684− liftIO $ readRef focusRef >>= flip shouldBe True
695+ readRef focusRef >>= flip shouldBe True
685696 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
686697 (e, ()) <- selectElement def options
687698 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
688− it "sets value appropriately" $ do
699+ it "sets value appropriately" $ runWD $ do
689700 valueByUIRef :: IORef Text <- newRef ""
690701 valueRef :: IORef Text <- newRef ""
691− setValueChan :: Chan Text <- newChan
702+ setValueChan :: Chan Text <- liftIO newChan
692703 let checkValue = do
693− liftIO $ readRef valueByUIRef >>= flip shouldBe "one"
694− liftIO $ readRef valueRef >>= flip shouldBe "one"
704+ readRef valueByUIRef >>= flip shouldBe "one"
705+ readRef valueRef >>= flip shouldBe "one"
695706 WD.click <=< WD.findElem $ WD.ById "two"
696− liftIO $ do
697− threadDelay 100000
698− readRef valueByUIRef >>= flip shouldBe "two"
699− readRef valueRef >>= flip shouldBe "two"
700− writeChan setValueChan "three"
701− threadDelay 100000
702− readRef valueByUIRef >>= flip shouldBe "two"
703− readRef valueRef >>= flip shouldBe "three"
707+ liftIO $ threadDelay 100000
708+ readRef valueByUIRef >>= flip shouldBe "two"
709+ readRef valueRef >>= flip shouldBe "two"
710+ liftIO $ writeChan setValueChan "three"
711+ liftIO $ threadDelay 100000
712+ readRef valueByUIRef >>= flip shouldBe "two"
713+ readRef valueRef >>= flip shouldBe "three"
704714 testWidget (pure ()) checkValue $ do
705715 setValue' <- triggerEventWithChan setValueChan
706716 prerender_ (pure ()) $ do
@@ -708,30 +718,30 @@ tests _selenium = do
708718 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
709719 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
710720
711− describe "prerender" $ do
712− it "works in simple case" $ do
721+ describe "prerender" $ session' $ do
722+ it "works in simple case" $ runWD $ do
713723 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
714724 prerender_ (text "One") (text "Two")
715− it "removes element correctly" $ do
725+ it "removes element correctly" $ runWD $ do
716726 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
717727 prerender_ (el "span" $ text "One") (text "Two")
718− it "can be nested in server widget" $ do
728+ it "can be nested in server widget" $ runWD $ do
719729 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
720730 prerender_ (prerender_ (text "One") (text "Two")) (text "Three")
721− it "can be nested in client widget" $ do
731+ it "can be nested in client widget" $ runWD $ do
722732 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
723733 prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
724− it "works with prerender_ siblings" $ do
734+ it "works with prerender_ siblings" $ runWD $ do
725735 testWidget
726736 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
727737 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
728738 prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
729739 prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
730740 prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
731− it "works inside other element" $ do
741+ it "works inside other element" $ runWD $ do
732742 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
733743 el "div" $ prerender_ (text "One") (text "Two")
734− it "places fences and removes them" $ do
744+ it "places fences and removes them" $ runWD $ do
735745 testWidget'
736746 (do
737747 scripts <- WD.findElems $ WD.ByTag "script"
@@ -739,19 +749,19 @@ tests _selenium = do
739749 )
740750 (traverse_ elementShouldBeRemoved)
741751 (el "span" $ prerender_ (text "One") (text "Two"))
742− it "postBuild works on server side" $ do
743− lock :: MVar () <- newEmptyMVar
752+ it "postBuild works on server side" $ runWD $ do
753+ lock :: MVar () <- liftIO newEmptyMVar
744754 testWidget (liftIO $ takeMVar lock) (pure ()) $ do
745755 prerender_ (do
746756 pb <- getPostBuild
747757 performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
748− it "postBuild works on client side" $ do
749− lock :: MVar () <- newEmptyMVar
758+ it "postBuild works on client side" $ runWD $ do
759+ lock :: MVar () <- liftIO newEmptyMVar
750760 testWidget (pure ()) (liftIO $ takeMVar lock) $ do
751761 prerender_ blank $ do
752762 pb <- getPostBuild
753763 performEvent_ $ liftIO (putMVar lock ()) <$ pb
754− it "result Dynamic is updated *after* switchover" $ do
764+ it "result Dynamic is updated *after* switchover" $ runWD $ do
755765 let static = shouldContainText "PostBuild" =<< WD.findElem (WD.ByTag "body")
756766 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
757767 testWidget static check $ void $ do
@@ -761,14 +771,14 @@ tests _selenium = do
761771 textNode $ TextNodeConfig initial $ Just $ leftmost [updated d, "PostBuild" <$ pb]
762772 -- This essentially checks that the client IO runs *after* switchover/postBuild,
763773 -- thus can't create conflicting DOM
764− it "can't exploit IO to break hydration" $ do
774+ it "can't exploit IO to break hydration" $ runWD $ do
765775 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
766776 testWidgetStatic static $ void $ do
767777 ref <- liftIO $ newRef "Initial"
768778 prerender_ (pure ()) (liftIO $ writeRef ref "Client")
769779 text <=< liftIO $ readRef ref
770780 -- As above, so below
771− it "can't exploit triggerEvent to break hydration" $ do
781+ it "can't exploit triggerEvent to break hydration" $ runWD $ do
772782 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
773783 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
774784 testWidget static check $ void $ do
@@ -776,13 +786,13 @@ tests _selenium = do
776786 prerender_ (pure ()) (liftIO $ trigger "Client")
777787 textNode $ TextNodeConfig "Initial" $ Just e
778788
779− describe "runWithReplace" $ do
780− it "works" $ do
781− replaceChan :: Chan Text <- newChan
789+ describe "runWithReplace" $ session' $ do
790+ it "works" $ runWD $ do
791+ replaceChan :: Chan Text <- liftIO newChan
782792 let setup = WD.findElem $ WD.ByTag "div"
783793 check ssr = do
784794 -- Check that the original element still exists and has the correct text
785− WD.getText ssr >>= liftIO . flip shouldBe "two"
795+ WD.getText ssr >>= flip shouldBe "two"
786796 liftIO $ do
787797 writeChan replaceChan "three"
788798 threadDelay 100000
@@ -795,12 +805,12 @@ tests _selenium = do
795805 [ el "div" (text "two") <$ pb
796806 , el "span" . text <$> replace
797807 ]
798− it "can be nested in initial widget" $ do
799− replaceChan :: Chan Text <- newChan
808+ it "can be nested in initial widget" $ runWD $ do
809+ replaceChan :: Chan Text <- liftIO newChan
800810 let setup = WD.findElem $ WD.ByTag "div"
801811 check ssr = do
802812 -- Check that the original element still exists and has the correct text
803− WD.getText ssr >>= liftIO . flip shouldBe "two"
813+ WD.getText ssr >>= flip shouldBe "two"
804814 liftIO $ do
805815 writeChan replaceChan "three"
806816 threadDelay 100000
@@ -813,12 +823,12 @@ tests _selenium = do
813823 [ el "div" (text "two") <$ pb
814824 , el "span" . text <$> replace
815825 ]
816− it "can be nested in postBuild widget" $ do
817− replaceChan <- newChan
826+ it "can be nested in postBuild widget" $ runWD $ do
827+ replaceChan <- liftIO newChan
818828 let setup = WD.findElem $ WD.ByTag "div"
819829 check ssr = do
820830 -- Check that the original element still exists and has the correct text
821− WD.getText ssr >>= liftIO . flip shouldBe "two"
831+ WD.getText ssr >>= flip shouldBe "two"
822832 liftIO $ do
823833 writeChan replaceChan "three"
824834 threadDelay 100000
@@ -833,9 +843,9 @@ tests _selenium = do
833843 [ el "div" (text "two") <$ pb'
834844 , el "span" . text <$> replace
835845 ]
836− it "postBuild works in replaced widget" $ do
837− replaceChan <- newChan
838− pbLock <- newEmptyMVar
846+ it "postBuild works in replaced widget" $ runWD $ do
847+ replaceChan <- liftIO newChan
848+ pbLock <- liftIO newEmptyMVar
839849 let check = do
840850 liftIO $ do
841851 writeChan replaceChan ()
@@ -846,10 +856,11 @@ tests _selenium = do
846856 runWithReplace (pure ()) $ ffor replace $ \() -> do
847857 pb <- getPostBuild
848858 performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
849− it "can be nested in event widget" $ do -- Test is broken, I think
850− replaceChan1 :: Chan Text <- newChan
851− replaceChan2 :: Chan Text <- newChan
852− lock :: MVar () <- newEmptyMVar
859+
860+ it "can be nested in event widget" $ runWD $ do -- Test is broken, I think
861+ replaceChan1 :: Chan Text <- liftIO newChan
862+ replaceChan2 :: Chan Text <- liftIO newChan
863+ lock :: MVar () <- liftIO newEmptyMVar
853864 let check = do
854865 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
855866 liftIO $ do
@@ -857,7 +868,7 @@ tests _selenium = do
857868 threadDelay 100000
858869 takeMVar lock
859870 one <- WD.findElem $ WD.ByTag "div"
860− WD.getText one >>= liftIO . flip shouldBe "pb"
871+ WD.getText one >>= flip shouldBe "pb"
861872 liftIO $ do
862873 writeChan replaceChan2 "two"
863874 threadDelay 100000
@@ -873,12 +884,13 @@ tests _selenium = do
873884 [ el "span" . text <$> replace2
874885 , el "div" (text "pb") <$ pb
875886 ]
876− it "works in immediate mode (RHS of prerender)" $ do
877− replaceChan :: Chan Text <- newChan
887+
888+ it "works in immediate mode (RHS of prerender)" $ runWD $ do
889+ replaceChan :: Chan Text <- liftIO newChan
878890 let check = do
879891 one <- WD.findElem $ WD.ByTag "div"
880892 shouldContainText "one" =<< WD.findElem (WD.ByTag "body")
881− WD.getText one >>= liftIO . flip shouldBe "one"
893+ WD.getText one >>= flip shouldBe "one"
882894 liftIO $ do
883895 writeChan replaceChan "pb"
884896 threadDelay 100000
@@ -888,12 +900,12 @@ tests _selenium = do
888900 replace <- triggerEventWithChan replaceChan
889901 prerender_ blank $ do
890902 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
891− it "works with postBuild in immediate mode (RHS of prerender)" $ do
892− replaceChan :: Chan Text <- newChan
903+ it "works with postBuild in immediate mode (RHS of prerender)" $ runWD $ do
904+ replaceChan :: Chan Text <- liftIO newChan
893905 let check = do
894906 two <- WD.findElem $ WD.ByTag "div"
895907 shouldContainText "two" =<< WD.findElem (WD.ByTag "body")
896− WD.getText two >>= liftIO . flip shouldBe "two"
908+ WD.getText two >>= flip shouldBe "two"
897909 liftIO $ do
898910 writeChan replaceChan "three"
899911 threadDelay 100000
@@ -908,7 +920,7 @@ tests _selenium = do
908920 , el "span" . text <$> replace
909921 ]
910922
911− describe "traverseDMapWithKeyWithAdjust" $ do
923+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do
912924 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
913925 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
914926 elClass "span" "key" $ text $ textKey k
@@ -946,19 +958,21 @@ tests _selenium = do
946958 e <- WD.findElem (WD.ById $ textKey k)
947959 checkItem e (textKey k) (T.pack $ show v)
948960 postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
949− it "doesn't replace elements at switchover, can delete/update/insert" $ do
950− chan <- newChan
951− let static = getAndCheckInitialItems keyMap
961+ it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
962+ chan <- liftIO newChan
963+ let static :: WD [WD.Element]
964+ static = getAndCheckInitialItems keyMap
965+ check :: [WD.Element] -> WD ()
952966 check xs = do
953967 checkInitialItems keyMap xs
954968 checkRemoval chan Key_Int
955969 checkReplace chan Key_Char 'B'
956970 checkInsert chan Key_Bool True
957− testWidget' static check $ void $ do
971+ testWidget' static check $ do
958972 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
959− liftIO $ dmap `shouldBe` keyMap
960− it "handles postBuild correctly" $ do
961− chan <- newChan
973+ liftIO $ dmap `H.shouldBe` keyMap
974+ it "handles postBuild correctly" $ runWD $ do
975+ chan <- liftIO newChan
962976 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
963977 check xs = do
964978 checkInitialItems (fromMaybe undefined $ apply postBuildPatch keyMap) xs
@@ -969,9 +983,9 @@ tests _selenium = do
969983 pb <- getPostBuild
970984 replace <- triggerEventWithChan chan
971985 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
972− liftIO $ dmap `shouldBe` keyMap
973− it "can delete/update/insert when built in prerender" $ do
974− chan <- newChan
986+ liftIO $ dmap `H.shouldBe` keyMap
987+ it "can delete/update/insert when built in prerender" $ runWD $ do
988+ chan <- liftIO newChan
975989 let check = do
976990 _ <- getAndCheckInitialItems keyMap
977991 checkRemoval chan Key_Int
@@ -981,9 +995,9 @@ tests _selenium = do
981995 replace <- triggerEventWithChan chan
982996 prerender_ (pure ()) $ do
983997 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
984− liftIO $ dmap `shouldBe` keyMap
985− it "can delete/update/insert when built in immediate mode" $ do
986− chan <- newChan
998+ liftIO $ dmap `H.shouldBe` keyMap
999+ it "can delete/update/insert when built in immediate mode" $ runWD $ do
1000+ chan <- liftIO newChan
9871001 let check = do
9881002 _ <- getAndCheckInitialItems keyMap
9891003 checkRemoval chan Key_Int
@@ -993,10 +1007,10 @@ tests _selenium = do
9931007 pb <- getPostBuild
9941008 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
9951009 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
996− liftIO $ dmap `shouldBe` keyMap
1010+ liftIO $ dmap `H.shouldBe` keyMap
9971011 -- Should be fixed by prerender changes!
998− it "handles postBuild correctly in prerender" $ do
999− chan <- newChan
1012+ it "handles postBuild correctly in prerender" $ runWD $ do
1013+ chan <- liftIO newChan
10001014 let check = do
10011015 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
10021016 checkRemoval chan Key_Int
@@ -1007,9 +1021,9 @@ tests _selenium = do
10071021 prerender_ (pure ()) $ void $ do
10081022 pb <- getPostBuild
10091023 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1010− liftIO $ dmap `shouldBe` keyMap
1024+ liftIO $ dmap `H.shouldBe` keyMap
10111025
1012− describe "traverseIntMapWithKeyWithAdjust" $ do
1026+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do
10131027 let textKeyInt k = "key" <> T.pack (show k)
10141028 intMap = IntMap.fromList
10151029 [ (1, "one")
@@ -1053,8 +1067,8 @@ tests _selenium = do
10531067 e <- WD.findElem (WD.ById $ textKeyInt k)
10541068 checkItem e (textKeyInt k) v
10551069 postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
1056− it "doesn't replace elements at switchover, can delete/update/insert" $ do
1057− chan <- newChan
1070+ it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
1071+ chan <- liftIO newChan
10581072 let static = getAndCheckInitialItems intMap
10591073 check xs = do
10601074 checkInitialItems intMap xs
@@ -1063,9 +1077,9 @@ tests _selenium = do
10631077 checkInsert chan 4 "four"
10641078 testWidget' static check $ void $ do
10651079 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1066− liftIO $ im `shouldBe` intMap
1067− it "handles postBuild correctly" $ do
1068− chan <- newChan
1080+ liftIO $ im `H.shouldBe` intMap
1081+ it "handles postBuild correctly" $ runWD $ do
1082+ chan <- liftIO newChan
10691083 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
10701084 check xs = do
10711085 checkInitialItems (fromMaybe undefined $ apply postBuildPatch intMap) xs
@@ -1076,9 +1090,9 @@ tests _selenium = do
10761090 pb <- getPostBuild
10771091 replace <- triggerEventWithChan chan
10781092 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1079− liftIO $ dmap `shouldBe` intMap
1080− it "can delete/update/insert when built in prerender" $ do
1081− chan <- newChan
1093+ liftIO $ dmap `H.shouldBe` intMap
1094+ it "can delete/update/insert when built in prerender" $ runWD $ do
1095+ chan <- liftIO newChan
10821096 let check = do
10831097 _ <- getAndCheckInitialItems intMap
10841098 checkRemoval chan 1
@@ -1088,9 +1102,9 @@ tests _selenium = do
10881102 replace <- triggerEventWithChan chan
10891103 prerender_ (pure ()) $ do
10901104 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap replace
1091− liftIO $ dmap `shouldBe` intMap
1092− it "can delete/update/insert when built in immediate mode" $ do
1093− chan <- newChan
1105+ liftIO $ dmap `H.shouldBe` intMap
1106+ it "can delete/update/insert when built in immediate mode" $ runWD $ do
1107+ chan <- liftIO newChan
10941108 let check = do
10951109 _ <- getAndCheckInitialItems intMap
10961110 checkRemoval chan 1
@@ -1100,10 +1114,10 @@ tests _selenium = do
11001114 pb <- getPostBuild
11011115 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
11021116 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1103− liftIO $ dmap `shouldBe` intMap
1117+ liftIO $ dmap `H.shouldBe` intMap
11041118 -- Should be fixed by prerender changes!
1105− it "handles postBuild correctly in prerender" $ do
1106− chan <- newChan
1119+ it "handles postBuild correctly in prerender" $ runWD $ do
1120+ chan <- liftIO newChan
11071121 let check = do
11081122 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
11091123 checkRemoval chan 1
@@ -1114,7 +1128,7 @@ tests _selenium = do
11141128 prerender_ (pure ()) $ void $ do
11151129 pb <- getPostBuild
11161130 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1117− liftIO $ dmap `shouldBe` intMap
1131+ liftIO $ dmap `H.shouldBe` intMap
11181132
11191133data Selenium = Selenium
11201134 { _selenium_portNumber :: PortNumber
@@ -1132,7 +1146,7 @@ startSeleniumServer port = do
11321146
11331147withSeleniumServer :: (Selenium -> IO ()) -> IO ()
11341148withSeleniumServer f = do
1135− let port = 4444 -- TODO port <- getFreePort
1149+ port <- getFreePort
11361150 stopServer <- startSeleniumServer port
11371151 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
11381152 f $ Selenium
@@ -1157,7 +1171,7 @@ elementShouldBeRemoved e = do
11571171 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
11581172
11591173shouldContainText :: Text -> WD.Element -> WD ()
1160−shouldContainText t = liftIO . flip shouldBe t <=< WD.getText
1174+shouldContainText t = flip shouldBe t <=< WD.getText
11611175
11621176checkBodyText :: Text -> WD ()
11631177checkBodyText = checkTextInTag "body"
@@ -1178,7 +1192,7 @@ testWidgetStatic
11781192 -- ^ Webdriver commands to run before JS runs and after hydration switchover
11791193 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
11801194 -- ^ Widget we are testing
1181− -> IO b
1195+ -> WD b
11821196testWidgetStatic w = testWidget (void w) w
11831197
11841198-- | TODO: do something about JSExceptions not causing tests to fail
@@ -1189,7 +1203,7 @@ testWidget
11891203 -- ^ Webdriver commands to run after hydration switchover
11901204 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
11911205 -- ^ Widget we are testing
1192− -> IO b
1206+ -> WD b
11931207testWidget beforeJS afterSwitchover = testWidget' beforeJS (const afterSwitchover)
11941208
11951209-- | TODO: do something about JSExceptions not causing tests to fail
@@ -1200,37 +1214,44 @@ testWidget'
12001214 -- ^ Webdriver commands to run after hydration switchover
12011215 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
12021216 -- ^ Widget we are testing (contents of body)
1203− -> IO b
1217+ -> WD b
12041218testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out") pure <=< timeout testTimeLimit $ do
12051219 let staticApp = do
12061220 el "head" $ pure ()
12071221 el "body" $ do
12081222 bodyWidget
12091223 el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
1210− ((), html) <- renderStatic staticApp
1211− waitBeforeJS <- newEmptyMVar -- Empty until JS should be run
1212− waitUntilSwitchover <- newEmptyMVar -- Empty until switchover
1224+ ((), html) <- liftIO $ renderStatic staticApp
1225+ waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
1226+ waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
12131227 let entryPoint = do
12141228 liftIO $ takeMVar waitBeforeJS
12151229 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget
12161230 syncPoint
1217− application <- jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html
1231+ application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse ->
1232+ sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html
12181233 port <- getFreePort
1219− let settings = Warp.setPort (fromIntegral $ toInteger port) Warp.defaultSettings
1234+ waitJSaddle <- liftIO newEmptyMVar
1235+ let settings = foldr ($) Warp.defaultSettings
1236+ [ Warp.setPort $ fromIntegral (toInteger port)
1237+ , Warp.setBeforeMainLoop $ putMVar waitJSaddle ()
1238+ ]
12201239 -- hSilence to get rid of ConnectionClosed logs
12211240 jsaddleWarp = forkIO $ hSilence [stderr] $ Warp.runSettings settings application
1222− bracket jsaddleWarp killThread $ \_ -> do
1223− browserPath <- T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""
1224− when (T.null browserPath) $ fail "No browser was found"
1225− WD.runSession (chromeConfig browserPath) . WD.finallyClose $ do
1226− WD.openPage $ "http://localhost:" <> show port
1227− a <- beforeJS
1228− liftIO $ putMVar waitBeforeJS ()
1229− liftIO $ takeMVar waitUntilSwitchover
1230− liftIO $ threadDelay 100000 -- wait a bit
1231− afterSwitchover a
1241+ jsaddleTid <- liftIO jsaddleWarp
1242+ liftIO $ takeMVar waitJSaddle
1243+ WD.openPage $ "http://localhost:" <> show port
1244+ a <- beforeJS
1245+ liftIO $ putMVar waitBeforeJS ()
1246+ liftIO $ takeMVar waitUntilSwitchover
1247+ liftIO $ threadDelay 100000 -- wait a bit
1248+ b <- afterSwitchover a
1249+ liftIO $ killThread jsaddleTid
1250+ return b
1251+
12321252
12331253-- TODO: Should this be part of more widely used module?
1254+-- TODO: Ensure port is not taken
12341255getFreePort :: MonadIO m => m PortNumber
12351256getFreePort = liftIO $ withSocketsDo $ do
12361257 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")