@@ -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 #-}
@@ -18,6 +21,7 @@ import Control.Monad
1821import Control.Monad.Catch
1922import Control.Monad.Fix
2023import Control.Monad.IO.Class
24+import Control.Monad.Ref
2125import Data.Constraint (Dict(..))
2226import Data.Constraint.Extras
2327import Data.Dependent.Map (DMap)
@@ -27,7 +31,7 @@ import Data.Functor.Identity
2731import Data.Functor.Misc
2832import Data.GADT.Compare.TH
2933import Data.GADT.Show.TH
30−import Data.IORef
34+import Data.IORef (IORef)
3135import Data.Maybe (fromMaybe, fromJust)
3236import Data.Proxy
3337import Data.Text (Text)
@@ -45,9 +49,11 @@ import System.IO (stderr)
4549import System.IO.Silently
4650import System.IO.Temp
4751import System.Process
48−import System.Timeout
49−import Test.HUnit (assertEqual, assertFailure)
50−import Test.Hspec (Spec, parallel, hspec, it, describe, shouldBe)
52+import System.Timeout.Lifted
53+import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
54+import qualified Test.Hspec as H
55+import Test.Hspec.WebDriver hiding (runWD)
56+import qualified Test.Hspec.WebDriver as WD
5157import Test.WebDriver (WD)
5258
5359import qualified Data.ByteString.Lazy as LBS
@@ -59,6 +65,16 @@ import qualified GHCJS.DOM.File as File
5965import qualified Network.Wai.Handler.Warp as Warp
6066import qualified System.FilePath as FilePath
6167import qualified Test.WebDriver as WD
68+import qualified Test.WebDriver.Capabilities as WD
69+
70+-- TODO Remove orphan
71+deriving instance MonadRef WD
72+
73+assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()
74+assertEqual a b = liftIO . HUnit.assertEqual a b
75+
76+assertFailure :: MonadIO m => String -> m ()
77+assertFailure = liftIO . HUnit.assertFailure
6278
6379testTimeLimit :: Int
6480testTimeLimit = 5 * 1000 * 1000
@@ -108,24 +124,30 @@ instance EqTag DKey Identity where
108124 eqTagged Key_Bool Key_Bool = (==)
109125
110126main :: IO ()
111−main = withSeleniumServer $ \selenium ->
112− hspec (parallel (tests selenium)) `finally` _selenium_stopServer selenium
127+main = withSeleniumServer $ \selenium -> do
128+ browserPath <- liftIO $ T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""
129+ when (T.null browserPath) $ fail "No browser found"
130+ let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
131+ chromeCaps' = WD.getCaps $ chromeConfig browserPath
132+ hspec (tests wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium
113133
114−tests :: Selenium -> Spec
115−tests _selenium = do
116− describe "text" $ do
117− it "works" $ do
134+tests :: WD.WDConfig -> [Capabilities] -> Selenium -> Spec
135+tests wdConfig caps _selenium = do
136+ let session' = sessionWith wdConfig "" . using (map (flip (,) "") caps)
137+ runWD = runWDOptions (WdOptions False)
138+ describe "text" $ session' $ do
139+ it "works" $ runWD $ do
118140 testWidgetStatic (checkBodyText "hello world") $ do
119141 text "hello world"
120− it "works with postBuild" $ do
142+ it "works with postBuild" $ runWD $ do
121143 testWidgetStatic (checkBodyText "pb") $ do
122144 pb <- getPostBuild
123145 void $ textNode $ TextNodeConfig "" $ Just $ "pb" <$ pb
124− it "works for adjacent text nodes" $ do
146+ it "works for adjacent text nodes" $ runWD $ do
125147 testWidgetStatic (checkBodyText "hello world") $ do
126148 text "hello "
127149 text "world"
128− it "works for empty adjacent text nodes" $ do
150+ it "works for empty adjacent text nodes" $ runWD $ do
129151 testWidgetStatic (checkBodyText "hello world") $ do
130152 pb <- getPostBuild
131153 text ""
@@ -134,37 +156,37 @@ tests _selenium = do
134156 _ <- textNode $ TextNodeConfig "abc" $ Just $ "" <$ pb
135157 _ <- textNode $ TextNodeConfig "" $ Just $ "world" <$ pb
136158 text ""
137− it "works when empty text nodes are the only children of an element" $ do
159+ it "works when empty text nodes are the only children of an element" $ runWD $ do
138160 testWidgetStatic (checkBodyText "hello world") $ do
139161 el "div" $ do
140162 text ""
141163 text ""
142164 text "hello world"
143− it "works when an empty text node is the first child before text" $ do
165+ it "works when an empty text node is the first child before text" $ runWD $ do
144166 testWidgetStatic (checkTextInTag "div" "hello world") $ do
145167 el "div" $ do
146168 text ""
147169 text "hello world"
148− it "works when an empty text node is the first child before element" $ do
170+ it "works when an empty text node is the first child before element" $ runWD $ do
149171 testWidgetStatic (checkTextInTag "div" "hello world") $ do
150172 el "div" $ do
151173 text ""
152174 el "span" $ text "hello world"
153− it "works when an empty text node is the last child" $ do
175+ it "works when an empty text node is the last child" $ runWD $ do
154176 testWidgetStatic (checkTextInTag "div" "hello world") $ do
155177 el "div" $ do
156178 el "span" $ text "hello world"
157179 text ""
158− it "updates after postBuild" $ do -- TODO I think these two tests are broken
180+ it "updates after postBuild" $ runWD $ do -- TODO I think these two tests are broken
159181 testWidget (checkBodyText "initial") (checkBodyText "after") $ do
160182 after <- delay 0 =<< getPostBuild
161183 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ after
162− it "updates immediately after postBuild" $ do
184+ it "updates immediately after postBuild" $ runWD $ do
163185 testWidget (checkBodyText "pb") (checkBodyText "after") $ do
164186 pb <- getPostBuild
165187 after <- delay 0 pb
166188 void $ textNode $ TextNodeConfig "initial" $ Just $ leftmost ["pb" <$ pb, "after" <$ after]
167− it "updates in immediate mode" $ do
189+ it "updates in immediate mode" $ runWD $ do
168190 let checkUpdated = do
169191 checkBodyText "initial"
170192 WD.click =<< WD.findElem (WD.ByTag "button")
@@ -174,35 +196,35 @@ tests _selenium = do
174196 click <- button ""
175197 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click
176198
177− describe "element" $ do
178− it "works with domEvent Click" $ do
179− clickedRef <- newIORef False
199+ describe "element" $ session' $ do
200+ it "works with domEvent Click" $ runWD $ do
201+ clickedRef <- liftIO $ newRef False
180202 testWidget' (WD.findElem $ WD.ByTag "div") WD.click $ do
181203 (e, _) <- el' "div" $ text "hello world"
182− performEvent_ $ liftIO (writeIORef clickedRef True) <$ domEvent Click e
183− clicked <- readIORef clickedRef
184− assertEqual "Not clicked" True clicked
185− it "works with eventFlags stopPropagation" $ do
186− firstClickedRef <- newIORef False
187− secondClickedRef <- newIORef False
204+ performEvent_ $ liftIO (writeRef clickedRef True) <$ domEvent Click e
205+ clicked <- liftIO $ readRef clickedRef
206+ liftIO $ assertEqual "Not clicked" True clicked
207+ it "works with eventFlags stopPropagation" $ runWD $ do
208+ firstClickedRef <- newRef False
209+ secondClickedRef <- newRef False
188210 let clickBoth = do
189211 WD.findElem (WD.ById "first") >>= WD.click
190212 WD.findElem (WD.ById "second") >>= WD.click
191213 testWidget (pure ()) clickBoth $ do
192214 (firstDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
193215 void $ elAttr "span" ("id" =: "first") $ text "hello world"
194− performEvent_ $ liftIO (writeIORef firstClickedRef True) <$ domEvent Click firstDivEl
216+ performEvent_ $ liftIO (writeRef firstClickedRef True) <$ domEvent Click firstDivEl
195217 (secondDivEl, _) <- el' "div" $ prerender_ (pure ()) $ do
196218 let conf :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace
197219 conf = (def :: ElementConfig EventResult (SpiderTimeline Global) GhcjsDomSpace)
198220 & initialAttributes .~ "id" =: "second"
199221 & elementConfig_eventSpec .~ (addEventSpecFlags (Proxy :: Proxy GhcjsDomSpace) Click (\_ -> stopPropagation) def)
200222 void $ element "span" conf $ text "hello world"
201− performEvent_ $ liftIO (writeIORef secondClickedRef True) <$ domEvent Click secondDivEl
202− firstClicked <- readIORef firstClickedRef
203− secondClicked <- readIORef secondClickedRef
223+ performEvent_ $ liftIO (writeRef secondClickedRef True) <$ domEvent Click secondDivEl
224+ firstClicked <- readRef firstClickedRef
225+ secondClicked <- readRef secondClickedRef
204226 assertEqual "Click propagated when it should have stopped" (True, False) (firstClicked, secondClicked)
205− it "works with eventFlags preventDefault" $ do
227+ it "works with eventFlags preventDefault" $ runWD $ do
206228 let click = do
207229 e <- WD.findElem $ WD.ByTag "input"
208230 s0 <- WD.isSelected e
@@ -216,7 +238,7 @@ tests _selenium = do
216238 & initialAttributes .~ "type" =: "checkbox"
217239 void $ element "input" conf $ text "hello world"
218240 assertEqual "Click not prevented" (False, False) clicked
219− it "can add/update/remove attributes" $ do
241+ it "can add/update/remove attributes" $ runWD $ do
220242 let checkInitialAttrs = do
221243 e <- WD.findElem $ WD.ByTag "div"
222244 assertAttr e "const" (Just "const")
@@ -239,7 +261,7 @@ tests _selenium = do
239261 let click = domEvent Click e
240262 return ()
241263 -- TODO check this is the correct solution
242− it "has ssr attribute, removes ssr attribute" $ do
264+ it "has ssr attribute, removes ssr attribute" $ runWD $ do
243265 let checkSSRAttr = do
244266 e <- WD.findElem $ WD.ByTag "div"
245267 assertAttr e "ssr" (Just "")
@@ -247,9 +269,9 @@ tests _selenium = do
247269 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
248270
249271 describe "inputElement" $ do
250− describe "hydration" $ do
251− it "doesn't wipe user input when switching over" $ do
252− inputRef <- newIORef ("" :: Text)
272+ describe "hydration" $ session' $ do
273+ it "doesn't wipe user input when switching over" $ runWD $ do
274+ inputRef <- newRef ("" :: Text)
253275 testWidget'
254276 (do
255277 e <- WD.findElem $ WD.ByTag "input"
@@ -257,206 +279,201 @@ tests _selenium = do
257279 pure e)
258280 (\e -> do
259281 t <- WD.attr e "value"
260− liftIO $ t `shouldBe` Just "hello world"
282+ t `shouldBe` Just "hello world"
261283 WD.click <=< WD.findElem $ WD.ByTag "button"
262− input <- liftIO $ readIORef inputRef
263− liftIO $ input `shouldBe` "hello world"
284+ input <- liftIO $ readRef inputRef
285+ input `shouldBe` "hello world"
264286 ) $ do
265287 e <- inputElement def
266288 click <- button "save"
267− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
268− it "captures user input after switchover" $ do
269− inputRef <- newIORef ("" :: Text)
289+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
290+ it "captures user input after switchover" $ runWD $ do
291+ inputRef <- newRef ("" :: Text)
270292 let checkValue = do
271293 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
272294 WD.click <=< WD.findElem $ WD.ByTag "button"
273− input <- liftIO $ readIORef inputRef
274− liftIO $ input `shouldBe` "hello world"
295+ input <- liftIO $ readRef inputRef
296+ input `shouldBe` "hello world"
275297 testWidget (pure ()) checkValue $ do
276298 e <- inputElement def
277299 click <- button "save"
278− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
279− it "sets focus appropriately" $ do
280− focusRef <- newIORef False
300+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
301+ it "sets focus appropriately" $ runWD $ do
302+ focusRef <- newRef False
281303 let checkValue = do
282− liftIO $ readIORef focusRef >>= flip shouldBe False
304+ readRef focusRef >>= flip shouldBe False
283305 e <- WD.findElem $ WD.ByTag "input"
284306 WD.click e
285307 liftIO $ threadDelay 100000
286− liftIO $ readIORef focusRef >>= flip shouldBe True
308+ readRef focusRef >>= flip shouldBe True
287309 testWidget (pure ()) checkValue $ do
288310 e <- inputElement def
289− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
290− it "sets focus when focus occurs before hydration" $ do
291− focusRef <- newIORef False
311+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
312+ it "sets focus when focus occurs before hydration" $ runWD $ do
313+ focusRef <- newRef False
292314 let setup = do
293315 e <- WD.findElem $ WD.ByTag "input"
294316 WD.click e
295317 hasFocus <- (== e) <$> WD.activeElem
296− liftIO $ do
297− hasFocus `shouldBe` True
298− readIORef focusRef >>= flip shouldBe False
299− check = liftIO $ readIORef focusRef >>= flip shouldBe True
318+ hasFocus `shouldBe` True
319+ readRef focusRef >>= flip shouldBe False
320+ check = readRef focusRef >>= flip shouldBe True
300321 testWidget setup check $ do
301322 e <- inputElement def
302− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
303− it "sets value appropriately" $ do
304− valueByUIRef <- newIORef ("" :: Text)
305− valueRef <- newIORef ("" :: Text)
306− setValueChan :: Chan Text <- newChan
323+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
324+ it "sets value appropriately" $ runWD $ do
325+ valueByUIRef <- newRef ("" :: Text)
326+ valueRef <- newRef ("" :: Text)
327+ setValueChan :: Chan Text <- liftIO newChan
307328 let checkValue = do
308− liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
309− liftIO $ readIORef valueRef >>= flip shouldBe ""
329+ readRef valueByUIRef >>= flip shouldBe ""
330+ readRef valueRef >>= flip shouldBe ""
310331 e <- WD.findElem $ WD.ByTag "input"
311332 WD.sendKeys "hello" e
312− liftIO $ do
313− threadDelay 100000
314− readIORef valueByUIRef >>= flip shouldBe "hello"
315− readIORef valueRef >>= flip shouldBe "hello"
316− writeChan setValueChan "world"
317− threadDelay 100000
318− readIORef valueByUIRef >>= flip shouldBe "hello"
319− readIORef valueRef >>= flip shouldBe "world"
333+ liftIO $ threadDelay 100000
334+ readRef valueByUIRef >>= flip shouldBe "hello"
335+ readRef valueRef >>= flip shouldBe "hello"
336+ liftIO $ writeChan setValueChan "world"
337+ liftIO $ threadDelay 100000
338+ readRef valueByUIRef >>= flip shouldBe "hello"
339+ readRef valueRef >>= flip shouldBe "world"
320340 testWidget (pure ()) checkValue $ do
321341 update <- triggerEventWithChan setValueChan
322342 e <- inputElement $ def & inputElementConfig_setValue .~ update
323− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
324− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
325− it "sets checked appropriately" $ do
326− checkedByUIRef <- newIORef False
327− checkedRef <- newIORef False
328− setCheckedChan <- newChan
343+ performEvent_ $ liftIO . (writeRef valueByUIRef) <$> _inputElement_input e
344+ performEvent_ $ liftIO . (writeRef valueRef) <$> updated (value e)
345+ it "sets checked appropriately" $ runWD $ do
346+ checkedByUIRef <- newRef False
347+ checkedRef <- newRef False
348+ setCheckedChan <- liftIO newChan
329349 let checkValue = do
330− liftIO $ readIORef checkedByUIRef >>= flip shouldBe False
331− liftIO $ readIORef checkedRef >>= flip shouldBe False
350+ readRef checkedByUIRef >>= flip shouldBe False
351+ readRef checkedRef >>= flip shouldBe False
332352 e <- WD.findElem $ WD.ByTag "input"
333353 WD.moveToCenter e
334354 WD.click e
335− liftIO $ do
336− threadDelay 100000
337− readIORef checkedByUIRef >>= flip shouldBe True
338− readIORef checkedRef >>= flip shouldBe True
339− writeChan setCheckedChan False
340− threadDelay 100000
341− readIORef checkedByUIRef >>= flip shouldBe True
342− readIORef checkedRef >>= flip shouldBe False
355+ liftIO $ threadDelay 100000
356+ readRef checkedByUIRef >>= flip shouldBe True
357+ readRef checkedRef >>= flip shouldBe True
358+ liftIO $ writeChan setCheckedChan False
359+ liftIO $ threadDelay 100000
360+ readRef checkedByUIRef >>= flip shouldBe True
361+ readRef checkedRef >>= flip shouldBe False
343362 testWidget (pure ()) checkValue $ do
344363 setChecked <- triggerEventWithChan setCheckedChan
345364 e <- inputElement $ def
346365 & initialAttributes .~ "type" =: "checkbox"
347366 & inputElementConfig_setChecked .~ setChecked
348− performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
349− performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
350− it "captures file uploads" $ do
351− filesRef :: IORef [Text] <- newIORef []
367+ performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
368+ performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
369+ it "captures file uploads" $ runWD $ do
370+ filesRef :: IORef [Text] <- newRef []
352371 let uploadFile = do
353372 e <- WD.findElem $ WD.ByTag "input"
354373 path <- liftIO $ writeSystemTempFile "testFile" "file contents"
355374 WD.sendKeys (T.pack path) e
356375 WD.click <=< WD.findElem $ WD.ByTag "button"
357376 liftIO $ removeFile path
358− input <- liftIO $ readIORef filesRef
359− liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
377+ input <- readRef filesRef
378+ input `shouldBe` [T.pack $ FilePath.takeFileName path]
360379 testWidget (pure ()) uploadFile $ do
361380 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
362381 click <- button "save"
363382 prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
364383 names <- liftJSM $ traverse File.getName fs
365− liftIO $ writeIORef filesRef names
384+ liftIO $ writeRef filesRef names
366385
367− describe "hydration/immediate" $ do
368− it "captures user input after switchover" $ do
369− inputRef :: IORef Text <- newIORef ""
386+ describe "hydration/immediate" $ session' $ do
387+ it "captures user input after switchover" $ runWD $ do
388+ inputRef :: IORef Text <- newRef ""
370389 let checkValue = do
371390 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "input"
372391 WD.click <=< WD.findElem $ WD.ByTag "button"
373− input <- liftIO $ readIORef inputRef
374− liftIO $ input `shouldBe` "hello world"
392+ input <- readRef inputRef
393+ input `shouldBe` "hello world"
375394 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
376395 e <- inputElement def
377396 click <- button "save"
378− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
379− it "sets focus appropriately" $ do
380− focusRef <- newIORef False
397+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
398+ it "sets focus appropriately" $ runWD $ do
399+ focusRef <- newRef False
381400 let checkValue = do
382− liftIO $ readIORef focusRef >>= flip shouldBe False
401+ readRef focusRef >>= flip shouldBe False
383402 e <- WD.findElem $ WD.ByTag "input"
384403 WD.click e
385404 liftIO $ threadDelay 100000
386− liftIO $ readIORef focusRef >>= flip shouldBe True
405+ readRef focusRef >>= flip shouldBe True
387406 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
388407 e <- inputElement def
389− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
390− it "sets value appropriately" $ do
391− valueByUIRef :: IORef Text <- newIORef ""
392− valueRef :: IORef Text <- newIORef ""
393− setValueChan :: Chan Text <- newChan
408+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_inputElement_hasFocus e)
409+ it "sets value appropriately" $ runWD $ do
410+ valueByUIRef :: IORef Text <- newRef ""
411+ valueRef :: IORef Text <- newRef ""
412+ setValueChan :: Chan Text <- liftIO newChan
394413 let checkValue = do
395− liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
396− liftIO $ readIORef valueRef >>= flip shouldBe ""
414+ readRef valueByUIRef >>= flip shouldBe ""
415+ readRef valueRef >>= flip shouldBe ""
397416 e <- WD.findElem $ WD.ByTag "input"
398417 WD.sendKeys "hello" e
399− liftIO $ do
400− threadDelay 100000
401− readIORef valueByUIRef >>= flip shouldBe "hello"
402− readIORef valueRef >>= flip shouldBe "hello"
403− writeChan setValueChan "world"
404− threadDelay 100000
405− readIORef valueByUIRef >>= flip shouldBe "hello"
406− readIORef valueRef >>= flip shouldBe "world"
418+ liftIO $ threadDelay 100000
419+ readRef valueByUIRef >>= flip shouldBe "hello"
420+ readRef valueRef >>= flip shouldBe "hello"
421+ liftIO $ writeChan setValueChan "world"
422+ liftIO $ threadDelay 100000
423+ readRef valueByUIRef >>= flip shouldBe "hello"
424+ readRef valueRef >>= flip shouldBe "world"
407425 testWidget (pure ()) checkValue $ do
408426 update <- triggerEventWithChan setValueChan
409427 prerender_ (pure ()) $ do
410428 e <- inputElement $ def & inputElementConfig_setValue .~ update
411− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
412− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
413− it "sets checked appropriately" $ do
414− checkedByUIRef <- newIORef False
415− checkedRef <- newIORef False
416− setCheckedChan <- newChan
429+ performEvent_ $ liftIO . writeRef valueByUIRef <$> _inputElement_input e
430+ performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
431+ it "sets checked appropriately" $ runWD $ do
432+ checkedByUIRef <- newRef False
433+ checkedRef <- newRef False
434+ setCheckedChan <- liftIO newChan
417435 let checkValue = do
418− liftIO $ readIORef checkedByUIRef >>= flip shouldBe False
419− liftIO $ readIORef checkedRef >>= flip shouldBe False
436+ readRef checkedByUIRef >>= flip shouldBe False
437+ readRef checkedRef >>= flip shouldBe False
420438 e <- WD.findElem $ WD.ByTag "input"
421439 WD.moveToCenter e
422440 WD.click e
423− liftIO $ do
424− threadDelay 100000
425− readIORef checkedByUIRef >>= flip shouldBe True
426− readIORef checkedRef >>= flip shouldBe True
427− writeChan setCheckedChan False
428− threadDelay 100000
429− readIORef checkedByUIRef >>= flip shouldBe True
430− readIORef checkedRef >>= flip shouldBe False
441+ liftIO $ threadDelay 100000
442+ readRef checkedByUIRef >>= flip shouldBe True
443+ readRef checkedRef >>= flip shouldBe True
444+ liftIO $ writeChan setCheckedChan False
445+ liftIO $ threadDelay 100000
446+ readRef checkedByUIRef >>= flip shouldBe True
447+ readRef checkedRef >>= flip shouldBe False
431448 testWidget (pure ()) checkValue $ do
432449 setChecked <- triggerEventWithChan setCheckedChan
433450 prerender_ (pure ()) $ do
434451 e <- inputElement $ def
435452 & initialAttributes .~ "type" =: "checkbox"
436453 & inputElementConfig_setChecked .~ setChecked
437− performEvent_ $ liftIO . writeIORef checkedByUIRef <$> _inputElement_checkedChange e
438− performEvent_ $ liftIO . writeIORef checkedRef <$> updated (_inputElement_checked e)
439− it "captures file uploads" $ do
440− filesRef :: IORef [Text] <- newIORef []
454+ performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e
455+ performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)
456+ it "captures file uploads" $ runWD $ do
457+ filesRef :: IORef [Text] <- newRef []
441458 let uploadFile = do
442459 e <- WD.findElem $ WD.ByTag "input"
443460 path <- liftIO $ writeSystemTempFile "testFile" "file contents"
444461 WD.sendKeys (T.pack path) e
445462 WD.click <=< WD.findElem $ WD.ByTag "button"
446463 liftIO $ removeFile path
447− input <- liftIO $ readIORef filesRef
448− liftIO $ input `shouldBe` [T.pack $ FilePath.takeFileName path]
464+ input <- liftIO $ readRef filesRef
465+ input `shouldBe` [T.pack $ FilePath.takeFileName path]
449466 testWidget (pure ()) uploadFile $ prerender_ (pure ()) $ do
450467 e <- inputElement $ def & initialAttributes .~ "type" =: "file"
451468 click <- button "save"
452469 performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do
453470 names <- liftJSM $ traverse File.getName fs
454− liftIO $ writeIORef filesRef names
471+ liftIO $ writeRef filesRef names
455472
456473 describe "textAreaElement" $ do
457− describe "hydration" $ do
458− it "doesn't wipe user input when switching over" $ do
459− inputRef <- newIORef ("" :: Text)
474+ describe "hydration" $ session' $ do
475+ it "doesn't wipe user input when switching over" $ runWD $ do
476+ inputRef <- newRef ("" :: Text)
460477 testWidget'
461478 (do
462479 e <- WD.findElem $ WD.ByTag "textarea"
@@ -464,118 +481,115 @@ tests _selenium = do
464481 pure e)
465482 (\e -> do
466483 t <- WD.attr e "value"
467− liftIO $ t `shouldBe` Just "hello world"
484+ t `shouldBe` Just "hello world"
468485 WD.click <=< WD.findElem $ WD.ByTag "button"
469− input <- liftIO $ readIORef inputRef
470− liftIO $ input `shouldBe` "hello world"
486+ input <- readRef inputRef
487+ input `shouldBe` "hello world"
471488 ) $ do
472489 e <- textAreaElement def
473490 click <- button "save"
474− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
475− it "captures user input after switchover" $ do
476− inputRef <- newIORef ("" :: Text)
491+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
492+ it "captures user input after switchover" $ runWD $ do
493+ inputRef <- newRef ("" :: Text)
477494 let checkValue = do
478495 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
479496 WD.click <=< WD.findElem $ WD.ByTag "button"
480− input <- liftIO $ readIORef inputRef
481− liftIO $ input `shouldBe` "hello world"
497+ input <- readRef inputRef
498+ input `shouldBe` "hello world"
482499 testWidget (pure ()) checkValue $ do
483500 e <- textAreaElement def
484501 click <- button "save"
485− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
486− it "sets focus appropriately" $ do
487− focusRef <- newIORef False
502+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
503+ it "sets focus appropriately" $ runWD $ do
504+ focusRef <- newRef False
488505 let checkValue = do
489− liftIO $ readIORef focusRef >>= flip shouldBe False
506+ readRef focusRef >>= flip shouldBe False
490507 e <- WD.findElem $ WD.ByTag "textarea"
491508 WD.click e
492509 liftIO $ threadDelay 100000
493− liftIO $ readIORef focusRef >>= flip shouldBe True
510+ readRef focusRef >>= flip shouldBe True
494511 testWidget (pure ()) checkValue $ do
495512 e <- textAreaElement def
496− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_textAreaElement_hasFocus e)
497− it "sets focus when focus occurs before hydration" $ do
498− focusRef <- newIORef False
513+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
514+ it "sets focus when focus occurs before hydration" $ runWD $ do
515+ focusRef <- newRef False
499516 let setup = do
500517 e <- WD.findElem $ WD.ByTag "textarea"
501518 WD.click e
502519 hasFocus <- (== e) <$> WD.activeElem
503− liftIO $ do
504− hasFocus `shouldBe` True
505− readIORef focusRef >>= flip shouldBe False
506− check = liftIO $ readIORef focusRef >>= flip shouldBe True
520+ hasFocus `shouldBe` True
521+ readRef focusRef >>= flip shouldBe False
522+ check = readRef focusRef >>= flip shouldBe True
507523 testWidget setup check $ do
508524 e <- textAreaElement def
509− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_textAreaElement_hasFocus e)
510− it "sets value appropriately" $ do
511− valueByUIRef <- newIORef ("" :: Text)
512− valueRef <- newIORef ("" :: Text)
513− setValueChan :: Chan Text <- newChan
525+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
526+ it "sets value appropriately" $ runWD $ do
527+ valueByUIRef <- newRef ("" :: Text)
528+ valueRef <- newRef ("" :: Text)
529+ setValueChan :: Chan Text <- liftIO newChan
514530 let checkValue = do
515− liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
516− liftIO $ readIORef valueRef >>= flip shouldBe ""
531+ readRef valueByUIRef >>= flip shouldBe ""
532+ readRef valueRef >>= flip shouldBe ""
517533 e <- WD.findElem $ WD.ByTag "textarea"
518534 WD.sendKeys "hello" e
519− liftIO $ do
520− threadDelay 100000
521− readIORef valueByUIRef >>= flip shouldBe "hello"
522− readIORef valueRef >>= flip shouldBe "hello"
523− writeChan setValueChan "world"
524− threadDelay 100000
525− readIORef valueByUIRef >>= flip shouldBe "hello"
526− readIORef valueRef >>= flip shouldBe "world"
535+ liftIO $ threadDelay 100000
536+ readRef valueByUIRef >>= flip shouldBe "hello"
537+ readRef valueRef >>= flip shouldBe "hello"
538+ liftIO $ writeChan setValueChan "world"
539+ liftIO $ threadDelay 100000
540+ readRef valueByUIRef >>= flip shouldBe "hello"
541+ readRef valueRef >>= flip shouldBe "world"
527542 testWidget (pure ()) checkValue $ do
528543 setValue' <- triggerEventWithChan setValueChan
529544 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
530− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e
531− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
545+ performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
546+ performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
532547
533− describe "hydration/immediate" $ do
534− it "captures user input after switchover" $ do
535− inputRef :: IORef Text <- newIORef ""
548+ describe "hydration/immediate" $ session' $ do
549+ it "captures user input after switchover" $ runWD $ do
550+ inputRef :: IORef Text <- newRef ""
536551 let checkValue = do
537552 WD.sendKeys "hello world" <=< WD.findElem $ WD.ByTag "textarea"
538553 WD.click <=< WD.findElem $ WD.ByTag "button"
539− input <- liftIO $ readIORef inputRef
540− liftIO $ input `shouldBe` "hello world"
554+ input <- liftIO $ readRef inputRef
555+ input `shouldBe` "hello world"
541556 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
542557 e <- textAreaElement def
543558 click <- button "save"
544− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (value e)) click
545− it "sets focus appropriately" $ do
546− focusRef <- newIORef False
559+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click
560+ it "sets focus appropriately" $ runWD $ do
561+ focusRef <- newRef False
547562 let checkValue = do
548− liftIO $ readIORef focusRef >>= flip shouldBe False
563+ readRef focusRef >>= flip shouldBe False
549564 e <- WD.findElem $ WD.ByTag "textarea"
550565 WD.click e
551566 liftIO $ threadDelay 100000
552− liftIO $ readIORef focusRef >>= flip shouldBe True
567+ readRef focusRef >>= flip shouldBe True
553568 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
554569 e <- textAreaElement def
555− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_textAreaElement_hasFocus e)
556− it "sets value appropriately" $ do
557− valueByUIRef :: IORef Text <- newIORef ""
558− valueRef :: IORef Text <- newIORef ""
559− setValueChan :: Chan Text <- newChan
570+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_textAreaElement_hasFocus e)
571+ it "sets value appropriately" $ runWD $ do
572+ valueByUIRef :: IORef Text <- newRef ""
573+ valueRef :: IORef Text <- newRef ""
574+ setValueChan :: Chan Text <- liftIO newChan
560575 let checkValue = do
561− liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
562− liftIO $ readIORef valueRef >>= flip shouldBe ""
576+ readRef valueByUIRef >>= flip shouldBe ""
577+ readRef valueRef >>= flip shouldBe ""
563578 e <- WD.findElem $ WD.ByTag "textarea"
564579 WD.sendKeys "hello" e
565− liftIO $ do
566− threadDelay 100000
567− readIORef valueByUIRef >>= flip shouldBe "hello"
568− readIORef valueRef >>= flip shouldBe "hello"
569− writeChan setValueChan "world"
570− threadDelay 100000
571− readIORef valueByUIRef >>= flip shouldBe "hello"
572− readIORef valueRef >>= flip shouldBe "world"
580+ liftIO $ threadDelay 100000
581+ readRef valueByUIRef >>= flip shouldBe "hello"
582+ readRef valueRef >>= flip shouldBe "hello"
583+ liftIO $ writeChan setValueChan "world"
584+ liftIO $ threadDelay 100000
585+ readRef valueByUIRef >>= flip shouldBe "hello"
586+ readRef valueRef >>= flip shouldBe "world"
573587 testWidget (pure ()) checkValue $ do
574588 setValue' <- triggerEventWithChan setValueChan
575589 prerender_ (pure ()) $ do
576590 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }
577− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _textAreaElement_input e
578− performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
591+ performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e
592+ performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)
579593
580594 describe "selectElement" $ do
581595 let options :: DomBuilder t m => m ()
@@ -583,9 +597,9 @@ tests _selenium = do
583597 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"
584598 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"
585599 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"
586− describe "hydration" $ do
587− it "sets initial value correctly" $ do
588− inputRef <- newIORef ("" :: Text)
600+ describe "hydration" $ session' $ do
601+ it "sets initial value correctly" $ runWD $ do
602+ inputRef <- newRef ("" :: Text)
589603 let setup = do
590604 e <- WD.findElem $ WD.ByTag "select"
591605 assertAttr e "value" (Just "three")
@@ -593,145 +607,142 @@ tests _selenium = do
593607 pure e
594608 check e = do
595609 assertAttr e "value" (Just "two")
596− liftIO $ readIORef inputRef >>= (`shouldBe` "three")
610+ readRef inputRef >>= (`shouldBe` "three")
597611 WD.click <=< WD.findElem $ WD.ByTag "button"
598612 assertAttr e "value" (Just "two")
599− liftIO $ readIORef inputRef >>= (`shouldBe` "two")
613+ readRef inputRef >>= (`shouldBe` "two")
600614 testWidget' setup check $ do
601615 (e, ()) <- selectElement (def { _selectElementConfig_initialValue = "three" }) options
602616 click <- button "save"
603− liftIO . writeIORef inputRef <=< sample $ current $ _selectElement_value e
604− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
605− it "captures user input after switchover" $ do
606− inputRef <- newIORef ("" :: Text)
617+ liftIO . writeRef inputRef <=< sample $ current $ _selectElement_value e
618+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
619+ it "captures user input after switchover" $ runWD $ do
620+ inputRef <- newRef ("" :: Text)
607621 let checkValue = do
608622 e <- WD.findElem $ WD.ByTag "select"
609623 assertAttr e "value" (Just "one")
610624 WD.click <=< WD.findElem $ WD.ById "two"
611625 assertAttr e "value" (Just "two")
612626 WD.click <=< WD.findElem $ WD.ByTag "button"
613− liftIO $ readIORef inputRef >>= (`shouldBe` "two")
627+ readRef inputRef >>= (`shouldBe` "two")
614628 testWidget (pure ()) checkValue $ do
615629 (e, ()) <- selectElement def options
616630 click <- button "save"
617− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
618− it "sets focus appropriately" $ do
619− focusRef <- newIORef False
631+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
632+ it "sets focus appropriately" $ runWD $ do
633+ focusRef <- newRef False
620634 let checkValue = do
621− liftIO $ readIORef focusRef >>= flip shouldBe False
635+ readRef focusRef >>= flip shouldBe False
622636 e <- WD.findElem $ WD.ByTag "select"
623637 WD.click e
624638 liftIO $ threadDelay 100000
625− liftIO $ readIORef focusRef >>= flip shouldBe True
639+ readRef focusRef >>= flip shouldBe True
626640 testWidget (pure ()) checkValue $ do
627641 (e, ()) <- selectElement def options
628− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_selectElement_hasFocus e)
629− it "sets focus when focus occurs before hydration" $ do
630− focusRef <- newIORef False
642+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
643+ it "sets focus when focus occurs before hydration" $ runWD $ do
644+ focusRef <- newRef False
631645 let setup = do
632646 e <- WD.findElem $ WD.ByTag "select"
633647 WD.click e
634648 hasFocus <- (== e) <$> WD.activeElem
635− liftIO $ do
636− hasFocus `shouldBe` True
637− readIORef focusRef >>= flip shouldBe False
638− check = liftIO $ readIORef focusRef >>= flip shouldBe True
649+ hasFocus `shouldBe` True
650+ readRef focusRef >>= flip shouldBe False
651+ check = readRef focusRef >>= flip shouldBe True
639652 testWidget setup check $ do
640653 (e, ()) <- selectElement def options
641− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_selectElement_hasFocus e)
642− it "sets value appropriately" $ do
643− valueByUIRef <- newIORef ("" :: Text)
644− valueRef <- newIORef ("" :: Text)
645− setValueChan :: Chan Text <- newChan
654+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
655+ it "sets value appropriately" $ runWD $ do
656+ valueByUIRef <- newRef ("" :: Text)
657+ valueRef <- newRef ("" :: Text)
658+ setValueChan :: Chan Text <- liftIO newChan
646659 let checkValue = do
647660 e <- WD.findElem $ WD.ByTag "select"
648661 assertAttr e "value" (Just "one")
649− liftIO $ readIORef valueByUIRef >>= flip shouldBe "one"
650− liftIO $ readIORef valueRef >>= flip shouldBe "one"
662+ readRef valueByUIRef >>= flip shouldBe "one"
663+ readRef valueRef >>= flip shouldBe "one"
651664 WD.click <=< WD.findElem $ WD.ById "two"
652− liftIO $ do
653− threadDelay 100000
654− readIORef valueByUIRef >>= flip shouldBe "two"
655− readIORef valueRef >>= flip shouldBe "two"
656− writeChan setValueChan "three"
657− threadDelay 100000
658− readIORef valueByUIRef >>= flip shouldBe "two"
659− readIORef valueRef >>= flip shouldBe "three"
665+ liftIO $ threadDelay 100000
666+ readRef valueByUIRef >>= flip shouldBe "two"
667+ readRef valueRef >>= flip shouldBe "two"
668+ liftIO $ writeChan setValueChan "three"
669+ liftIO $ threadDelay 100000
670+ readRef valueByUIRef >>= flip shouldBe "two"
671+ readRef valueRef >>= flip shouldBe "three"
660672 testWidget (pure ()) checkValue $ do
661673 setValue' <- triggerEventWithChan setValueChan
662674 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
663− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e
664− performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)
675+ performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
676+ performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
665677
666− describe "hydration/immediate" $ do
667− it "captures user input after switchover" $ do
668− inputRef :: IORef Text <- newIORef ""
678+ describe "hydration/immediate" $ session' $ do
679+ it "captures user input after switchover" $ runWD $ do
680+ inputRef :: IORef Text <- newRef ""
669681 let checkValue = do
670682 WD.click <=< WD.findElem $ WD.ById "two"
671683 WD.click <=< WD.findElem $ WD.ByTag "button"
672− liftIO $ readIORef inputRef >>= flip shouldBe "two"
684+ readRef inputRef >>= flip shouldBe "two"
673685 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
674686 (e, ()) <- selectElement def options
675687 click <- button "save"
676− performEvent_ $ liftIO . writeIORef inputRef <$> tag (current (_selectElement_value e)) click
677− it "sets focus appropriately" $ do
678− focusRef <- newIORef False
688+ performEvent_ $ liftIO . writeRef inputRef <$> tag (current (_selectElement_value e)) click
689+ it "sets focus appropriately" $ runWD $ do
690+ focusRef <- newRef False
679691 let checkValue = do
680− liftIO $ readIORef focusRef >>= flip shouldBe False
692+ readRef focusRef >>= flip shouldBe False
681693 e <- WD.findElem $ WD.ByTag "select"
682694 WD.click e
683695 liftIO $ threadDelay 100000
684− liftIO $ readIORef focusRef >>= flip shouldBe True
696+ readRef focusRef >>= flip shouldBe True
685697 testWidget (pure ()) checkValue $ prerender_ (pure ()) $ do
686698 (e, ()) <- selectElement def options
687− performEvent_ $ liftIO . writeIORef focusRef <$> updated (_selectElement_hasFocus e)
688− it "sets value appropriately" $ do
689− valueByUIRef :: IORef Text <- newIORef ""
690− valueRef :: IORef Text <- newIORef ""
691− setValueChan :: Chan Text <- newChan
699+ performEvent_ $ liftIO . writeRef focusRef <$> updated (_selectElement_hasFocus e)
700+ it "sets value appropriately" $ runWD $ do
701+ valueByUIRef :: IORef Text <- newRef ""
702+ valueRef :: IORef Text <- newRef ""
703+ setValueChan :: Chan Text <- liftIO newChan
692704 let checkValue = do
693− liftIO $ readIORef valueByUIRef >>= flip shouldBe "one"
694− liftIO $ readIORef valueRef >>= flip shouldBe "one"
705+ readRef valueByUIRef >>= flip shouldBe "one"
706+ readRef valueRef >>= flip shouldBe "one"
695707 WD.click <=< WD.findElem $ WD.ById "two"
696− liftIO $ do
697− threadDelay 100000
698− readIORef valueByUIRef >>= flip shouldBe "two"
699− readIORef valueRef >>= flip shouldBe "two"
700− writeChan setValueChan "three"
701− threadDelay 100000
702− readIORef valueByUIRef >>= flip shouldBe "two"
703− readIORef valueRef >>= flip shouldBe "three"
708+ liftIO $ threadDelay 100000
709+ readRef valueByUIRef >>= flip shouldBe "two"
710+ readRef valueRef >>= flip shouldBe "two"
711+ liftIO $ writeChan setValueChan "three"
712+ liftIO $ threadDelay 100000
713+ readRef valueByUIRef >>= flip shouldBe "two"
714+ readRef valueRef >>= flip shouldBe "three"
704715 testWidget (pure ()) checkValue $ do
705716 setValue' <- triggerEventWithChan setValueChan
706717 prerender_ (pure ()) $ do
707718 (e, ()) <- selectElement def { _selectElementConfig_setValue = Just setValue' } options
708− performEvent_ $ liftIO . writeIORef valueByUIRef <$> _selectElement_change e
709− performEvent_ $ liftIO . writeIORef valueRef <$> updated (_selectElement_value e)
719+ performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e
720+ performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)
710721
711− describe "prerender" $ do
712− it "works in simple case" $ do
722+ describe "prerender" $ session' $ do
723+ it "works in simple case" $ runWD $ do
713724 testWidget (checkBodyText "One") (checkBodyText "Two") $ do
714725 prerender_ (text "One") (text "Two")
715− it "removes element correctly" $ do
726+ it "removes element correctly" $ runWD $ do
716727 testWidget' (WD.findElem $ WD.ByTag "span") elementShouldBeRemoved $ do
717728 prerender_ (el "span" $ text "One") (text "Two")
718− it "can be nested in server widget" $ do
729+ it "can be nested in server widget" $ runWD $ do
719730 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
720731 prerender_ (prerender_ (text "One") (text "Two")) (text "Three")
721− it "can be nested in client widget" $ do
732+ it "can be nested in client widget" $ runWD $ do
722733 testWidget (checkBodyText "One") (checkBodyText "Three") $ do
723734 prerender_ (text "One") (prerender_ (text "Two") (text "Three"))
724− it "works with prerender_ siblings" $ do
735+ it "works with prerender_ siblings" $ runWD $ do
725736 testWidget
726737 (checkTextInId "a1" "One" >> checkTextInId "b1" "Three" >> checkTextInId "c1" "Five")
727738 (checkTextInId "a2" "Two" >> checkTextInId "b2" "Four" >> checkTextInId "c2" "Six") $ do
728739 prerender_ (divId "a1" $ text "One") (divId "a2" $ text "Two")
729740 prerender_ (divId "b1" $ text "Three") (divId "b2" $ text "Four")
730741 prerender_ (divId "c1" $ text "Five") (divId "c2" $ text "Six")
731− it "works inside other element" $ do
742+ it "works inside other element" $ runWD $ do
732743 testWidget (checkTextInTag "div" "One") (checkTextInTag "div" "Two") $ do
733744 el "div" $ prerender_ (text "One") (text "Two")
734− it "places fences and removes them" $ do
745+ it "places fences and removes them" $ runWD $ do
735746 testWidget'
736747 (do
737748 scripts <- WD.findElems $ WD.ByTag "script"
@@ -739,19 +750,19 @@ tests _selenium = do
739750 )
740751 (traverse_ elementShouldBeRemoved)
741752 (el "span" $ prerender_ (text "One") (text "Two"))
742− it "postBuild works on server side" $ do
743− lock :: MVar () <- newEmptyMVar
753+ it "postBuild works on server side" $ runWD $ do
754+ lock :: MVar () <- liftIO newEmptyMVar
744755 testWidget (liftIO $ takeMVar lock) (pure ()) $ do
745756 prerender_ (do
746757 pb <- getPostBuild
747758 performEvent_ $ liftIO (putMVar lock ()) <$ pb) blank
748− it "postBuild works on client side" $ do
749− lock :: MVar () <- newEmptyMVar
759+ it "postBuild works on client side" $ runWD $ do
760+ lock :: MVar () <- liftIO newEmptyMVar
750761 testWidget (pure ()) (liftIO $ takeMVar lock) $ do
751762 prerender_ blank $ do
752763 pb <- getPostBuild
753764 performEvent_ $ liftIO (putMVar lock ()) <$ pb
754− it "result Dynamic is updated *after* switchover" $ do
765+ it "result Dynamic is updated *after* switchover" $ runWD $ do
755766 let static = shouldContainText "PostBuild" =<< WD.findElem (WD.ByTag "body")
756767 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
757768 testWidget static check $ void $ do
@@ -761,14 +772,14 @@ tests _selenium = do
761772 textNode $ TextNodeConfig initial $ Just $ leftmost [updated d, "PostBuild" <$ pb]
762773 -- This essentially checks that the client IO runs *after* switchover/postBuild,
763774 -- thus can't create conflicting DOM
764− it "can't exploit IO to break hydration" $ do
775+ it "can't exploit IO to break hydration" $ runWD $ do
765776 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
766777 testWidgetStatic static $ void $ do
767− ref <- liftIO $ newIORef "Initial"
768− prerender_ (pure ()) (liftIO $ writeIORef ref "Client")
769− text <=< liftIO $ readIORef ref
778+ ref <- liftIO $ newRef "Initial"
779+ prerender_ (pure ()) (liftIO $ writeRef ref "Client")
780+ text <=< liftIO $ readRef ref
770781 -- As above, so below
771− it "can't exploit triggerEvent to break hydration" $ do
782+ it "can't exploit triggerEvent to break hydration" $ runWD $ do
772783 let static = shouldContainText "Initial" =<< WD.findElem (WD.ByTag "body")
773784 check = shouldContainText "Client" =<< WD.findElem (WD.ByTag "body")
774785 testWidget static check $ void $ do
@@ -776,13 +787,13 @@ tests _selenium = do
776787 prerender_ (pure ()) (liftIO $ trigger "Client")
777788 textNode $ TextNodeConfig "Initial" $ Just e
778789
779− describe "runWithReplace" $ do
780− it "works" $ do
781− replaceChan :: Chan Text <- newChan
790+ describe "runWithReplace" $ session' $ do
791+ it "works" $ runWD $ do
792+ replaceChan :: Chan Text <- liftIO newChan
782793 let setup = WD.findElem $ WD.ByTag "div"
783794 check ssr = do
784795 -- Check that the original element still exists and has the correct text
785− WD.getText ssr >>= liftIO . flip shouldBe "two"
796+ WD.getText ssr >>= flip shouldBe "two"
786797 liftIO $ do
787798 writeChan replaceChan "three"
788799 threadDelay 100000
@@ -795,12 +806,12 @@ tests _selenium = do
795806 [ el "div" (text "two") <$ pb
796807 , el "span" . text <$> replace
797808 ]
798− it "can be nested in initial widget" $ do
799− replaceChan :: Chan Text <- newChan
809+ it "can be nested in initial widget" $ runWD $ do
810+ replaceChan :: Chan Text <- liftIO newChan
800811 let setup = WD.findElem $ WD.ByTag "div"
801812 check ssr = do
802813 -- Check that the original element still exists and has the correct text
803− WD.getText ssr >>= liftIO . flip shouldBe "two"
814+ WD.getText ssr >>= flip shouldBe "two"
804815 liftIO $ do
805816 writeChan replaceChan "three"
806817 threadDelay 100000
@@ -813,12 +824,12 @@ tests _selenium = do
813824 [ el "div" (text "two") <$ pb
814825 , el "span" . text <$> replace
815826 ]
816− it "can be nested in postBuild widget" $ do
817− replaceChan <- newChan
827+ it "can be nested in postBuild widget" $ runWD $ do
828+ replaceChan <- liftIO newChan
818829 let setup = WD.findElem $ WD.ByTag "div"
819830 check ssr = do
820831 -- Check that the original element still exists and has the correct text
821− WD.getText ssr >>= liftIO . flip shouldBe "two"
832+ WD.getText ssr >>= flip shouldBe "two"
822833 liftIO $ do
823834 writeChan replaceChan "three"
824835 threadDelay 100000
@@ -833,9 +844,9 @@ tests _selenium = do
833844 [ el "div" (text "two") <$ pb'
834845 , el "span" . text <$> replace
835846 ]
836− it "postBuild works in replaced widget" $ do
837− replaceChan <- newChan
838− pbLock <- newEmptyMVar
847+ it "postBuild works in replaced widget" $ runWD $ do
848+ replaceChan <- liftIO newChan
849+ pbLock <- liftIO newEmptyMVar
839850 let check = do
840851 liftIO $ do
841852 writeChan replaceChan ()
@@ -845,17 +856,18 @@ tests _selenium = do
845856 runWithReplace (pure ()) $ ffor replace $ \() -> do
846857 pb <- getPostBuild
847858 performEvent_ $ liftIO (putMVar pbLock ()) <$ pb
848− it "can be nested in event widget" $ do -- Test is broken, I think
849− replaceChan1 :: Chan Text <- newChan
850− replaceChan2 :: Chan Text <- newChan
851− 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
852864 let check = do
853865 shouldContainText "" =<< WD.findElem (WD.ByTag "body")
854866 liftIO $ do
855867 writeChan replaceChan1 "one"
856868 takeMVar lock
857869 one <- WD.findElem $ WD.ByTag "div"
858− WD.getText one >>= liftIO . flip shouldBe "pb"
870+ WD.getText one >>= flip shouldBe "pb"
859871 liftIO $ do
860872 writeChan replaceChan2 "two"
861873 threadDelay 100000
@@ -871,12 +883,13 @@ tests _selenium = do
871883 [ el "span" . text <$> replace2
872884 , el "div" (text "pb") <$ pb
873885 ]
874− it "works in immediate mode (RHS of prerender)" $ do
875− replaceChan :: Chan Text <- newChan
886+
887+ it "works in immediate mode (RHS of prerender)" $ runWD $ do
888+ replaceChan :: Chan Text <- liftIO newChan
876889 let check = do
877890 one <- WD.findElem $ WD.ByTag "div"
878891 shouldContainText "one" =<< WD.findElem (WD.ByTag "body")
879− WD.getText one >>= liftIO . flip shouldBe "one"
892+ WD.getText one >>= flip shouldBe "one"
880893 liftIO $ do
881894 writeChan replaceChan "pb"
882895 threadDelay 100000
@@ -886,12 +899,12 @@ tests _selenium = do
886899 replace <- triggerEventWithChan replaceChan
887900 prerender_ blank $ do
888901 void $ runWithReplace (el "div" $ text "one") $ el "span" . text <$> replace
889− it "works with postBuild in immediate mode (RHS of prerender)" $ do
890− replaceChan :: Chan Text <- newChan
902+ it "works with postBuild in immediate mode (RHS of prerender)" $ runWD $ do
903+ replaceChan :: Chan Text <- liftIO newChan
891904 let check = do
892905 two <- WD.findElem $ WD.ByTag "div"
893906 shouldContainText "two" =<< WD.findElem (WD.ByTag "body")
894− WD.getText two >>= liftIO . flip shouldBe "two"
907+ WD.getText two >>= flip shouldBe "two"
895908 liftIO $ do
896909 writeChan replaceChan "three"
897910 threadDelay 100000
@@ -906,7 +919,7 @@ tests _selenium = do
906919 , el "span" . text <$> replace
907920 ]
908921
909− describe "traverseDMapWithKeyWithAdjust" $ do
922+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do
910923 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
911924 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
912925 elClass "span" "key" $ text $ textKey k
@@ -944,19 +957,21 @@ tests _selenium = do
944957 e <- WD.findElem (WD.ById $ textKey k)
945958 checkItem e (textKey k) (T.pack $ show v)
946959 postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
947− it "doesn't replace elements at switchover, can delete/update/insert" $ do
948− chan <- newChan
949− let static = getAndCheckInitialItems keyMap
960+ it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
961+ chan <- liftIO newChan
962+ let static :: WD [WD.Element]
963+ static = getAndCheckInitialItems keyMap
964+ check :: [WD.Element] -> WD ()
950965 check xs = do
951966 checkInitialItems keyMap xs
952967 checkRemoval chan Key_Int
953968 checkReplace chan Key_Char 'B'
954969 checkInsert chan Key_Bool True
955− testWidget' static check $ void $ do
970+ testWidget' static check $ do
956971 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
957− liftIO $ dmap `shouldBe` keyMap
958− it "handles postBuild correctly" $ do
959− chan <- newChan
972+ liftIO $ dmap `H.shouldBe` keyMap
973+ it "handles postBuild correctly" $ runWD $ do
974+ chan <- liftIO newChan
960975 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
961976 check xs = do
962977 checkInitialItems (fromMaybe undefined $ apply postBuildPatch keyMap) xs
@@ -967,9 +982,9 @@ tests _selenium = do
967982 pb <- getPostBuild
968983 replace <- triggerEventWithChan chan
969984 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
970− liftIO $ dmap `shouldBe` keyMap
971− it "can delete/update/insert when built in prerender" $ do
972− chan <- newChan
985+ liftIO $ dmap `H.shouldBe` keyMap
986+ it "can delete/update/insert when built in prerender" $ runWD $ do
987+ chan <- liftIO newChan
973988 let check = do
974989 _ <- getAndCheckInitialItems keyMap
975990 checkRemoval chan Key_Int
@@ -979,9 +994,9 @@ tests _selenium = do
979994 replace <- triggerEventWithChan chan
980995 prerender_ (pure ()) $ do
981996 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap replace
982− liftIO $ dmap `shouldBe` keyMap
983− it "can delete/update/insert when built in immediate mode" $ do
984− chan <- newChan
997+ liftIO $ dmap `H.shouldBe` keyMap
998+ it "can delete/update/insert when built in immediate mode" $ runWD $ do
999+ chan <- liftIO newChan
9851000 let check = do
9861001 _ <- getAndCheckInitialItems keyMap
9871002 checkRemoval chan Key_Int
@@ -991,10 +1006,10 @@ tests _selenium = do
9911006 pb <- getPostBuild
9921007 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
9931008 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
994− liftIO $ dmap `shouldBe` keyMap
1009+ liftIO $ dmap `H.shouldBe` keyMap
9951010 -- Should be fixed by prerender changes!
996− it "handles postBuild correctly in prerender" $ do
997− chan <- newChan
1011+ it "handles postBuild correctly in prerender" $ runWD $ do
1012+ chan <- liftIO newChan
9981013 let check = do
9991014 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch keyMap)
10001015 checkRemoval chan Key_Int
@@ -1005,9 +1020,9 @@ tests _selenium = do
10051020 prerender_ (pure ()) $ void $ do
10061021 pb <- getPostBuild
10071022 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
1008− liftIO $ dmap `shouldBe` keyMap
1023+ liftIO $ dmap `H.shouldBe` keyMap
10091024
1010− describe "traverseIntMapWithKeyWithAdjust" $ do
1025+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do
10111026 let textKeyInt k = "key" <> T.pack (show k)
10121027 intMap = IntMap.fromList
10131028 [ (1, "one")
@@ -1051,8 +1066,8 @@ tests _selenium = do
10511066 e <- WD.findElem (WD.ById $ textKeyInt k)
10521067 checkItem e (textKeyInt k) v
10531068 postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
1054− it "doesn't replace elements at switchover, can delete/update/insert" $ do
1055− chan <- newChan
1069+ it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
1070+ chan <- liftIO newChan
10561071 let static = getAndCheckInitialItems intMap
10571072 check xs = do
10581073 checkInitialItems intMap xs
@@ -1061,9 +1076,9 @@ tests _selenium = do
10611076 checkInsert chan 4 "four"
10621077 testWidget' static check $ void $ do
10631078 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1064− liftIO $ im `shouldBe` intMap
1065− it "handles postBuild correctly" $ do
1066− chan <- newChan
1079+ liftIO $ im `H.shouldBe` intMap
1080+ it "handles postBuild correctly" $ runWD $ do
1081+ chan <- liftIO newChan
10671082 let static = getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
10681083 check xs = do
10691084 checkInitialItems (fromMaybe undefined $ apply postBuildPatch intMap) xs
@@ -1074,9 +1089,9 @@ tests _selenium = do
10741089 pb <- getPostBuild
10751090 replace <- triggerEventWithChan chan
10761091 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1077− liftIO $ dmap `shouldBe` intMap
1078− it "can delete/update/insert when built in prerender" $ do
1079− chan <- newChan
1092+ liftIO $ dmap `H.shouldBe` intMap
1093+ it "can delete/update/insert when built in prerender" $ runWD $ do
1094+ chan <- liftIO newChan
10801095 let check = do
10811096 _ <- getAndCheckInitialItems intMap
10821097 checkRemoval chan 1
@@ -1086,9 +1101,9 @@ tests _selenium = do
10861101 replace <- triggerEventWithChan chan
10871102 prerender_ (pure ()) $ do
10881103 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap replace
1089− liftIO $ dmap `shouldBe` intMap
1090− it "can delete/update/insert when built in immediate mode" $ do
1091− chan <- newChan
1104+ liftIO $ dmap `H.shouldBe` intMap
1105+ it "can delete/update/insert when built in immediate mode" $ runWD $ do
1106+ chan <- liftIO newChan
10921107 let check = do
10931108 _ <- getAndCheckInitialItems intMap
10941109 checkRemoval chan 1
@@ -1098,10 +1113,10 @@ tests _selenium = do
10981113 pb <- getPostBuild
10991114 runWithReplace (pure ()) $ ffor pb $ \() -> void $ do
11001115 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
1101− liftIO $ dmap `shouldBe` intMap
1116+ liftIO $ dmap `H.shouldBe` intMap
11021117 -- Should be fixed by prerender changes!
1103− it "handles postBuild correctly in prerender" $ do
1104− chan <- newChan
1118+ it "handles postBuild correctly in prerender" $ runWD $ do
1119+ chan <- liftIO newChan
11051120 let check = do
11061121 _ <- getAndCheckInitialItems (fromJust $ apply postBuildPatch intMap)
11071122 checkRemoval chan 1
@@ -1112,7 +1127,7 @@ tests _selenium = do
11121127 prerender_ (pure ()) $ void $ do
11131128 pb <- getPostBuild
11141129 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
1115− liftIO $ dmap `shouldBe` intMap
1130+ liftIO $ dmap `H.shouldBe` intMap
11161131
11171132 describe "traverseDMapWithKeyWithAdjustWithMove" $ do
11181133 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)
@@ -1226,7 +1241,7 @@ startSeleniumServer port = do
12261241
12271242withSeleniumServer :: (Selenium -> IO ()) -> IO ()
12281243withSeleniumServer f = do
1229− let port = 4444 -- TODO port <- getFreePort
1244+ port <- getFreePort
12301245 stopServer <- startSeleniumServer port
12311246 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
12321247 f $ Selenium
@@ -1251,7 +1266,7 @@ elementShouldBeRemoved e = do
12511266 Right !_ -> liftIO $ assertFailure "Expected element to be removed, but it still exists"
12521267
12531268shouldContainText :: Text -> WD.Element -> WD ()
1254−shouldContainText t = liftIO . flip shouldBe t <=< WD.getText
1269+shouldContainText t = flip shouldBe t <=< WD.getText
12551270
12561271checkBodyText :: Text -> WD ()
12571272checkBodyText = checkTextInTag "body"
@@ -1272,7 +1287,7 @@ testWidgetStatic
12721287 -- ^ Webdriver commands to run before JS runs and after hydration switchover
12731288 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
12741289 -- ^ Widget we are testing
1275− -> IO b
1290+ -> WD b
12761291testWidgetStatic w = testWidget (void w) w
12771292
12781293-- | TODO: do something about JSExceptions not causing tests to fail
@@ -1283,7 +1298,7 @@ testWidget
12831298 -- ^ Webdriver commands to run after hydration switchover
12841299 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
12851300 -- ^ Widget we are testing
1286− -> IO b
1301+ -> WD b
12871302testWidget beforeJS afterSwitchover = testWidget' beforeJS (const afterSwitchover)
12881303
12891304-- | TODO: do something about JSExceptions not causing tests to fail
@@ -1294,37 +1309,44 @@ testWidget'
12941309 -- ^ Webdriver commands to run after hydration switchover
12951310 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
12961311 -- ^ Widget we are testing (contents of body)
1297− -> IO b
1312+ -> WD b
12981313testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out") pure <=< timeout testTimeLimit $ do
12991314 let staticApp = do
13001315 el "head" $ pure ()
13011316 el "body" $ do
13021317 bodyWidget
13031318 el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
1304− ((), html) <- renderStatic staticApp
1305− waitBeforeJS <- newEmptyMVar -- Empty until JS should be run
1306− waitUntilSwitchover <- newEmptyMVar -- Empty until switchover
1319+ ((), html) <- liftIO $ renderStatic staticApp
1320+ waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
1321+ waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
13071322 let entryPoint = do
13081323 liftIO $ takeMVar waitBeforeJS
13091324 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget
13101325 syncPoint
1311− application <- jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html
1326+ application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse ->
1327+ sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html
13121328 port <- getFreePort
1313− let settings = Warp.setPort (fromIntegral $ toInteger port) Warp.defaultSettings
1329+ waitJSaddle <- liftIO newEmptyMVar
1330+ let settings = foldr ($) Warp.defaultSettings
1331+ [ Warp.setPort $ fromIntegral (toInteger port)
1332+ , Warp.setBeforeMainLoop $ putMVar waitJSaddle ()
1333+ ]
13141334 -- hSilence to get rid of ConnectionClosed logs
13151335 jsaddleWarp = forkIO $ hSilence [stderr] $ Warp.runSettings settings application
1316− bracket jsaddleWarp killThread $ \_ -> do
1317− browserPath <- T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""
1318− when (T.null browserPath) $ fail "No browser was found"
1319− WD.runSession (chromeConfig browserPath) . WD.finallyClose $ do
1320− WD.openPage $ "http://localhost:" <> show port
1321− a <- beforeJS
1322− liftIO $ putMVar waitBeforeJS ()
1323− liftIO $ takeMVar waitUntilSwitchover
1324− liftIO $ threadDelay 100000 -- wait a bit
1325− afterSwitchover a
1336+ jsaddleTid <- liftIO jsaddleWarp
1337+ liftIO $ takeMVar waitJSaddle
1338+ WD.openPage $ "http://localhost:" <> show port
1339+ a <- beforeJS
1340+ liftIO $ putMVar waitBeforeJS ()
1341+ liftIO $ takeMVar waitUntilSwitchover
1342+ liftIO $ threadDelay 100000 -- wait a bit
1343+ b <- afterSwitchover a
1344+ liftIO $ killThread jsaddleTid
1345+ return b
1346+
13261347
13271348-- TODO: Should this be part of more widely used module?
1349+-- TODO: Ensure port is not taken
13281350getFreePort :: MonadIO m => m PortNumber
13291351getFreePort = liftIO $ withSocketsDo $ do
13301352 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")