@@ -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
@@ -60,6 +62,7 @@ import Test.Hspec (xit)
6062import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)
6163import qualified Test.Hspec.WebDriver as WD
6264import Test.WebDriver (WD(..))
65+import Test.WebDriver.Exceptions (ServerError(..))
6366
6467import qualified Data.ByteString.Lazy as LBS
6568import qualified Data.Dependent.Map as DMap
@@ -121,6 +124,8 @@ deriveGEq ''DKey
121124deriveGCompare ''DKey
122125deriveGShow ''DKey
123126
127+deriving instance MonadFail WD
128+
124129main :: IO ()
125130main = do
126131 unshareNetork
@@ -741,9 +746,9 @@ tests withDebugging wdConfig caps _selenium = do
741746 pb <- getPostBuild
742747 performEvent_ $ liftIO (putMVar lock ()) <$ pb
743748 it "result Dynamic is updated *after* switchover" $ runWD $ do
744− let static = checkBodyText "PostBuild"
749+ let preSwitchover = checkBodyText "PostBuild"
745750 check = checkBodyText "Client"
746− testWidget static check $ void $ do
751+ testWidget preSwitchover check $ void $ do
747752 d <- prerender (pure "Initial") (pure "Client")
748753 pb <- getPostBuild
749754 initial <- sample $ current d
@@ -751,16 +756,16 @@ tests withDebugging wdConfig caps _selenium = do
751756 -- This essentially checks that the client IO runs *after* switchover/postBuild,
752757 -- thus can't create conflicting DOM
753758 it "can't exploit IO to break hydration" $ runWD $ do
754− let static = checkBodyText "Initial"
755− testWidgetStatic static $ void $ do
759+ let preSwitchover = checkBodyText "Initial"
760+ testWidgetStatic preSwitchover $ void $ do
756761 ref <- liftIO $ newRef "Initial"
757762 prerender_ (pure ()) (liftIO $ writeRef ref "Client")
758763 text <=< liftIO $ readRef ref
759764 -- As above, so below
760765 it "can't exploit triggerEvent to break hydration" $ runWD $ do
761− let static = checkBodyText "Initial"
766+ let preSwitchover = checkBodyText "Initial"
762767 check = checkBodyText "Client"
763− testWidget static check $ void $ do
768+ testWidget preSwitchover check $ void $ do
764769 (e, trigger) <- newTriggerEvent
765770 prerender_ (pure ()) (liftIO $ trigger "Client")
766771 textNode $ TextNodeConfig "Initial" $ Just e
@@ -949,26 +954,26 @@ tests withDebugging wdConfig caps _selenium = do
949954 postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
950955 it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
951956 chan <- liftIO newChan
952− let static :: WD [WD.Element]
953− static = getAndCheckInitialItems keyMap
957+ let preSwitchover :: WD [WD.Element]
958+ preSwitchover = getAndCheckInitialItems keyMap
954959 check :: [WD.Element] -> WD ()
955960 check xs = do
956961 checkInitialItems keyMap xs
957962 checkRemoval chan Key_Int
958963 checkReplace chan Key_Char 'B'
959964 checkInsert chan Key_Bool True
960− testWidget' static check $ do
965+ testWidget' preSwitchover check $ do
961966 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
962967 liftIO $ dmap `H.shouldBe` keyMap
963968 it "handles postBuild correctly" $ runWD $ do
964969 chan <- liftIO newChan
965− let static = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
970+ let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
966971 check xs = do
967972 withRetry $ checkInitialItems (applyAlways postBuildPatch keyMap) xs
968973 checkRemoval chan Key_Int
969974 checkInsert chan Key_Char 'B'
970975 checkReplace chan Key_Bool True
971− testWidget' static check $ void $ do
976+ testWidget' preSwitchover check $ void $ do
972977 pb <- getPostBuild
973978 replace <- triggerEventWithChan chan
974979 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
@@ -1058,24 +1063,24 @@ tests withDebugging wdConfig caps _selenium = do
10581063 postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
10591064 xit "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
10601065 chan <- liftIO newChan
1061− let static = getAndCheckInitialItems intMap
1066+ let preSwitchover = getAndCheckInitialItems intMap
10621067 check xs = do
10631068 checkInitialItems intMap xs
10641069 checkRemoval chan 1
10651070 checkReplace chan 2 "deux"
10661071 checkInsert chan 4 "four"
1067− testWidget' static check $ void $ do
1072+ testWidget' preSwitchover check $ void $ do
10681073 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
10691074 liftIO $ im `H.shouldBe` intMap
10701075 xit "handles postBuild correctly" $ runWD $ do
10711076 chan <- liftIO newChan
1072− let static = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
1077+ let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
10731078 check xs = do
10741079 withRetry $ checkInitialItems (applyAlways postBuildPatch intMap) xs
10751080 checkRemoval chan 1
10761081 checkInsert chan 2 "deux"
10771082 checkReplace chan 3 "trois"
1078− testWidget' static check $ void $ do
1083+ testWidget' preSwitchover check $ void $ do
10791084 pb <- getPostBuild
10801085 replace <- triggerEventWithChan chan
10811086 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
@@ -1170,12 +1175,12 @@ tests withDebugging wdConfig caps _selenium = do
11701175
11711176 describe "hydration" $ moveSpec $ \initMap test -> do
11721177 chan <- liftIO newChan
1173− let static = getAndCheckInitialItems initMap
1178+ let preSwitchover = getAndCheckInitialItems initMap
11741179 check xs = do
11751180 checkInitialItems initMap xs
11761181 body <- getBody
11771182 test body chan
1178− testWidget' static check $ void $ do
1183+ testWidget' preSwitchover check $ void $ do
11791184 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
11801185 liftIO $ assertEqual "DMap" initMap dmap
11811186
@@ -1201,7 +1206,7 @@ tests withDebugging wdConfig caps _selenium = do
12011206
12021207 describe "hydrating invalid HTML" $ session' $ do
12031208 it "can hydrate list in paragraph" $ runWD $ do
1204− let static = do
1209+ let preSwitchover = do
12051210 checkBodyText "before\ninner\nafter"
12061211 -- Two <p> tags should be present
12071212 (p1, p2) <- WD.findElems (WD.ByTag "p") >>= \case
@@ -1217,7 +1222,7 @@ tests withDebugging wdConfig caps _selenium = do
12171222 shouldContainText "before\ninner\nafter" p1
12181223 elementShouldBeRemoved ol
12191224 elementShouldBeRemoved p2
1220− testWidget' static check $ do
1225+ testWidget' preSwitchover check $ do
12211226 -- This is deliberately invalid HTML, the browser will interpret it as
12221227 -- <p>before</p><ol>inner</ol>after<p></p>
12231228 el "p" $ do