@@ -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
@@ -52,6 +54,7 @@ import System.IO (stderr)
5254import System.IO.Silently
5355import System.IO.Temp
5456import System.Process
57+import System.Which (staticWhich)
5558import qualified Test.HUnit as HUnit (assertEqual, assertFailure)
5659import qualified Test.Hspec as H
5760import qualified Test.Hspec.Core.Spec as H
@@ -59,6 +62,7 @@ import Test.Hspec (xit)
5962import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)
6063import qualified Test.Hspec.WebDriver as WD
6164import Test.WebDriver (WD(..))
65+import Test.WebDriver.Exceptions (ServerError(..))
6266
6367import qualified Data.ByteString.Lazy as LBS
6468import qualified Data.Dependent.Map as DMap
@@ -74,6 +78,9 @@ import qualified Test.WebDriver.Capabilities as WD
7478import Test.Util.ChromeFlags
7579import Test.Util.UnshareNetwork
7680
81+chromium :: FilePath
82+chromium = $(staticWhich "chromium")
83+
7784seleniumPort, jsaddlePort :: PortNumber
7885seleniumPort = 8000
7986jsaddlePort = 8001
@@ -117,13 +124,15 @@ deriveGEq ''DKey
117124deriveGCompare ''DKey
118125deriveGShow ''DKey
119126
127+deriving instance MonadFail WD
128+
120129main :: IO ()
121130main = do
122131 unshareNetork
123132 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"
124133 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
125134 withSeleniumServer $ \selenium -> do
126− browserPath <- liftIO $ T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""
135+ let browserPath = T.strip $ T.pack chromium
127136 when (T.null browserPath) $ fail "No browser found"
128137 withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
129138 let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
@@ -737,9 +746,9 @@ tests withDebugging wdConfig caps _selenium = do
737746 pb <- getPostBuild
738747 performEvent_ $ liftIO (putMVar lock ()) <$ pb
739748 it "result Dynamic is updated *after* switchover" $ runWD $ do
740− let static = checkBodyText "PostBuild"
749+ let preSwitchover = checkBodyText "PostBuild"
741750 check = checkBodyText "Client"
742− testWidget static check $ void $ do
751+ testWidget preSwitchover check $ void $ do
743752 d <- prerender (pure "Initial") (pure "Client")
744753 pb <- getPostBuild
745754 initial <- sample $ current d
@@ -747,16 +756,16 @@ tests withDebugging wdConfig caps _selenium = do
747756 -- This essentially checks that the client IO runs *after* switchover/postBuild,
748757 -- thus can't create conflicting DOM
749758 it "can't exploit IO to break hydration" $ runWD $ do
750− let static = checkBodyText "Initial"
751− testWidgetStatic static $ void $ do
759+ let preSwitchover = checkBodyText "Initial"
760+ testWidgetStatic preSwitchover $ void $ do
752761 ref <- liftIO $ newRef "Initial"
753762 prerender_ (pure ()) (liftIO $ writeRef ref "Client")
754763 text <=< liftIO $ readRef ref
755764 -- As above, so below
756765 it "can't exploit triggerEvent to break hydration" $ runWD $ do
757− let static = checkBodyText "Initial"
766+ let preSwitchover = checkBodyText "Initial"
758767 check = checkBodyText "Client"
759− testWidget static check $ void $ do
768+ testWidget preSwitchover check $ void $ do
760769 (e, trigger) <- newTriggerEvent
761770 prerender_ (pure ()) (liftIO $ trigger "Client")
762771 textNode $ TextNodeConfig "Initial" $ Just e
@@ -945,26 +954,26 @@ tests withDebugging wdConfig caps _selenium = do
945954 postBuildPatch = PatchDMap $ DMap.fromList [Key_Char :=> ComposeMaybe Nothing, Key_Bool :=> ComposeMaybe (Just $ Identity True)]
946955 it "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
947956 chan <- liftIO newChan
948− let static :: WD [WD.Element]
949− static = getAndCheckInitialItems keyMap
957+ let preSwitchover :: WD [WD.Element]
958+ preSwitchover = getAndCheckInitialItems keyMap
950959 check :: [WD.Element] -> WD ()
951960 check xs = do
952961 checkInitialItems keyMap xs
953962 checkRemoval chan Key_Int
954963 checkReplace chan Key_Char 'B'
955964 checkInsert chan Key_Bool True
956− testWidget' static check $ do
965+ testWidget' preSwitchover check $ do
957966 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap =<< triggerEventWithChan chan
958967 liftIO $ dmap `H.shouldBe` keyMap
959968 it "handles postBuild correctly" $ runWD $ do
960969 chan <- liftIO newChan
961− let static = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
970+ let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch keyMap
962971 check xs = do
963972 withRetry $ checkInitialItems (applyAlways postBuildPatch keyMap) xs
964973 checkRemoval chan Key_Int
965974 checkInsert chan Key_Char 'B'
966975 checkReplace chan Key_Bool True
967− testWidget' static check $ void $ do
976+ testWidget' preSwitchover check $ void $ do
968977 pb <- getPostBuild
969978 replace <- triggerEventWithChan chan
970979 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]
@@ -1054,24 +1063,24 @@ tests withDebugging wdConfig caps _selenium = do
10541063 postBuildPatch = PatchIntMap $ IntMap.fromList [(2, Nothing), (3, Just "trois"), (4, Just "four")]
10551064 xit "doesn't replace elements at switchover, can delete/update/insert" $ runWD $ do
10561065 chan <- liftIO newChan
1057− let static = getAndCheckInitialItems intMap
1066+ let preSwitchover = getAndCheckInitialItems intMap
10581067 check xs = do
10591068 checkInitialItems intMap xs
10601069 checkRemoval chan 1
10611070 checkReplace chan 2 "deux"
10621071 checkInsert chan 4 "four"
1063− testWidget' static check $ void $ do
1072+ testWidget' preSwitchover check $ void $ do
10641073 (im, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap =<< triggerEventWithChan chan
10651074 liftIO $ im `H.shouldBe` intMap
10661075 xit "handles postBuild correctly" $ runWD $ do
10671076 chan <- liftIO newChan
1068− let static = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
1077+ let preSwitchover = getAndCheckInitialItems $ applyAlways postBuildPatch intMap
10691078 check xs = do
10701079 withRetry $ checkInitialItems (applyAlways postBuildPatch intMap) xs
10711080 checkRemoval chan 1
10721081 checkInsert chan 2 "deux"
10731082 checkReplace chan 3 "trois"
1074− testWidget' static check $ void $ do
1083+ testWidget' preSwitchover check $ void $ do
10751084 pb <- getPostBuild
10761085 replace <- triggerEventWithChan chan
10771086 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]
@@ -1166,12 +1175,12 @@ tests withDebugging wdConfig caps _selenium = do
11661175
11671176 describe "hydration" $ moveSpec $ \initMap test -> do
11681177 chan <- liftIO newChan
1169− let static = getAndCheckInitialItems initMap
1178+ let preSwitchover = getAndCheckInitialItems initMap
11701179 check xs = do
11711180 checkInitialItems initMap xs
11721181 body <- getBody
11731182 test body chan
1174− testWidget' static check $ void $ do
1183+ testWidget' preSwitchover check $ void $ do
11751184 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan
11761185 liftIO $ assertEqual "DMap" initMap dmap
11771186
@@ -1197,10 +1206,12 @@ tests withDebugging wdConfig caps _selenium = do
11971206
11981207 describe "hydrating invalid HTML" $ session' $ do
11991208 it "can hydrate list in paragraph" $ runWD $ do
1200− let static = do
1209+ let preSwitchover = do
12011210 checkBodyText "before\ninner\nafter"
12021211 -- Two <p> tags should be present
1203− [p1, p2] <- WD.findElems (WD.ByTag "p")
1212+ (p1, p2) <- WD.findElems (WD.ByTag "p") >>= \case
1213+ [p1, p2] -> pure (p1, p2)
1214+ _ -> error "Unexpected number of `p` tags (expected 2)"
12041215 ol <- findElemWithRetry (WD.ByTag "ol")
12051216 shouldContainText "before" p1
12061217 shouldContainText "inner" ol
@@ -1211,7 +1222,7 @@ tests withDebugging wdConfig caps _selenium = do
12111222 shouldContainText "before\ninner\nafter" p1
12121223 elementShouldBeRemoved ol
12131224 elementShouldBeRemoved p2
1214− testWidget' static check $ do
1225+ testWidget' preSwitchover check $ do
12151226 -- This is deliberately invalid HTML, the browser will interpret it as
12161227 -- <p>before</p><ol>inner</ol>after<p></p>
12171228 el "p" $ do
@@ -1345,7 +1356,7 @@ testWidgetDebug' withDebugging beforeJS afterSwitchover bodyWidget = do
13451356 bodyWidget
13461357 el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False
13471358 putStrLnDebug "rendering static"
1348− ((), html) <- liftIO $ renderStatic staticApp
1359+ ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp
13491360 putStrLnDebug "rendered static"
13501361 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run
13511362 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover