@@ -1,4 +1,7 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE StandaloneDeriving #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE UndecidableInstances #-}
2{-# LANGUAGE ConstraintKinds #-}
5{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE CPP #-}
6{-# LANGUAGE CPP #-}
4{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleContexts #-}
@@ -45,9 +48,11 @@ import System.IO (stderr)
45import System.IO.Silently
48import System.IO.Silently
46import System.IO.Temp
49import System.IO.Temp
47import System.Process
50import System.Process
48−import System.Timeout
51+import System.Timeout.Lifted
49−import Test.HUnit (assertEqual, assertFailure)
52+import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
50−import Test.Hspec (Spec, parallel, hspec, it, describe, shouldBe)
53+import qualified Test.Hspec as H
54+import Test.Hspec.WebDriver hiding (runWD)
55+import qualified Test.Hspec.WebDriver as WD
51import Test.WebDriver (WD)
56import Test.WebDriver (WD)
53import qualified Data.ByteString.Lazy as LBS
58import qualified Data.ByteString.Lazy as LBS
@@ -59,6 +64,16 @@ import qualified GHCJS.DOM.File as File
59import qualified Network.Wai.Handler.Warp as Warp
64import qualified Network.Wai.Handler.Warp as Warp
60import qualified System.FilePath as FilePath
65import qualified System.FilePath as FilePath
61import qualified Test.WebDriver as WD
66import qualified Test.WebDriver as WD
67+import qualified Test.WebDriver.Capabilities as WD
70+deriving instance MonadRef WD
72+assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
73+assertEqual a b = liftIO . HUnit.assertEqual a b
75+assertFailure :: MonadIO m => String -> m ()
76+assertFailure = liftIO . HUnit.assertFailure
63testTimeLimit :: Int
78testTimeLimit :: Int
64testTimeLimit = 5 * 1000 * 1000
79testTimeLimit = 5 * 1000 * 1000
@@ -108,24 +123,30 @@ instance EqTag DKey Identity where
108 eqTagged Key_Bool Key_Bool = (==)
123 eqTagged Key_Bool Key_Bool = (==)
110main :: IO ()
125main :: IO ()
111−main = withSeleniumServer $ \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
112− hspec (parallel (tests selenium)) `finally` _selenium_stopServer selenium
131+ hspec (tests wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium
114−tests :: Selenium -> Spec
133+tests :: WD.WDConfig -> [Capabilities] -> Selenium -> Spec
115−tests _selenium = do
134+tests wdConfig caps _selenium = do
135+ let session' = sessionWith wdConfig "" . using (map (flip (,) "") caps)
136+ runWD = runWDOptions (WdOptions False)
116− describe "text" $ do
137+ describe "text" $ session' $ do
117− it "works" $ do
138+ it "works" $ runWD $ do
118 testWidgetStatic (checkBodyText "hello world") $ do
139 testWidgetStatic (checkBodyText "hello world") $ do
119 text "hello world"
140 text "hello world"
120− it "works with postBuild" $ do
141+ it "works with postBuild" $ runWD $ do
121 testWidgetStatic (checkBodyText "pb") $ do
142 testWidgetStatic (checkBodyText "pb") $ do
122 pb <- getPostBuild
143 pb <- getPostBuild
123 void $ textNode $ TextNodeConfig "" $ Just $ "pb" <$ pb
144 void $ textNode $ TextNodeConfig "" $ Just $ "pb" <$ pb
124− it "works for adjacent text nodes" $ do
145+ it "works for adjacent text nodes" $ runWD $ do
125 testWidgetStatic (checkBodyText "hello world") $ do
146 testWidgetStatic (checkBodyText "hello world") $ do
126 text "hello "
147 text "hello "
127 text "world"
148 text "world"
128− it "works for empty adjacent text nodes" $ do
149+ it "works for empty adjacent text nodes" $ runWD $ do
129 testWidgetStatic (checkBodyText "hello world") $ do
150 testWidgetStatic (checkBodyText "hello world") $ do
130 pb <- getPostBuild
151 pb <- getPostBuild
@@ -134,37 +155,37 @@ tests _selenium = do
134 _ <- textNode $ TextNodeConfig "abc" $ Just $ "" <$ pb
155 _ <- textNode $ TextNodeConfig "abc" $ Just $ "" <$ pb
135 _ <- textNode $ TextNodeConfig "" $ Just $ "world" <$ pb
156 _ <- textNode $ TextNodeConfig "" $ Just $ "world" <$ pb
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
138 testWidgetStatic (checkBodyText "hello world") $ do
159 testWidgetStatic (checkBodyText "hello world") $ do
139 el "div" $ do
160 el "div" $ do
142 text "hello world"
163 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
144 testWidgetStatic (checkTextInTag "div" "hello world") $ do
165 testWidgetStatic (checkTextInTag "div" "hello world") $ do
145 el "div" $ do
166 el "div" $ do
147 text "hello world"
168 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
149 testWidgetStatic (checkTextInTag "div" "hello world") $ do
170 testWidgetStatic (checkTextInTag "div" "hello world") $ do
150 el "div" $ do
171 el "div" $ do
152 el "span" $ text "hello world"
173 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
154 testWidgetStatic (checkTextInTag "div" "hello world") $ do
175 testWidgetStatic (checkTextInTag "div" "hello world") $ do
155 el "div" $ do
176 el "div" $ do
156 el "span" $ text "hello world"
177 el "span" $ text "hello world"
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
159 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
180 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
160 after <- delay 0 =<< getPostBuild
181 after <- delay 0 =<< getPostBuild
161 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
182 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
162− it "updates immediately after postBuild" $ do
183+ it "updates immediately after postBuild" $ runWD $ do
163 testWidget (checkBodyText "pb") (checkBodyText "after") $ do
184 testWidget (checkBodyText "pb") (checkBodyText "after") $ do
164 pb <- getPostBuild
185 pb <- getPostBuild
165 after <- delay 0 pb
186 after <- delay 0 pb
166 void $ textNode $ TextNodeConfig "initial" $ Just $ leftmost ["pb" <$ pb, "after" <$ after]
187 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
168 let checkUpdated = do
189 let checkUpdated = do
169 checkBodyText "initial"
190 checkBodyText "initial"
170 WD.click =<< WD.findElem (WD.ByTag "button")
191 WD.click =<< WD.findElem (WD.ByTag "button")
@@ -174,15 +195,15 @@ tests _selenium = do
174 click <- button ""
195 click <- button ""
175 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
196 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
177− describe "element" $ do
198+ describe "element" $ session' $ do
178− it "works with domEvent Click" $ do
199+ it "works with domEvent Click" $ runWD $ do
179− clickedRef <- newRef False
200+ clickedRef <- liftIO $ newRef False
180 testWidget' (WD.findElem $ WD.ByTag "div") WD.click $ do
201 testWidget' (WD.findElem $ WD.ByTag "div") WD.click $ do
181 (e, _) <- el' "div" $ text "hello world"
202 (e, _) <- el' "div" $ text "hello world"
182 performEvent_ $ liftIO (writeRef clickedRef True) <$ domEvent Click e
203 performEvent_ $ liftIO (writeRef clickedRef True) <$ domEvent Click e
183− clicked <- readRef clickedRef
204+ clicked <- liftIO $ readRef clickedRef
184− assertEqual "Not clicked" True clicked
205+ liftIO $ assertEqual "Not clicked" True clicked
185− it "works with eventFlags stopPropagation" $ do
206+ it "works with eventFlags stopPropagation" $ runWD $ do
186 firstClickedRef <- newRef False
207 firstClickedRef <- newRef False
187 secondClickedRef <- newRef False
208 secondClickedRef <- newRef False
188 let clickBoth = do
209 let clickBoth = do
@@ -202,7 +223,7 @@ tests _selenium = do
202 firstClicked <- readRef firstClickedRef
223 firstClicked <- readRef firstClickedRef
203 secondClicked <- readRef secondClickedRef
224 secondClicked <- readRef secondClickedRef
204 assertEqual "Click propagated when it should have stopped" (True, False) (firstClicked, secondClicked)
225 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
206 let click = do
227 let click = do
207 e <- WD.findElem $ WD.ByTag "input"
228 e <- WD.findElem $ WD.ByTag "input"
208 s0 <- WD.isSelected e
229 s0 <- WD.isSelected e
@@ -216,7 +237,7 @@ tests _selenium = do
216 & initialAttributes .~ "type" =: "checkbox"
237 & initialAttributes .~ "type" =: "checkbox"
217 void $ element "input" conf $ text "hello world"
238 void $ element "input" conf $ text "hello world"
218 assertEqual "Click not prevented" (False, False) clicked
239 assertEqual "Click not prevented" (False, False) clicked
219− it "can add/update/remove attributes" $ do
240+ it "can add/update/remove attributes" $ runWD $ do
220 let checkInitialAttrs = do
241 let checkInitialAttrs = do
221 e <- WD.findElem $ WD.ByTag "div"
242 e <- WD.findElem $ WD.ByTag "div"
222 assertAttr e "const" (Just "const")
243 assertAttr e "const" (Just "const")
@@ -239,7 +260,7 @@ tests _selenium = do
239 let click = domEvent Click e
260 let click = domEvent Click e
240 return ()
261 return ()
241 -- TODO check this is the correct solution
262 -- 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
243 let checkSSRAttr = do
264 let checkSSRAttr = do
244 e <- WD.findElem $ WD.ByTag "div"
265 e <- WD.findElem $ WD.ByTag "div"
245 assertAttr e "ssr" (Just "")
266 assertAttr e "ssr" (Just "")
@@ -247,8 +268,8 @@ tests _selenium = do
247 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
268 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
249 describe "inputElement" $ do
270 describe "inputElement" $ do
250− describe "hydration" $ do
271+ describe "hydration" $ session' $ do
251− it "doesn't wipe user input when switching over" $ do
272+ it "doesn't wipe user input when switching over" $ runWD $ do
252 inputRef <- newRef ("" :: Text)
273 inputRef <- newRef ("" :: Text)
253 testWidget'
274 testWidget'
@@ -257,89 +278,86 @@ tests _selenium = do
258 (\e -> do
279 (\e -> do
259 t <- WD.attr e "value"
280 t <- WD.attr e "value"
260− liftIO $ t `shouldBe` Just "hello world"
281+ t `shouldBe` Just "hello world"
261 WD.click <=< WD.findElem $ WD.ByTag "button"
282 WD.click <=< WD.findElem $ WD.ByTag "button"
262 input <- liftIO $ readRef inputRef
283 input <- liftIO $ readRef inputRef
263− liftIO $ input `shouldBe` "hello world"
284+ input `shouldBe` "hello world"
265 e <- inputElement def
286 e <- inputElement def
266 click <- button "save"
287 click <- button "save"
267 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
288 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
269 inputRef <- newRef ("" :: Text)
290 inputRef <- newRef ("" :: Text)
270 let checkValue = do
291 let checkValue = do
271 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
292 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
272 WD.click <=< WD.findElem $ WD.ByTag "button"
293 WD.click <=< WD.findElem $ WD.ByTag "button"
273 input <- liftIO $ readRef inputRef
294 input <- liftIO $ readRef inputRef
274− liftIO $ input `shouldBe` "hello world"
295+ input `shouldBe` "hello world"
275 testWidget (pure ()) checkValue $ do
296 testWidget (pure ()) checkValue $ do
276 e <- inputElement def
297 e <- inputElement def
277 click <- button "save"
298 click <- button "save"
278 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
299 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
279− it "sets focus appropriately" $ do
300+ it "sets focus appropriately" $ runWD $ do
280 focusRef <- newRef False
301 focusRef <- newRef False
281 let checkValue = do
302 let checkValue = do
282− liftIO $ readRef focusRef >>= flip shouldBe False
303+ readRef focusRef >>= flip shouldBe False
283 e <- WD.findElem $ WD.ByTag "input"
304 e <- WD.findElem $ WD.ByTag "input"
284 WD.click e
305 WD.click e
285 liftIO $ threadDelay 100000
306 liftIO $ threadDelay 100000
286− liftIO $ readRef focusRef >>= flip shouldBe True
307+ readRef focusRef >>= flip shouldBe True
287 testWidget (pure ()) checkValue $ do
308 testWidget (pure ()) checkValue $ do
288 e <- inputElement def
309 e <- inputElement def
289 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
310 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
291 focusRef <- newRef False
312 focusRef <- newRef False
292 let setup = do
313 let setup = do
293 e <- WD.findElem $ WD.ByTag "input"
314 e <- WD.findElem $ WD.ByTag "input"
294 WD.click e
315 WD.click e
295 hasFocus <- (== e) <$> WD.activeElem
316 hasFocus <- (== e) <$> WD.activeElem
297− hasFocus `shouldBe` True
317+ hasFocus `shouldBe` True
298− readRef focusRef >>= flip shouldBe False
318+ readRef focusRef >>= flip shouldBe False
299− check = liftIO $ readRef focusRef >>= flip shouldBe True
319+ check = readRef focusRef >>= flip shouldBe True
300 testWidget setup check $ do
320 testWidget setup check $ do
301 e <- inputElement def
321 e <- inputElement def
302 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
322 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
303− it "sets value appropriately" $ do
323+ it "sets value appropriately" $ runWD $ do
304 valueByUIRef <- newRef ("" :: Text)
324 valueByUIRef <- newRef ("" :: Text)
305 valueRef <- newRef ("" :: Text)
325 valueRef <- newRef ("" :: Text)
306− setValueChan :: Chan Text <- newChan
326+ setValueChan :: Chan Text <- liftIO newChan
307 let checkValue = do
327 let checkValue = do
308− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
328+ readRef valueByUIRef >>= flip shouldBe ""
309− liftIO $ readRef valueRef >>= flip shouldBe ""
329+ readRef valueRef >>= flip shouldBe ""
310 e <- WD.findElem $ WD.ByTag "input"
330 e <- WD.findElem $ WD.ByTag "input"
311 WD.sendKeys "hello" e
331 WD.sendKeys "hello" e
313− threadDelay 100000
332+ liftIO $ threadDelay 100000
314− readRef valueByUIRef >>= flip shouldBe "hello"
333+ readRef valueByUIRef >>= flip shouldBe "hello"
315− readRef valueRef >>= flip shouldBe "hello"
334+ readRef valueRef >>= flip shouldBe "hello"
316− writeChan setValueChan "world"
335+ liftIO $ writeChan setValueChan "world"
317− threadDelay 100000
336+ liftIO $ threadDelay 100000
318− readRef valueByUIRef >>= flip shouldBe "hello"
337+ readRef valueByUIRef >>= flip shouldBe "hello"
319− readRef valueRef >>= flip shouldBe "world"
338+ readRef valueRef >>= flip shouldBe "world"
320 testWidget (pure ()) checkValue $ do
339 testWidget (pure ()) checkValue $ do
321 update <- triggerEventWithChan setValueChan
340 update <- triggerEventWithChan setValueChan
322 e <- inputElement $ def & inputElementConfig_setValue .~ update
341 e <- inputElement $ def & inputElementConfig_setValue .~ update
323− performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
342+ performEvent_ $ liftIO . (writeRef valueByUIRef) <$> _inputElement_input e
324− performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
343+ performEvent_ $ liftIO . (writeRef valueRef) <$> updated (value e)
325− it "sets checked appropriately" $ do
344+ it "sets checked appropriately" $ runWD $ do
326 checkedByUIRef <- newRef False
345 checkedByUIRef <- newRef False
327 checkedRef <- newRef False
346 checkedRef <- newRef False
328− setCheckedChan <- newChan
347+ setCheckedChan <- liftIO newChan
329 let checkValue = do
348 let checkValue = do
330− liftIO $ readRef checkedByUIRef >>= flip shouldBe False
349+ readRef checkedByUIRef >>= flip shouldBe False
331− liftIO $ readRef checkedRef >>= flip shouldBe False
350+ readRef checkedRef >>= flip shouldBe False
332 e <- WD.findElem $ WD.ByTag "input"
351 e <- WD.findElem $ WD.ByTag "input"
333 WD.moveToCenter e
352 WD.moveToCenter e
334 WD.click e
353 WD.click e
336− threadDelay 100000
354+ liftIO $ threadDelay 100000
337− readRef checkedByUIRef >>= flip shouldBe True
355+ readRef checkedByUIRef >>= flip shouldBe True
338− readRef checkedRef >>= flip shouldBe True
356+ readRef checkedRef >>= flip shouldBe True
339− writeChan setCheckedChan False
357+ liftIO $ writeChan setCheckedChan False
340− threadDelay 100000
358+ liftIO $ threadDelay 100000
341− readRef checkedByUIRef >>= flip shouldBe True
359+ readRef checkedByUIRef >>= flip shouldBe True
342− readRef checkedRef >>= flip shouldBe False
360+ readRef checkedRef >>= flip shouldBe False
343 testWidget (pure ()) checkValue $ do
361 testWidget (pure ()) checkValue $ do
344 setChecked <- triggerEventWithChan setCheckedChan
362 setChecked <- triggerEventWithChan setCheckedChan
345 e <- inputElement $ def
363 e <- inputElement $ def
@@ -347,7 +365,7 @@ tests _selenium = do
347 & inputElementConfig_setChecked .~ setChecked
365 & inputElementConfig_setChecked .~ setChecked
348 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
366 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
349 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
367 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
350− it "captures file uploads" $ do
368+ it "captures file uploads" $ runWD $ do
351 filesRef :: IORef [Text] <- newRef []
369 filesRef :: IORef [Text] <- newRef []
352 let uploadFile = do
370 let uploadFile = do
353 e <- WD.findElem $ WD.ByTag "input"
371 e <- WD.findElem $ WD.ByTag "input"
@@ -355,8 +373,8 @@ tests _selenium = do
355 WD.sendKeys (T.pack path) e
373 WD.sendKeys (T.pack path) e
356 WD.click <=< WD.findElem $ WD.ByTag "button"
374 WD.click <=< WD.findElem $ WD.ByTag "button"
357 liftIO $ removeFile path
375 liftIO $ removeFile path
358− input <- liftIO $ readRef filesRef
376+ input <- readRef filesRef
359− liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
377+ input `shouldBe` [T.pack $ FilePath.takeFileName path]
360 testWidget (pure ()) uploadFile $ do
378 testWidget (pure ()) uploadFile $ do
361 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
379 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
362 click <- button "save"
380 click <- button "save"
@@ -364,70 +382,68 @@ tests _selenium = do
364 names <- liftJSM $ traverse File.getName fs
382 names <- liftJSM $ traverse File.getName fs
365 liftIO $ writeRef filesRef names
383 liftIO $ writeRef filesRef names
367− describe "hydration/immediate" $ do
385+ describe "hydration/immediate" $ session' $ do
368− it "captures user input after switchover" $ do
386+ it "captures user input after switchover" $ runWD $ do
369 inputRef :: IORef Text <- newRef ""
387 inputRef :: IORef Text <- newRef ""
370 let checkValue = do
388 let checkValue = do
371 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
389 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
372 WD.click <=< WD.findElem $ WD.ByTag "button"
390 WD.click <=< WD.findElem $ WD.ByTag "button"
373− input <- liftIO $ readRef inputRef
391+ input <- readRef inputRef
374− liftIO $ input `shouldBe` "hello world"
392+ input `shouldBe` "hello world"
375 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
393 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
376 e <- inputElement def
394 e <- inputElement def
377 click <- button "save"
395 click <- button "save"
378 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
396 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
379− it "sets focus appropriately" $ do
397+ it "sets focus appropriately" $ runWD $ do
380 focusRef <- newRef False
398 focusRef <- newRef False
381 let checkValue = do
399 let checkValue = do
382− liftIO $ readRef focusRef >>= flip shouldBe False
400+ readRef focusRef >>= flip shouldBe False
383 e <- WD.findElem $ WD.ByTag "input"
401 e <- WD.findElem $ WD.ByTag "input"
384 WD.click e
402 WD.click e
385 liftIO $ threadDelay 100000
403 liftIO $ threadDelay 100000
386− liftIO $ readRef focusRef >>= flip shouldBe True
404+ readRef focusRef >>= flip shouldBe True
387 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
405 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
388 e <- inputElement def
406 e <- inputElement def
389 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
407 performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
390− it "sets value appropriately" $ do
408+ it "sets value appropriately" $ runWD $ do
391 valueByUIRef :: IORef Text <- newRef ""
409 valueByUIRef :: IORef Text <- newRef ""
392 valueRef :: IORef Text <- newRef ""
410 valueRef :: IORef Text <- newRef ""
393− setValueChan :: Chan Text <- newChan
411+ setValueChan :: Chan Text <- liftIO newChan
394 let checkValue = do
412 let checkValue = do
395− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
413+ readRef valueByUIRef >>= flip shouldBe ""
396− liftIO $ readRef valueRef >>= flip shouldBe ""
414+ readRef valueRef >>= flip shouldBe ""
397 e <- WD.findElem $ WD.ByTag "input"
415 e <- WD.findElem $ WD.ByTag "input"
398 WD.sendKeys "hello" e
416 WD.sendKeys "hello" e
400− threadDelay 100000
417+ liftIO $ threadDelay 100000
401− readRef valueByUIRef >>= flip shouldBe "hello"
418+ readRef valueByUIRef >>= flip shouldBe "hello"
402− readRef valueRef >>= flip shouldBe "hello"
419+ readRef valueRef >>= flip shouldBe "hello"
403− writeChan setValueChan "world"
420+ liftIO $ writeChan setValueChan "world"
404− threadDelay 100000
421+ liftIO $ threadDelay 100000
405− readRef valueByUIRef >>= flip shouldBe "hello"
422+ readRef valueByUIRef >>= flip shouldBe "hello"
406− readRef valueRef >>= flip shouldBe "world"
423+ readRef valueRef >>= flip shouldBe "world"
407 testWidget (pure ()) checkValue $ do
424 testWidget (pure ()) checkValue $ do
408 update <- triggerEventWithChan setValueChan
425 update <- triggerEventWithChan setValueChan
409 prerender_ (pure ()) $ do
426 prerender_ (pure ()) $ do
410 e <- inputElement $ def & inputElementConfig_setValue .~ update
427 e <- inputElement $ def & inputElementConfig_setValue .~ update
411 performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
428 performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
412 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
429 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
413− it "sets checked appropriately" $ do
430+ it "sets checked appropriately" $ runWD $ do
414 checkedByUIRef <- newRef False
431 checkedByUIRef <- newRef False
415 checkedRef <- newRef False
432 checkedRef <- newRef False
416− setCheckedChan <- newChan
433+ setCheckedChan <- liftIO newChan
417 let checkValue = do
434 let checkValue = do
418− liftIO $ readRef checkedByUIRef >>= flip shouldBe False
435+ readRef checkedByUIRef >>= flip shouldBe False
419− liftIO $ readRef checkedRef >>= flip shouldBe False
436+ readRef checkedRef >>= flip shouldBe False
420 e <- WD.findElem $ WD.ByTag "input"
437 e <- WD.findElem $ WD.ByTag "input"
421 WD.moveToCenter e
438 WD.moveToCenter e
422 WD.click e
439 WD.click e
424− threadDelay 100000
440+ liftIO $ threadDelay 100000
425− readRef checkedByUIRef >>= flip shouldBe True
441+ readRef checkedByUIRef >>= flip shouldBe True
426− readRef checkedRef >>= flip shouldBe True
442+ readRef checkedRef >>= flip shouldBe True
427− writeChan setCheckedChan False
443+ liftIO $ writeChan setCheckedChan False
428− threadDelay 100000
444+ liftIO $ threadDelay 100000
429− readRef checkedByUIRef >>= flip shouldBe True
445+ readRef checkedByUIRef >>= flip shouldBe True
430− readRef checkedRef >>= flip shouldBe False
446+ readRef checkedRef >>= flip shouldBe False
431 testWidget (pure ()) checkValue $ do
447 testWidget (pure ()) checkValue $ do
432 setChecked <- triggerEventWithChan setCheckedChan
448 setChecked <- triggerEventWithChan setCheckedChan
433 prerender_ (pure ()) $ do
449 prerender_ (pure ()) $ do
@@ -436,7 +452,7 @@ tests _selenium = do
436 & inputElementConfig_setChecked .~ setChecked
452 & inputElementConfig_setChecked .~ setChecked
437 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
453 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
438 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
454 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
439− it "captures file uploads" $ do
455+ it "captures file uploads" $ runWD $ do
440 filesRef :: IORef [Text] <- newRef []
456 filesRef :: IORef [Text] <- newRef []
441 let uploadFile = do
457 let uploadFile = do
442 e <- WD.findElem $ WD.ByTag "input"
458 e <- WD.findElem $ WD.ByTag "input"
@@ -445,7 +461,7 @@ tests _selenium = do
445 WD.click <=< WD.findElem $ WD.ByTag "button"
461 WD.click <=< WD.findElem $ WD.ByTag "button"
446 liftIO $ removeFile path
462 liftIO $ removeFile path
447 input <- liftIO $ readRef filesRef
463 input <- liftIO $ readRef filesRef
448− liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
464+ input `shouldBe` [T.pack $ FilePath.takeFileName path]
449 testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
465 testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
450 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
466 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
451 click <- button "save"
467 click <- button "save"
@@ -454,8 +470,8 @@ tests _selenium = do
454 liftIO $ writeRef filesRef names
470 liftIO $ writeRef filesRef names
456 describe "textAreaElement" $ do
472 describe "textAreaElement" $ do
457− describe "hydration" $ do
473+ describe "hydration" $ session' $ do
458− it "doesn't wipe user input when switching over" $ do
474+ it "doesn't wipe user input when switching over" $ runWD $ do
459 inputRef <- newRef ("" :: Text)
475 inputRef <- newRef ("" :: Text)
460 testWidget'
476 testWidget'
@@ -464,112 +480,109 @@ tests _selenium = do
465 (\e -> do
481 (\e -> do
466 t <- WD.attr e "value"
482 t <- WD.attr e "value"
467− liftIO $ t `shouldBe` Just "hello world"
483+ t `shouldBe` Just "hello world"
468 WD.click <=< WD.findElem $ WD.ByTag "button"
484 WD.click <=< WD.findElem $ WD.ByTag "button"
469− input <- liftIO $ readRef inputRef
485+ input <- readRef inputRef
470− liftIO $ input `shouldBe` "hello world"
486+ input `shouldBe` "hello world"
472 e <- textAreaElement def
488 e <- textAreaElement def
473 click <- button "save"
489 click <- button "save"
474 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
490 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
476 inputRef <- newRef ("" :: Text)
492 inputRef <- newRef ("" :: Text)
477 let checkValue = do
493 let checkValue = do
478 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
494 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
479 WD.click <=< WD.findElem $ WD.ByTag "button"
495 WD.click <=< WD.findElem $ WD.ByTag "button"
480− input <- liftIO $ readRef inputRef
496+ input <- readRef inputRef
481− liftIO $ input `shouldBe` "hello world"
497+ input `shouldBe` "hello world"
482 testWidget (pure ()) checkValue $ do
498 testWidget (pure ()) checkValue $ do
483 e <- textAreaElement def
499 e <- textAreaElement def
484 click <- button "save"
500 click <- button "save"
485 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
501 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
486− it "sets focus appropriately" $ do
502+ it "sets focus appropriately" $ runWD $ do
487 focusRef <- newRef False
503 focusRef <- newRef False
488 let checkValue = do
504 let checkValue = do
489− liftIO $ readRef focusRef >>= flip shouldBe False
505+ readRef focusRef >>= flip shouldBe False
490 e <- WD.findElem $ WD.ByTag "textarea"
506 e <- WD.findElem $ WD.ByTag "textarea"
491 WD.click e
507 WD.click e
492 liftIO $ threadDelay 100000
508 liftIO $ threadDelay 100000
493− liftIO $ readRef focusRef >>= flip shouldBe True
509+ readRef focusRef >>= flip shouldBe True
494 testWidget (pure ()) checkValue $ do
510 testWidget (pure ()) checkValue $ do
495 e <- textAreaElement def
511 e <- textAreaElement def
496 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
512 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
498 focusRef <- newRef False
514 focusRef <- newRef False
499 let setup = do
515 let setup = do
500 e <- WD.findElem $ WD.ByTag "textarea"
516 e <- WD.findElem $ WD.ByTag "textarea"
501 WD.click e
517 WD.click e
502 hasFocus <- (== e) <$> WD.activeElem
518 hasFocus <- (== e) <$> WD.activeElem
504− hasFocus `shouldBe` True
519+ hasFocus `shouldBe` True
505− readRef focusRef >>= flip shouldBe False
520+ readRef focusRef >>= flip shouldBe False
506− check = liftIO $ readRef focusRef >>= flip shouldBe True
521+ check = readRef focusRef >>= flip shouldBe True
507 testWidget setup check $ do
522 testWidget setup check $ do
508 e <- textAreaElement def
523 e <- textAreaElement def
509 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
524 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
510− it "sets value appropriately" $ do
525+ it "sets value appropriately" $ runWD $ do
511 valueByUIRef <- newRef ("" :: Text)
526 valueByUIRef <- newRef ("" :: Text)
512 valueRef <- newRef ("" :: Text)
527 valueRef <- newRef ("" :: Text)
513− setValueChan :: Chan Text <- newChan
528+ setValueChan :: Chan Text <- liftIO newChan
514 let checkValue = do
529 let checkValue = do
515− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
530+ readRef valueByUIRef >>= flip shouldBe ""
516− liftIO $ readRef valueRef >>= flip shouldBe ""
531+ readRef valueRef >>= flip shouldBe ""
517 e <- WD.findElem $ WD.ByTag "textarea"
532 e <- WD.findElem $ WD.ByTag "textarea"
518 WD.sendKeys "hello" e
533 WD.sendKeys "hello" e
520− threadDelay 100000
534+ liftIO $ threadDelay 100000
521− readRef valueByUIRef >>= flip shouldBe "hello"
535+ readRef valueByUIRef >>= flip shouldBe "hello"
522− readRef valueRef >>= flip shouldBe "hello"
536+ readRef valueRef >>= flip shouldBe "hello"
523− writeChan setValueChan "world"
537+ liftIO $ writeChan setValueChan "world"
524− threadDelay 100000
538+ liftIO $ threadDelay 100000
525− readRef valueByUIRef >>= flip shouldBe "hello"
539+ readRef valueByUIRef >>= flip shouldBe "hello"
526− readRef valueRef >>= flip shouldBe "world"
540+ readRef valueRef >>= flip shouldBe "world"
527 testWidget (pure ()) checkValue $ do
541 testWidget (pure ()) checkValue $ do
528 setValue' <- triggerEventWithChan setValueChan
542 setValue' <- triggerEventWithChan setValueChan
529 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
543 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
530 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
544 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
531 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
545 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
533− describe "hydration/immediate" $ do
547+ describe "hydration/immediate" $ session' $ do
534− it "captures user input after switchover" $ do
548+ it "captures user input after switchover" $ runWD $ do
535 inputRef :: IORef Text <- newRef ""
549 inputRef :: IORef Text <- newRef ""
536 let checkValue = do
550 let checkValue = do
537 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
551 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
538 WD.click <=< WD.findElem $ WD.ByTag "button"
552 WD.click <=< WD.findElem $ WD.ByTag "button"
539 input <- liftIO $ readRef inputRef
553 input <- liftIO $ readRef inputRef
540− liftIO $ input `shouldBe` "hello world"
554+ input `shouldBe` "hello world"
541 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
555 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
542 e <- textAreaElement def
556 e <- textAreaElement def
543 click <- button "save"
557 click <- button "save"
544 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
558 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
545− it "sets focus appropriately" $ do
559+ it "sets focus appropriately" $ runWD $ do
546 focusRef <- newRef False
560 focusRef <- newRef False
547 let checkValue = do
561 let checkValue = do
548− liftIO $ readRef focusRef >>= flip shouldBe False
562+ readRef focusRef >>= flip shouldBe False
549 e <- WD.findElem $ WD.ByTag "textarea"
563 e <- WD.findElem $ WD.ByTag "textarea"
550 WD.click e
564 WD.click e
551 liftIO $ threadDelay 100000
565 liftIO $ threadDelay 100000
552− liftIO $ readRef focusRef >>= flip shouldBe True
566+ readRef focusRef >>= flip shouldBe True
553 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
567 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
554 e <- textAreaElement def
568 e <- textAreaElement def
555 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
569 performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
556− it "sets value appropriately" $ do
570+ it "sets value appropriately" $ runWD $ do
557 valueByUIRef :: IORef Text <- newRef ""
571 valueByUIRef :: IORef Text <- newRef ""
558 valueRef :: IORef Text <- newRef ""
572 valueRef :: IORef Text <- newRef ""
559− setValueChan :: Chan Text <- newChan
573+ setValueChan :: Chan Text <- liftIO newChan
560 let checkValue = do
574 let checkValue = do
561− liftIO $ readRef valueByUIRef >>= flip shouldBe ""
575+ readRef valueByUIRef >>= flip shouldBe ""
562− liftIO $ readRef valueRef >>= flip shouldBe ""
576+ readRef valueRef >>= flip shouldBe ""
563 e <- WD.findElem $ WD.ByTag "textarea"
577 e <- WD.findElem $ WD.ByTag "textarea"
564 WD.sendKeys "hello" e
578 WD.sendKeys "hello" e
566− threadDelay 100000
579+ liftIO $ threadDelay 100000
567− readRef valueByUIRef >>= flip shouldBe "hello"
580+ readRef valueByUIRef >>= flip shouldBe "hello"
568− readRef valueRef >>= flip shouldBe "hello"
581+ readRef valueRef >>= flip shouldBe "hello"
569− writeChan setValueChan "world"
582+ liftIO $ writeChan setValueChan "world"
570− threadDelay 100000
583+ liftIO $ threadDelay 100000
571− readRef valueByUIRef >>= flip shouldBe "hello"
584+ readRef valueByUIRef >>= flip shouldBe "hello"
572− readRef valueRef >>= flip shouldBe "world"
585+ readRef valueRef >>= flip shouldBe "world"
573 testWidget (pure ()) checkValue $ do
586 testWidget (pure ()) checkValue $ do
574 setValue' <- triggerEventWithChan setValueChan
587 setValue' <- triggerEventWithChan setValueChan
575 prerender_ (pure ()) $ do
588 prerender_ (pure ()) $ do
@@ -583,8 +596,8 @@ tests _selenium = do
583 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
596 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
584 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
597 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
585 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
598 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
586− describe "hydration" $ do
599+ describe "hydration" $ session' $ do
587− it "sets initial value correctly" $ do
600+ it "sets initial value correctly" $ runWD $ do
588 inputRef <- newRef ("" :: Text)
601 inputRef <- newRef ("" :: Text)
589 let setup = do
602 let setup = do
590 e <- WD.findElem $ WD.ByTag "select"
603 e <- WD.findElem $ WD.ByTag "select"
@@ -593,16 +606,16 @@ tests _selenium = do
594 check e = do
607 check e = do
595 assertAttr e "value" (Just "two")
608 assertAttr e "value" (Just "two")
596− liftIO $ readRef inputRef >>= (`shouldBe` "three")
609+ readRef inputRef >>= (`shouldBe` "three")
597 WD.click <=< WD.findElem $ WD.ByTag "button"
610 WD.click <=< WD.findElem $ WD.ByTag "button"
598 assertAttr e "value" (Just "two")
611 assertAttr e "value" (Just "two")
599− liftIO $ readRef inputRef >>= (`shouldBe` "two")
612+ readRef inputRef >>= (`shouldBe` "two")
600 testWidget' setup check $ do
613 testWidget' setup check $ do
601 (e, ()) <- selectElement (def { _selectElementConfig_initialValue = "three" }) options
614 (e, ()) <- selectElement (def { _selectElementConfig_initialValue = "three" }) options
602 click <- button "save"
615 click <- button "save"
603 liftIO . writeRef inputRef <=< sample $ current $ _selectElement_value e
616 liftIO . writeRef inputRef <=< sample $ current $ _selectElement_value e
604 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
617 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
606 inputRef <- newRef ("" :: Text)
619 inputRef <- newRef ("" :: Text)
607 let checkValue = do
620 let checkValue = do
608 e <- WD.findElem $ WD.ByTag "select"
621 e <- WD.findElem $ WD.ByTag "select"
@@ -610,97 +623,94 @@ tests _selenium = do
610 WD.click <=< WD.findElem $ WD.ById "two"
623 WD.click <=< WD.findElem $ WD.ById "two"
611 assertAttr e "value" (Just "two")
624 assertAttr e "value" (Just "two")
612 WD.click <=< WD.findElem $ WD.ByTag "button"
625 WD.click <=< WD.findElem $ WD.ByTag "button"
613− liftIO $ readRef inputRef >>= (`shouldBe` "two")
626+ readRef inputRef >>= (`shouldBe` "two")
614 testWidget (pure ()) checkValue $ do
627 testWidget (pure ()) checkValue $ do
615 (e, ()) <- selectElement def options
628 (e, ()) <- selectElement def options
616 click <- button "save"
629 click <- button "save"
617 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
630 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
618− it "sets focus appropriately" $ do
631+ it "sets focus appropriately" $ runWD $ do
619 focusRef <- newRef False
632 focusRef <- newRef False
620 let checkValue = do
633 let checkValue = do
621− liftIO $ readRef focusRef >>= flip shouldBe False
634+ readRef focusRef >>= flip shouldBe False
622 e <- WD.findElem $ WD.ByTag "select"
635 e <- WD.findElem $ WD.ByTag "select"
623 WD.click e
636 WD.click e
624 liftIO $ threadDelay 100000
637 liftIO $ threadDelay 100000
625− liftIO $ readRef focusRef >>= flip shouldBe True
638+ readRef focusRef >>= flip shouldBe True
626 testWidget (pure ()) checkValue $ do
639 testWidget (pure ()) checkValue $ do
627 (e, ()) <- selectElement def options
640 (e, ()) <- selectElement def options
628 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
641 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
630 focusRef <- newRef False
643 focusRef <- newRef False
631 let setup = do
644 let setup = do
632 e <- WD.findElem $ WD.ByTag "select"
645 e <- WD.findElem $ WD.ByTag "select"
633 WD.click e
646 WD.click e
634 hasFocus <- (== e) <$> WD.activeElem
647 hasFocus <- (== e) <$> WD.activeElem
636− hasFocus `shouldBe` True
648+ hasFocus `shouldBe` True
637− readRef focusRef >>= flip shouldBe False
649+ readRef focusRef >>= flip shouldBe False
638− check = liftIO $ readRef focusRef >>= flip shouldBe True
650+ check = readRef focusRef >>= flip shouldBe True
639 testWidget setup check $ do
651 testWidget setup check $ do
640 (e, ()) <- selectElement def options
652 (e, ()) <- selectElement def options
641 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
653 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
642− it "sets value appropriately" $ do
654+ it "sets value appropriately" $ runWD $ do
643 valueByUIRef <- newRef ("" :: Text)
655 valueByUIRef <- newRef ("" :: Text)
644 valueRef <- newRef ("" :: Text)
656 valueRef <- newRef ("" :: Text)
645− setValueChan :: Chan Text <- newChan
657+ setValueChan :: Chan Text <- liftIO newChan
646 let checkValue = do
658 let checkValue = do
647 e <- WD.findElem $ WD.ByTag "select"
659 e <- WD.findElem $ WD.ByTag "select"
648 assertAttr e "value" (Just "one")
660 assertAttr e "value" (Just "one")
649− liftIO $ readRef valueByUIRef >>= flip shouldBe "one"
661+ readRef valueByUIRef >>= flip shouldBe "one"
650− liftIO $ readRef valueRef >>= flip shouldBe "one"
662+ readRef valueRef >>= flip shouldBe "one"
651 WD.click <=< WD.findElem $ WD.ById "two"
663 WD.click <=< WD.findElem $ WD.ById "two"
653− threadDelay 100000
664+ liftIO $ threadDelay 100000
654− readRef valueByUIRef >>= flip shouldBe "two"
665+ readRef valueByUIRef >>= flip shouldBe "two"
655− readRef valueRef >>= flip shouldBe "two"
666+ readRef valueRef >>= flip shouldBe "two"
656− writeChan setValueChan "three"
667+ liftIO $ writeChan setValueChan "three"
657− threadDelay 100000
668+ liftIO $ threadDelay 100000
658− readRef valueByUIRef >>= flip shouldBe "two"
669+ readRef valueByUIRef >>= flip shouldBe "two"
659− readRef valueRef >>= flip shouldBe "three"
670+ readRef valueRef >>= flip shouldBe "three"
660 testWidget (pure ()) checkValue $ do
671 testWidget (pure ()) checkValue $ do
661 setValue' <- triggerEventWithChan setValueChan
672 setValue' <- triggerEventWithChan setValueChan
662 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
673 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
663 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
674 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
664 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
675 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
666− describe "hydration/immediate" $ do
677+ describe "hydration/immediate" $ session' $ do
667− it "captures user input after switchover" $ do
678+ it "captures user input after switchover" $ runWD $ do
668 inputRef :: IORef Text <- newRef ""
679 inputRef :: IORef Text <- newRef ""
669 let checkValue = do
680 let checkValue = do
670 WD.click <=< WD.findElem $ WD.ById "two"
681 WD.click <=< WD.findElem $ WD.ById "two"
671 WD.click <=< WD.findElem $ WD.ByTag "button"
682 WD.click <=< WD.findElem $ WD.ByTag "button"
672− liftIO $ readRef inputRef >>= flip shouldBe "two"
683+ readRef inputRef >>= flip shouldBe "two"
673 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
684 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
674 (e, ()) <- selectElement def options
685 (e, ()) <- selectElement def options
675 click <- button "save"
686 click <- button "save"
676 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
687 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
677− it "sets focus appropriately" $ do
688+ it "sets focus appropriately" $ runWD $ do
678 focusRef <- newRef False
689 focusRef <- newRef False
679 let checkValue = do
690 let checkValue = do
680− liftIO $ readRef focusRef >>= flip shouldBe False
691+ readRef focusRef >>= flip shouldBe False
681 e <- WD.findElem $ WD.ByTag "select"
692 e <- WD.findElem $ WD.ByTag "select"
682 WD.click e
693 WD.click e
683 liftIO $ threadDelay 100000
694 liftIO $ threadDelay 100000
684− liftIO $ readRef focusRef >>= flip shouldBe True
695+ readRef focusRef >>= flip shouldBe True
685 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
696 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
686 (e, ()) <- selectElement def options
697 (e, ()) <- selectElement def options
687 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
698 performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
688− it "sets value appropriately" $ do
699+ it "sets value appropriately" $ runWD $ do
689 valueByUIRef :: IORef Text <- newRef ""
700 valueByUIRef :: IORef Text <- newRef ""
690 valueRef :: IORef Text <- newRef ""
701 valueRef :: IORef Text <- newRef ""
691− setValueChan :: Chan Text <- newChan
702+ setValueChan :: Chan Text <- liftIO newChan
692 let checkValue = do
703 let checkValue = do
693− liftIO $ readRef valueByUIRef >>= flip shouldBe "one"
704+ readRef valueByUIRef >>= flip shouldBe "one"
694− liftIO $ readRef valueRef >>= flip shouldBe "one"
705+ readRef valueRef >>= flip shouldBe "one"
695 WD.click <=< WD.findElem $ WD.ById "two"
706 WD.click <=< WD.findElem $ WD.ById "two"
697− threadDelay 100000
707+ liftIO $ threadDelay 100000
698− readRef valueByUIRef >>= flip shouldBe "two"
708+ readRef valueByUIRef >>= flip shouldBe "two"
699− readRef valueRef >>= flip shouldBe "two"
709+ readRef valueRef >>= flip shouldBe "two"
700− writeChan setValueChan "three"
710+ liftIO $ writeChan setValueChan "three"
701− threadDelay 100000
711+ liftIO $ threadDelay 100000
702− readRef valueByUIRef >>= flip shouldBe "two"
712+ readRef valueByUIRef >>= flip shouldBe "two"
703− readRef valueRef >>= flip shouldBe "three"
713+ readRef valueRef >>= flip shouldBe "three"
704 testWidget (pure ()) checkValue $ do
714 testWidget (pure ()) checkValue $ do
705 setValue' <- triggerEventWithChan setValueChan
715 setValue' <- triggerEventWithChan setValueChan
706 prerender_ (pure ()) $ do
716 prerender_ (pure ()) $ do
@@ -708,30 +718,30 @@ tests _selenium = do
708 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
718 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
709 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
719 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
711− describe "prerender" $ do
721+ describe "prerender" $ session' $ do
712− it "works in simple case" $ do
722+ it "works in simple case" $ runWD $ do
713 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
723 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
714 prerender_ (text "One") (text "Two")
724 prerender_ (text "One") (text "Two")
715− it "removes element correctly" $ do
725+ it "removes element correctly" $ runWD $ do
716 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
726 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
717 prerender_ (el "span" $ text "One") (text "Two")
727 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
719 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
729 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
720 prerender_ (prerender_ (text "One") (text "Two")) (text "Three")
730 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
722 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
732 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
723 prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
733 prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
724− it "works with prerender_ siblings" $ do
734+ it "works with prerender_ siblings" $ runWD $ do
725 testWidget
735 testWidget
726 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
736 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
727 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
737 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
728 prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
738 prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
729 prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
739 prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
730 prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
740 prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
731− it "works inside other element" $ do
741+ it "works inside other element" $ runWD $ do
732 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
742 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
733 el "div" $ prerender_ (text "One") (text "Two")
743 el "div" $ prerender_ (text "One") (text "Two")
734− it "places fences and removes them" $ do
744+ it "places fences and removes them" $ runWD $ do
735 testWidget'
745 testWidget'
737 scripts <- WD.findElems $ WD.ByTag "script"
747 scripts <- WD.findElems $ WD.ByTag "script"
@@ -739,19 +749,19 @@ tests _selenium = do
740 (traverse_ elementShouldBeRemoved)
750 (traverse_ elementShouldBeRemoved)
741 (el "span" $ prerender_ (text "One") (text "Two"))
751 (el "span" $ prerender_ (text "One") (text "Two"))
742− it "postBuild works on server side" $ do
752+ it "postBuild works on server side" $ runWD $ do
743− lock :: MVar () <- newEmptyMVar
753+ lock :: MVar () <- liftIO newEmptyMVar
744 testWidget (liftIO $ takeMVar lock) (pure ()) $ do
754 testWidget (liftIO $ takeMVar lock) (pure ()) $ do
745 prerender_ (do
755 prerender_ (do
746 pb <- getPostBuild
756 pb <- getPostBuild
747 performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
757 performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
748− it "postBuild works on client side" $ do
758+ it "postBuild works on client side" $ runWD $ do
749− lock :: MVar () <- newEmptyMVar
759+ lock :: MVar () <- liftIO newEmptyMVar
750 testWidget (pure ()) (liftIO $ takeMVar lock) $ do
760 testWidget (pure ()) (liftIO $ takeMVar lock) $ do
751 prerender_ blank $ do
761 prerender_ blank $ do
752 pb <- getPostBuild
762 pb <- getPostBuild
753 performEvent_ $ liftIO (putMVar lock ()) <$ pb
763 performEvent_ $ liftIO (putMVar lock ()) <$ pb
754− it "result Dynamic is updated *after* switchover" $ do
764+ it "result Dynamic is updated *after* switchover" $ runWD $ do
755 let static = shouldContainText "PostBuild" =<< WD.findElem (WD.ByTag "body")
765 let static = shouldContainText "PostBuild" =<< WD.findElem (WD.ByTag "body")
756 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
766 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
757 testWidget static check $ void $ do
767 testWidget static check $ void $ do
@@ -761,14 +771,14 @@ tests _selenium = do
761 textNode $ TextNodeConfig initial $ Just $ leftmost [updated d, "PostBuild" <$ pb]
771 textNode $ TextNodeConfig initial $ Just $ leftmost [updated d, "PostBuild" <$ pb]
762 -- This essentially checks that the client IO runs *after* switchover/postBuild,
772 -- This essentially checks that the client IO runs *after* switchover/postBuild,
763 -- thus can't create conflicting DOM
773 -- 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
765 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
775 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
766 testWidgetStatic static $ void $ do
776 testWidgetStatic static $ void $ do
767 ref <- liftIO $ newRef "Initial"
777 ref <- liftIO $ newRef "Initial"
768 prerender_ (pure ()) (liftIO $ writeRef ref "Client")
778 prerender_ (pure ()) (liftIO $ writeRef ref "Client")
769 text <=< liftIO $ readRef ref
779 text <=< liftIO $ readRef ref
770 -- As above, so below
780 -- 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
772 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
782 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
773 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
783 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
774 testWidget static check $ void $ do
784 testWidget static check $ void $ do
@@ -776,13 +786,13 @@ tests _selenium = do
776 prerender_ (pure ()) (liftIO $ trigger "Client")
786 prerender_ (pure ()) (liftIO $ trigger "Client")
777 textNode $ TextNodeConfig "Initial" $ Just e
787 textNode $ TextNodeConfig "Initial" $ Just e
779− describe "runWithReplace" $ do
789+ describe "runWithReplace" $ session' $ do
780− it "works" $ do
790+ it "works" $ runWD $ do
781− replaceChan :: Chan Text <- newChan
791+ replaceChan :: Chan Text <- liftIO newChan
782 let setup = WD.findElem $ WD.ByTag "div"
792 let setup = WD.findElem $ WD.ByTag "div"
783 check ssr = do
793 check ssr = do
784 -- Check that the original element still exists and has the correct text
794 -- 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"
786 liftIO $ do
796 liftIO $ do
787 writeChan replaceChan "three"
797 writeChan replaceChan "three"
788 threadDelay 100000
798 threadDelay 100000
@@ -795,12 +805,12 @@ tests _selenium = do
795 [ el "div" (text "two") <$ pb
805 [ el "div" (text "two") <$ pb
796 , el "span" . text <$> replace
806 , el "span" . text <$> replace
798− it "can be nested in initial widget" $ do
808+ it "can be nested in initial widget" $ runWD $ do
799− replaceChan :: Chan Text <- newChan
809+ replaceChan :: Chan Text <- liftIO newChan
800 let setup = WD.findElem $ WD.ByTag "div"
810 let setup = WD.findElem $ WD.ByTag "div"
801 check ssr = do
811 check ssr = do
802 -- Check that the original element still exists and has the correct text
812 -- 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"
804 liftIO $ do
814 liftIO $ do
805 writeChan replaceChan "three"
815 writeChan replaceChan "three"
806 threadDelay 100000
816 threadDelay 100000
@@ -813,12 +823,12 @@ tests _selenium = do
813 [ el "div" (text "two") <$ pb
823 [ el "div" (text "two") <$ pb
814 , el "span" . text <$> replace
824 , el "span" . text <$> replace
816− it "can be nested in postBuild widget" $ do
826+ it "can be nested in postBuild widget" $ runWD $ do
817− replaceChan <- newChan
827+ replaceChan <- liftIO newChan
818 let setup = WD.findElem $ WD.ByTag "div"
828 let setup = WD.findElem $ WD.ByTag "div"
819 check ssr = do
829 check ssr = do
820 -- Check that the original element still exists and has the correct text
830 -- 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"
822 liftIO $ do
832 liftIO $ do
823 writeChan replaceChan "three"
833 writeChan replaceChan "three"
824 threadDelay 100000
834 threadDelay 100000
@@ -833,9 +843,9 @@ tests _selenium = do
833 [ el "div" (text "two") <$ pb'
843 [ el "div" (text "two") <$ pb'
834 , el "span" . text <$> replace
844 , el "span" . text <$> replace
836− it "postBuild works in replaced widget" $ do
846+ it "postBuild works in replaced widget" $ runWD $ do
837− replaceChan <- newChan
847+ replaceChan <- liftIO newChan
838− pbLock <- newEmptyMVar
848+ pbLock <- liftIO newEmptyMVar
839 let check = do
849 let check = do
840 liftIO $ do
850 liftIO $ do
841 writeChan replaceChan ()
851 writeChan replaceChan ()
@@ -846,10 +856,11 @@ tests _selenium = do
846 runWithReplace (pure ()) $ ffor replace $ \() -> do
856 runWithReplace (pure ()) $ ffor replace $ \() -> do
847 pb <- getPostBuild
857 pb <- getPostBuild
848 performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
858 performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
849− it "can be nested in event widget" $ do -- Test is broken, I think
860+ it "can be nested in event widget" $ runWD $ do -- Test is broken, I think
850− replaceChan1 :: Chan Text <- newChan
861+ replaceChan1 :: Chan Text <- liftIO newChan
851− replaceChan2 :: Chan Text <- newChan
862+ replaceChan2 :: Chan Text <- liftIO newChan
852− lock :: MVar () <- newEmptyMVar
863+ lock :: MVar () <- liftIO newEmptyMVar
853 let check = do
864 let check = do
854 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
865 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
855 liftIO $ do
866 liftIO $ do
@@ -857,7 +868,7 @@ tests _selenium = do
857 threadDelay 100000
868 threadDelay 100000
858 takeMVar lock
869 takeMVar lock
859 one <- WD.findElem $ WD.ByTag "div"
870 one <- WD.findElem $ WD.ByTag "div"
860− WD.getText one >>= liftIO . flip shouldBe "pb"
871+ WD.getText one >>= flip shouldBe "pb"
861 liftIO $ do
872 liftIO $ do
862 writeChan replaceChan2 "two"
873 writeChan replaceChan2 "two"
863 threadDelay 100000
874 threadDelay 100000
@@ -873,12 +884,13 @@ tests _selenium = do
873 [ el "span" . text <$> replace2
884 [ el "span" . text <$> replace2
874 , el "div" (text "pb") <$ pb
885 , el "div" (text "pb") <$ pb
876− it "works in immediate mode (RHS of prerender)" $ do
888+ it "works in immediate mode (RHS of prerender)" $ runWD $ do
877− replaceChan :: Chan Text <- newChan
889+ replaceChan :: Chan Text <- liftIO newChan
878 let check = do
890 let check = do
879 one <- WD.findElem $ WD.ByTag "div"
891 one <- WD.findElem $ WD.ByTag "div"
880 shouldContainText "one" =<< WD.findElem (WD.ByTag "body")
892 shouldContainText "one" =<< WD.findElem (WD.ByTag "body")
881− WD.getText one >>= liftIO . flip shouldBe "one"
893+ WD.getText one >>= flip shouldBe "one"
882 liftIO $ do
894 liftIO $ do
883 writeChan replaceChan "pb"
895 writeChan replaceChan "pb"
884 threadDelay 100000
896 threadDelay 100000
@@ -888,12 +900,12 @@ tests _selenium = do
888 replace <- triggerEventWithChan replaceChan
900 replace <- triggerEventWithChan replaceChan
889 prerender_ blank $ do
901 prerender_ blank $ do
890 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
902 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
891− it "works with postBuild in immediate mode (RHS of prerender)" $ do
903+ it "works with postBuild in immediate mode (RHS of prerender)" $ runWD $ do
892− replaceChan :: Chan Text <- newChan
904+ replaceChan :: Chan Text <- liftIO newChan
893 let check = do
905 let check = do
894 two <- WD.findElem $ WD.ByTag "div"
906 two <- WD.findElem $ WD.ByTag "div"
895 shouldContainText "two" =<< WD.findElem (WD.ByTag "body")
907 shouldContainText "two" =<< WD.findElem (WD.ByTag "body")
896− WD.getText two >>= liftIO . flip shouldBe "two"
908+ WD.getText two >>= flip shouldBe "two"
897 liftIO $ do
909 liftIO $ do
898 writeChan replaceChan "three"
910 writeChan replaceChan "three"
899 threadDelay 100000
911 threadDelay 100000
@@ -908,7 +920,7 @@ tests _selenium = do
908 , el "span" . text <$> replace
920 , el "span" . text <$> replace
911− describe "traverseDMapWithKeyWithAdjust" $ do
923+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do
912 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
924 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
913 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
925 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
914 elClass "span" "key" $ text $ textKey k
926 elClass "span" "key" $ text $ textKey k
@@ -946,19 +958,21 @@ tests _selenium = do
946 e <- WD.findElem (WD.ById $ textKey k)
958 e <- WD.findElem (WD.ById $ textKey k)
947 checkItem e (textKey k) (T.pack $ show v)
959 checkItem e (textKey k) (T.pack $ show v)
948 postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
960 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
961+ it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
950− chan <- newChan
962+ chan <- liftIO newChan
963+ let static :: WD [WD.Element]
951− let static = getAndCheckInitialItems keyMap
964+ static = getAndCheckInitialItems keyMap
965+ check :: [WD.Element] -> WD ()
952 check xs = do
966 check xs = do
953 checkInitialItems keyMap xs
967 checkInitialItems keyMap xs
954 checkRemoval chan Key_Int
968 checkRemoval chan Key_Int
955 checkReplace chan Key_Char 'B'
969 checkReplace chan Key_Char 'B'
956 checkInsert chan Key_Bool True
970 checkInsert chan Key_Bool True
957− testWidget' static check $ void $ do
971+ testWidget' static check $ do
958 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
972 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
959− liftIO $ dmap `shouldBe` keyMap
973+ liftIO $ dmap `H.shouldBe` keyMap
960− it "handles postBuild correctly" $ do
974+ it "handles postBuild correctly" $ runWD $ do
961− chan <- newChan
975+ chan <- liftIO newChan
962 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
976 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
963 check xs = do
977 check xs = do
964 checkInitialItems (fromMaybe undefined $ apply postBuildPatch keyMap) xs
978 checkInitialItems (fromMaybe undefined $ apply postBuildPatch keyMap) xs
@@ -969,9 +983,9 @@ tests _selenium = do
969 pb <- getPostBuild
983 pb <- getPostBuild
970 replace <- triggerEventWithChan chan
984 replace <- triggerEventWithChan chan
971 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
985 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
972− liftIO $ dmap `shouldBe` keyMap
986+ liftIO $ dmap `H.shouldBe` keyMap
973− it "can delete/update/insert when built in prerender" $ do
987+ it "can delete/update/insert when built in prerender" $ runWD $ do
974− chan <- newChan
988+ chan <- liftIO newChan
975 let check = do
989 let check = do
976 _ <- getAndCheckInitialItems keyMap
990 _ <- getAndCheckInitialItems keyMap
977 checkRemoval chan Key_Int
991 checkRemoval chan Key_Int
@@ -981,9 +995,9 @@ tests _selenium = do
981 replace <- triggerEventWithChan chan
995 replace <- triggerEventWithChan chan
982 prerender_ (pure ()) $ do
996 prerender_ (pure ()) $ do
983 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
997 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
984− liftIO $ dmap `shouldBe` keyMap
998+ liftIO $ dmap `H.shouldBe` keyMap
985− it "can delete/update/insert when built in immediate mode" $ do
999+ it "can delete/update/insert when built in immediate mode" $ runWD $ do
986− chan <- newChan
1000+ chan <- liftIO newChan
987 let check = do
1001 let check = do
988 _ <- getAndCheckInitialItems keyMap
1002 _ <- getAndCheckInitialItems keyMap
989 checkRemoval chan Key_Int
1003 checkRemoval chan Key_Int
@@ -993,10 +1007,10 @@ tests _selenium = do
993 pb <- getPostBuild
1007 pb <- getPostBuild
994 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
1008 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
995 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
1009 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
996− liftIO $ dmap `shouldBe` keyMap
1010+ liftIO $ dmap `H.shouldBe` keyMap
997 -- Should be fixed by prerender changes!
1011 -- Should be fixed by prerender changes!
998− it "handles postBuild correctly in prerender" $ do
1012+ it "handles postBuild correctly in prerender" $ runWD $ do
999− chan <- newChan
1013+ chan <- liftIO newChan
1000 let check = do
1014 let check = do
1001 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
1015 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
1002 checkRemoval chan Key_Int
1016 checkRemoval chan Key_Int
@@ -1007,9 +1021,9 @@ tests _selenium = do
1007 prerender_ (pure ()) $ void $ do
1021 prerender_ (pure ()) $ void $ do
1008 pb <- getPostBuild
1022 pb <- getPostBuild
1009 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1023 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1010− liftIO $ dmap `shouldBe` keyMap
1024+ liftIO $ dmap `H.shouldBe` keyMap
1012− describe "traverseIntMapWithKeyWithAdjust" $ do
1026+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do
1013 let textKeyInt k = "key" <> T.pack (show k)
1027 let textKeyInt k = "key" <> T.pack (show k)
1014 intMap = IntMap.fromList
1028 intMap = IntMap.fromList
1015 [ (1, "one")
1029 [ (1, "one")
@@ -1053,8 +1067,8 @@ tests _selenium = do
1053 e <- WD.findElem (WD.ById $ textKeyInt k)
1067 e <- WD.findElem (WD.ById $ textKeyInt k)
1054 checkItem e (textKeyInt k) v
1068 checkItem e (textKeyInt k) v
1055 postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
1069 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
1070+ it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
1057− chan <- newChan
1071+ chan <- liftIO newChan
1058 let static = getAndCheckInitialItems intMap
1072 let static = getAndCheckInitialItems intMap
1059 check xs = do
1073 check xs = do
1060 checkInitialItems intMap xs
1074 checkInitialItems intMap xs
@@ -1063,9 +1077,9 @@ tests _selenium = do
1063 checkInsert chan 4 "four"
1077 checkInsert chan 4 "four"
1064 testWidget' static check $ void $ do
1078 testWidget' static check $ void $ do
1065 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1079 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1066− liftIO $ im `shouldBe` intMap
1080+ liftIO $ im `H.shouldBe` intMap
1067− it "handles postBuild correctly" $ do
1081+ it "handles postBuild correctly" $ runWD $ do
1068− chan <- newChan
1082+ chan <- liftIO newChan
1069 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
1083 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
1070 check xs = do
1084 check xs = do
1071 checkInitialItems (fromMaybe undefined $ apply postBuildPatch intMap) xs
1085 checkInitialItems (fromMaybe undefined $ apply postBuildPatch intMap) xs
@@ -1076,9 +1090,9 @@ tests _selenium = do
1076 pb <- getPostBuild
1090 pb <- getPostBuild
1077 replace <- triggerEventWithChan chan
1091 replace <- triggerEventWithChan chan
1078 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1092 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1079− liftIO $ dmap `shouldBe` intMap
1093+ liftIO $ dmap `H.shouldBe` intMap
1080− it "can delete/update/insert when built in prerender" $ do
1094+ it "can delete/update/insert when built in prerender" $ runWD $ do
1081− chan <- newChan
1095+ chan <- liftIO newChan
1082 let check = do
1096 let check = do
1083 _ <- getAndCheckInitialItems intMap
1097 _ <- getAndCheckInitialItems intMap
1084 checkRemoval chan 1
1098 checkRemoval chan 1
@@ -1088,9 +1102,9 @@ tests _selenium = do
1088 replace <- triggerEventWithChan chan
1102 replace <- triggerEventWithChan chan
1089 prerender_ (pure ()) $ do
1103 prerender_ (pure ()) $ do
1090 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap replace
1104 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap replace
1091− liftIO $ dmap `shouldBe` intMap
1105+ liftIO $ dmap `H.shouldBe` intMap
1092− it "can delete/update/insert when built in immediate mode" $ do
1106+ it "can delete/update/insert when built in immediate mode" $ runWD $ do
1093− chan <- newChan
1107+ chan <- liftIO newChan
1094 let check = do
1108 let check = do
1095 _ <- getAndCheckInitialItems intMap
1109 _ <- getAndCheckInitialItems intMap
1096 checkRemoval chan 1
1110 checkRemoval chan 1
@@ -1100,10 +1114,10 @@ tests _selenium = do
1100 pb <- getPostBuild
1114 pb <- getPostBuild
1101 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
1115 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
1102 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1116 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1103− liftIO $ dmap `shouldBe` intMap
1117+ liftIO $ dmap `H.shouldBe` intMap
1104 -- Should be fixed by prerender changes!
1118 -- Should be fixed by prerender changes!
1105− it "handles postBuild correctly in prerender" $ do
1119+ it "handles postBuild correctly in prerender" $ runWD $ do
1106− chan <- newChan
1120+ chan <- liftIO newChan
1107 let check = do
1121 let check = do
1108 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
1122 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
1109 checkRemoval chan 1
1123 checkRemoval chan 1
@@ -1114,7 +1128,7 @@ tests _selenium = do
1114 prerender_ (pure ()) $ void $ do
1128 prerender_ (pure ()) $ void $ do
1115 pb <- getPostBuild
1129 pb <- getPostBuild
1116 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1130 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1117− liftIO $ dmap `shouldBe` intMap
1131+ liftIO $ dmap `H.shouldBe` intMap
1119data Selenium = Selenium
1133data Selenium = Selenium
1120 { _selenium_portNumber :: PortNumber
1134 { _selenium_portNumber :: PortNumber
@@ -1132,7 +1146,7 @@ startSeleniumServer port = do
1133withSeleniumServer :: (Selenium -> IO ()) -> IO ()
1147withSeleniumServer :: (Selenium -> IO ()) -> IO ()
1134withSeleniumServer f = do
1148withSeleniumServer f = do
1135− let port = 4444 -- TODO port <- getFreePort
1149+ port <- getFreePort
1136 stopServer <- startSeleniumServer port
1150 stopServer <- startSeleniumServer port
1137 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
1151 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
1138 f $ Selenium
1152 f $ Selenium
@@ -1157,7 +1171,7 @@ elementShouldBeRemoved e = do
1157 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
1171 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
1159shouldContainText :: Text -> WD.Element -> WD ()
1173shouldContainText :: Text -> WD.Element -> WD ()
1160−shouldContainText t = liftIO . flip shouldBe t <=< WD.getText
1174+shouldContainText t = flip shouldBe t <=< WD.getText
1162checkBodyText :: Text -> WD ()
1176checkBodyText :: Text -> WD ()
1163checkBodyText = checkTextInTag "body"
1177checkBodyText = checkTextInTag "body"
@@ -1178,7 +1192,7 @@ testWidgetStatic
1178 -- ^ Webdriver commands to run before JS runs and after hydration switchover
1192 -- ^ Webdriver commands to run before JS runs and after hydration switchover
1179 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1193 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1180 -- ^ Widget we are testing
1194 -- ^ Widget we are testing
1181− -> IO b
1195+ -> WD b
1182testWidgetStatic w = testWidget (void w) w
1196testWidgetStatic w = testWidget (void w) w
1184-- | TODO: do something about JSExceptions not causing tests to fail
1198-- | TODO: do something about JSExceptions not causing tests to fail
@@ -1189,7 +1203,7 @@ testWidget
1189 -- ^ Webdriver commands to run after hydration switchover
1203 -- ^ Webdriver commands to run after hydration switchover
1190 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1204 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1191 -- ^ Widget we are testing
1205 -- ^ Widget we are testing
1192− -> IO b
1206+ -> WD b
1193testWidget beforeJS afterSwitchover = testWidget' beforeJS (const afterSwitchover)
1207testWidget beforeJS afterSwitchover = testWidget' beforeJS (const afterSwitchover)
1195-- | TODO: do something about JSExceptions not causing tests to fail
1209-- | TODO: do something about JSExceptions not causing tests to fail
@@ -1200,37 +1214,44 @@ testWidget'
1200 -- ^ Webdriver commands to run after hydration switchover
1214 -- ^ Webdriver commands to run after hydration switchover
1201 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1215 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
1202 -- ^ Widget we are testing (contents of body)
1216 -- ^ Widget we are testing (contents of body)
1203− -> IO b
1217+ -> WD b
1204testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out") pure <=< timeout testTimeLimit $ do
1218testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out") pure <=< timeout testTimeLimit $ do
1205 let staticApp = do
1219 let staticApp = do
1206 el "head" $ pure ()
1220 el "head" $ pure ()
1207 el "body" $ do
1221 el "body" $ do
1208 bodyWidget
1222 bodyWidget
1209 el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
1223 el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
1210− ((), html) <- renderStatic staticApp
1224+ ((), html) <- liftIO $ renderStatic staticApp
1211− waitBeforeJS <- newEmptyMVar -- Empty until JS should be run
1225+ waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
1212− waitUntilSwitchover <- newEmptyMVar -- Empty until switchover
1226+ waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
1213 let entryPoint = do
1227 let entryPoint = do
1214 liftIO $ takeMVar waitBeforeJS
1228 liftIO $ takeMVar waitBeforeJS
1215 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget
1229 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget
1216 syncPoint
1230 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
1218 port <- getFreePort
1233 port <- getFreePort
1234+ waitJSaddle <- liftIO newEmptyMVar
1235+ let settings = foldr ($) Warp.defaultSettings
1219− let settings = Warp.setPort (fromIntegral $ toInteger port) Warp.defaultSettings
1236+ [ Warp.setPort $ fromIntegral (toInteger port)
1237+ , Warp.setBeforeMainLoop $ putMVar waitJSaddle ()
1220 -- hSilence to get rid of ConnectionClosed logs
1239 -- hSilence to get rid of ConnectionClosed logs
1221 jsaddleWarp = forkIO $ hSilence [stderr] $ Warp.runSettings settings application
1240 jsaddleWarp = forkIO $ hSilence [stderr] $ Warp.runSettings settings application
1222− bracket jsaddleWarp killThread $ \_ -> do
1241+ jsaddleTid <- liftIO jsaddleWarp
1223− browserPath <- T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""
1242+ liftIO $ takeMVar waitJSaddle
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
1243+ WD.openPage $ "http://localhost:" <> show port
1227− a <- beforeJS
1244+ a <- beforeJS
1228− liftIO $ putMVar waitBeforeJS ()
1245+ liftIO $ putMVar waitBeforeJS ()
1229− liftIO $ takeMVar waitUntilSwitchover
1246+ liftIO $ takeMVar waitUntilSwitchover
1230− liftIO $ threadDelay 100000 -- wait a bit
1247+ liftIO $ threadDelay 100000 -- wait a bit
1231− afterSwitchover a
1248+ b <- afterSwitchover a
1249+ liftIO $ killThread jsaddleTid
1233-- TODO: Should this be part of more widely used module?
1253-- TODO: Should this be part of more widely used module?
1254+-- TODO: Ensure port is not taken
1234getFreePort :: MonadIO m => m PortNumber
1255getFreePort :: MonadIO m => m PortNumber
1235getFreePort = liftIO $ withSocketsDo $ do
1256getFreePort = liftIO $ withSocketsDo $ do
1236 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")
1257 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")