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