@@ -20,9 +20,11 @@
2020{-# LANGUAGE TypeApplications #-}
2121{-# LANGUAGE TypeFamilies #-}
2222
23+import Prelude hiding (fail)
2324import Control.Concurrent
24−import Control.Monad
25+import Control.Monad hiding (fail)
2526import Control.Monad.Catch
27+import Control.Monad.Fail
2628import Control.Monad.Fix
2729import Control.Monad.IO.Class
2830import Control.Monad.Ref
@@ -59,6 +61,7 @@ import Test.Hspec (xit)
5961import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)
6062import qualified Test.Hspec.WebDriver as WD
6163import Test.WebDriver (WD(..))
64+import Test.WebDriver.Exceptions (ServerError(..))
6265
6366import qualified Data.ByteString.Lazy as LBS
6467import qualified Data.Dependent.Map as DMap
@@ -117,6 +120,8 @@ deriveGEq ''DKey
117120deriveGCompare ''DKey
118121deriveGShow ''DKey
119122
123+deriving instance MonadFail WD
124+
120125main :: IO ()
121126main = do
122127 unshareNetork
@@ -737,9 +742,9 @@ tests withDebugging wdConfig caps _selenium = do
737742 pb <- getPostBuild
738743 performEvent_ $ liftIO (putMVar lock ()) <$ pb
739744 it "result Dynamic is updated *after* switchover" $ runWD $ do
740− let static = checkBodyText "PostBuild"
745+ let preSwitchover = checkBodyText "PostBuild"
741746 check = checkBodyText "Client"
742− testWidget static check $ void $ do
747+ testWidget preSwitchover check $ void $ do
743748 d <- prerender (pure "Initial") (pure "Client")
744749 pb <- getPostBuild
745750 initial <- sample $ current d
@@ -747,16 +752,16 @@ tests withDebugging wdConfig caps _selenium = do
747752 -- This essentially checks that the client IO runs *after* switchover/postBuild,
748753 -- thus can't create conflicting DOM
749754 it "can't exploit IO to break hydration" $ runWD $ do
750− let static = checkBodyText "Initial"
751− testWidgetStatic static $ void $ do
755+ let preSwitchover = checkBodyText "Initial"
756+ testWidgetStatic preSwitchover $ void $ do
752757 ref <- liftIO $ newRef "Initial"
753758 prerender_ (pure ()) (liftIO $ writeRef ref "Client")
754759 text <=< liftIO $ readRef ref
755760 -- As above, so below
756761 it "can't exploit triggerEvent to break hydration" $ runWD $ do
757− let static = checkBodyText "Initial"
762+ let preSwitchover = checkBodyText "Initial"
758763 check = checkBodyText "Client"
759− testWidget static check $ void $ do
764+ testWidget preSwitchover check $ void $ do
760765 (e, trigger) <- newTriggerEvent
761766 prerender_ (pure ()) (liftIO $ trigger "Client")
762767 textNode $ TextNodeConfig "Initial" $ Just e
@@ -945,26 +950,26 @@ tests withDebugging wdConfig caps _selenium = do
945950 postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
946951 it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
947952 chan <- liftIO newChan
948− let static :: WD [WD.Element]
949− static = getAndCheckInitialItems keyMap
953+ let preSwitchover :: WD [WD.Element]
954+ preSwitchover = getAndCheckInitialItems keyMap
950955 check :: [WD.Element] -> WD ()
951956 check xs = do
952957 checkInitialItems keyMap xs
953958 checkRemoval chan Key_Int
954959 checkReplace chan Key_Char 'B'
955960 checkInsert chan Key_Bool True
956− testWidget' static check $ do
961+ testWidget' preSwitchover check $ do
957962 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
958963 liftIO $ dmap `H.shouldBe` keyMap
959964 it "handles postBuild correctly" $ runWD $ do
960965 chan <- liftIO newChan
961− let static = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
966+ let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
962967 check xs = do
963968 withRetry $ checkInitialItems (applyAlways postBuildPatch keyMap) xs
964969 checkRemoval chan Key_Int
965970 checkInsert chan Key_Char 'B'
966971 checkReplace chan Key_Bool True
967− testWidget' static check $ void $ do
972+ testWidget' preSwitchover check $ void $ do
968973 pb <- getPostBuild
969974 replace <- triggerEventWithChan chan
970975 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
@@ -1054,24 +1059,24 @@ tests withDebugging wdConfig caps _selenium = do
10541059 postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
10551060 xit "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
10561061 chan <- liftIO newChan
1057− let static = getAndCheckInitialItems intMap
1062+ let preSwitchover = getAndCheckInitialItems intMap
10581063 check xs = do
10591064 checkInitialItems intMap xs
10601065 checkRemoval chan 1
10611066 checkReplace chan 2 "deux"
10621067 checkInsert chan 4 "four"
1063− testWidget' static check $ void $ do
1068+ testWidget' preSwitchover check $ void $ do
10641069 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
10651070 liftIO $ im `H.shouldBe` intMap
10661071 xit "handles postBuild correctly" $ runWD $ do
10671072 chan <- liftIO newChan
1068− let static = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
1073+ let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
10691074 check xs = do
10701075 withRetry $ checkInitialItems (applyAlways postBuildPatch intMap) xs
10711076 checkRemoval chan 1
10721077 checkInsert chan 2 "deux"
10731078 checkReplace chan 3 "trois"
1074− testWidget' static check $ void $ do
1079+ testWidget' preSwitchover check $ void $ do
10751080 pb <- getPostBuild
10761081 replace <- triggerEventWithChan chan
10771082 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
@@ -1166,12 +1171,12 @@ tests withDebugging wdConfig caps _selenium = do
11661171
11671172 describe "hydration" $ moveSpec $ \initMap test -> do
11681173 chan <- liftIO newChan
1169− let static = getAndCheckInitialItems initMap
1174+ let preSwitchover = getAndCheckInitialItems initMap
11701175 check xs = do
11711176 checkInitialItems initMap xs
11721177 body <- getBody
11731178 test body chan
1174− testWidget' static check $ void $ do
1179+ testWidget' preSwitchover check $ void $ do
11751180 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
11761181 liftIO $ assertEqual "DMap" initMap dmap
11771182
@@ -1197,7 +1202,7 @@ tests withDebugging wdConfig caps _selenium = do
11971202
11981203 describe "hydrating invalid HTML" $ session' $ do
11991204 it "can hydrate list in paragraph" $ runWD $ do
1200− let static = do
1205+ let preSwitchover = do
12011206 checkBodyText "before\ninner\nafter"
12021207 -- Two <p> tags should be present
12031208 [p1, p2] <- WD.findElems (WD.ByTag "p")
@@ -1211,7 +1216,7 @@ tests withDebugging wdConfig caps _selenium = do
12111216 shouldContainText "before\ninner\nafter" p1
12121217 elementShouldBeRemoved ol
12131218 elementShouldBeRemoved p2
1214− testWidget' static check $ do
1219+ testWidget' preSwitchover check $ do
12151220 -- This is deliberately invalid HTML, the browser will interpret it as
12161221 -- <p>before</p><ol>inner</ol>after<p></p>
12171222 el "p" $ do
@@ -1344,9 +1349,9 @@ testWidgetDebug' withDebugging beforeJS afterSwitchover bodyWidget = do
13441349 el "body" $ do
13451350 bodyWidget
13461351 el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
1347− putStrLnDebug "rendering static"
1352+ putStrLnDebug "rendering preSwitchover"
13481353 ((), html) <- liftIO $ renderStatic staticApp
1349− putStrLnDebug "rendered static"
1354+ putStrLnDebug "rendered preSwitchover"
13501355 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
13511356 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
13521357 let entryPoint = do