mirror of
https://github.com/ilyakooo0/reflex-dom.git
synced 2024-09-11 06:35:30 +03:00
Cleanup selenium testing library
- Move to Reflex.Dom.Test.Selenium, screenshots are not part of this library. - Fix the nested hspec issue in the main function - Add utility function for embedding different spec types - More configurable stuff
This commit is contained in:
parent
2266870cb6
commit
2093f3fe12
@ -1 +1 @@
|
||||
packages: reflex-dom-core, reflex-dom, reflex-dom-test-selenium
|
||||
packages: chrome-test-utils, reflex-dom-core, reflex-dom, reflex-dom-test-selenium
|
||||
|
@ -19,22 +19,23 @@ library
|
||||
bytestring == 0.10.*,
|
||||
chrome-test-utils,
|
||||
exceptions,
|
||||
hspec-core,
|
||||
hspec-webdriver >= 1.2.1,
|
||||
http-types,
|
||||
jsaddle >= 0.9.0.0 && < 0.10,
|
||||
jsaddle-warp,
|
||||
http-types,
|
||||
network,
|
||||
reflex-dom-core,
|
||||
process,
|
||||
reflex-dom-core,
|
||||
silently,
|
||||
text == 1.2.*,
|
||||
wai,
|
||||
warp,
|
||||
text == 1.2.*,
|
||||
websockets,
|
||||
hspec-webdriver,
|
||||
webdriver
|
||||
webdriver,
|
||||
websockets
|
||||
|
||||
exposed-modules:
|
||||
Reflex.Dom.Test.Screenshot
|
||||
Reflex.Dom.Test.Selenium
|
||||
|
||||
default-language: Haskell98
|
||||
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively
|
||||
|
@ -9,16 +9,24 @@
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Reflex.Dom.Test.Screenshot
|
||||
-- | Utilities for testing reflex-dom widgets with Selenium.
|
||||
--
|
||||
-- Any uses of the 'testWidget' functions will start a jsaddle warp server and
|
||||
-- serve the given widget in an otherwise empty page. Webdriver commands can run
|
||||
-- on the statically rendered page, and on the hydrated page.
|
||||
module Reflex.Dom.Test.Selenium
|
||||
( TestWidget
|
||||
, TestWidgetConfig (..)
|
||||
, testWidget, testWidget', testWidgetStatic, testWidgetHydrated
|
||||
, testWithSelenium
|
||||
, withSeleniumSpec
|
||||
, embedSpec
|
||||
, SeleniumSetupConfig (..)
|
||||
) where
|
||||
|
||||
import Control.Concurrent (threadDelay, newEmptyMVar, takeMVar, putMVar)
|
||||
import Control.Monad (when, void)
|
||||
import Control.Monad.Catch (MonadMask, handle, finally)
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Catch (MonadMask, handle)
|
||||
import Control.Monad.Fix (MonadFix)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
import Data.Text (Text)
|
||||
@ -32,50 +40,48 @@ import Reflex.Dom.Core
|
||||
import System.IO (stderr)
|
||||
import System.IO.Silently (hSilence)
|
||||
import System.Process (std_in, std_out, std_err, createProcess, proc, StdStream (..), terminateProcess)
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
|
||||
import Test.Hspec.WebDriver (SpecWith, WdTestSession, hspec, sessionWith, using)
|
||||
import Test.Hspec.WebDriver (Spec, SpecWith, WdTestSession, sessionWith, using)
|
||||
import Test.Util.ChromeFlags
|
||||
import Test.Util.UnshareNetwork
|
||||
import Test.WebDriver (WD)
|
||||
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import qualified Test.Hspec.Core.Spec as Hspec
|
||||
import qualified Test.WebDriver as WD
|
||||
import qualified Test.WebDriver.Capabilities as WD
|
||||
|
||||
deriving instance MonadMask WD
|
||||
|
||||
testWithSelenium
|
||||
:: FilePath
|
||||
data SeleniumSetupConfig = SeleniumSetupConfig
|
||||
{ _seleniumSetupConfig_chromiumPath :: FilePath
|
||||
-- ^ Path to the chromium executable
|
||||
-> Bool
|
||||
, _seleniumSetupConfig_headless :: Bool
|
||||
-- ^ True means that the browser is invoked in headless mode, False means that
|
||||
-- the user can see the interaction happening on the browser (useful for debugging).
|
||||
-> SpecWith (WdTestSession a)
|
||||
-- ^ The tests we want to write in the selenium session
|
||||
-> IO ()
|
||||
testWithSelenium chromium isHeadless actualTests = do
|
||||
handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
|
||||
withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
|
||||
withSeleniumServer $ \selenium -> do
|
||||
let browserPath = T.strip $ T.pack chromium
|
||||
when (T.null browserPath) $ fail "No browser found"
|
||||
let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
|
||||
chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
|
||||
hspec (sessionWith wdConfig "" . using [(chromeCaps', "")] $ actualTests) `finally` _selenium_stopServer selenium
|
||||
|
||||
seleniumPort, jsaddlePort :: PortNumber
|
||||
seleniumPort = 8000
|
||||
jsaddlePort = 8001
|
||||
|
||||
data Selenium = Selenium
|
||||
{ _selenium_portNumber :: PortNumber
|
||||
, _selenium_stopServer :: IO ()
|
||||
, _seleniumSetupConfig_seleniumPort :: PortNumber
|
||||
-- ^ The port number used by selenium
|
||||
}
|
||||
|
||||
-- | Setup a selenium server and use it to run some hspec tests.
|
||||
--
|
||||
-- withSeleniumSpec config $ \runSession -> hspec $ do
|
||||
-- describe "tests using webdriver session" $ runSession $ do
|
||||
-- webdriver tests here
|
||||
withSeleniumSpec :: SeleniumSetupConfig -> ((forall multi. SpecWith (WdTestSession multi) -> Spec) -> IO a) -> IO a
|
||||
withSeleniumSpec config runSpec = do
|
||||
liftIO $ handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
|
||||
withSandboxedChromeFlags (_seleniumSetupConfig_headless config) $ \chromeFlags -> do
|
||||
withSeleniumServer (_seleniumSetupConfig_seleniumPort config) $ do
|
||||
let browserPath = T.strip $ T.pack $ _seleniumSetupConfig_chromiumPath config
|
||||
when (T.null browserPath) $ fail "No browser found"
|
||||
let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _seleniumSetupConfig_seleniumPort config }
|
||||
chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
|
||||
runSpec $ sessionWith wdConfig "" . using [(chromeCaps', "chrome")]
|
||||
|
||||
startSeleniumServer :: PortNumber -> IO (IO ())
|
||||
startSeleniumServer port = do
|
||||
(_,_,_,ph) <- createProcess $ (proc "selenium-server" ["-port", show port])
|
||||
@ -85,14 +91,10 @@ startSeleniumServer port = do
|
||||
}
|
||||
return $ terminateProcess ph
|
||||
|
||||
withSeleniumServer :: (Selenium -> IO ()) -> IO ()
|
||||
withSeleniumServer f = do
|
||||
stopServer <- startSeleniumServer seleniumPort
|
||||
withSeleniumServer :: PortNumber -> IO a -> IO a
|
||||
withSeleniumServer port f = bracket (startSeleniumServer port) id $ \_ -> do
|
||||
threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
|
||||
f $ Selenium
|
||||
{ _selenium_portNumber = seleniumPort
|
||||
, _selenium_stopServer = stopServer
|
||||
}
|
||||
f
|
||||
|
||||
chromeConfig :: Text -> [Text] -> WD.WDConfig
|
||||
chromeConfig fp flags =
|
||||
@ -104,20 +106,25 @@ chromeConfig fp flags =
|
||||
-- Function to test widgets
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | The environment in which your widgets can be tested
|
||||
type TestWidget js t m =
|
||||
(DomBuilder t m, MonadHold t m, PostBuild t m
|
||||
, Prerender js t m, PerformEvent t m, TriggerEvent t m
|
||||
, MonadFix m, MonadIO (Performable m), MonadIO m)
|
||||
|
||||
-- | Configuration of individual tests
|
||||
data TestWidgetConfig = TestWidgetConfig
|
||||
{ testWidgetConfig_debug :: Bool
|
||||
{ _testWidgetConfig_debug :: Bool
|
||||
-- ^ If this flag is set to True, during the test we will emit debug messages
|
||||
-- giving insight on our progress in the hydratation progress
|
||||
, testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
|
||||
, _testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
|
||||
-- ^ We can add widgets here that will be included in the head of the page
|
||||
-- (useful for example to include external js libraries in the tests)
|
||||
, _testWidgetConfig_jsaddlePort :: PortNumber
|
||||
-- ^ Port used by the jsaddle server
|
||||
}
|
||||
|
||||
-- | Test a widget by running some webdriver commands before and after
|
||||
-- hydration.
|
||||
testWidget
|
||||
:: TestWidgetConfig
|
||||
-> WD a
|
||||
@ -129,15 +136,18 @@ testWidget
|
||||
-> WD b
|
||||
testWidget cfg before after widget = testWidget' cfg before (const after) widget
|
||||
|
||||
-- | Test a widget by running some webdriver commands before hydration (on the
|
||||
-- statically rendered page).
|
||||
testWidgetStatic
|
||||
:: TestWidgetConfig
|
||||
-> WD ()
|
||||
-> WD a
|
||||
-- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
|
||||
-> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
|
||||
-- ^ Widget we are testing (contents of body)
|
||||
-> WD ()
|
||||
testWidgetStatic cfg before widget = testWidget' cfg (void before) (const $ pure ()) widget
|
||||
-> WD a
|
||||
testWidgetStatic cfg before widget = testWidget' cfg before pure widget
|
||||
|
||||
-- | Test a widget by running some webdriver commands after hydration.
|
||||
testWidgetHydrated
|
||||
:: TestWidgetConfig
|
||||
-> WD b
|
||||
@ -147,6 +157,9 @@ testWidgetHydrated
|
||||
-> WD b
|
||||
testWidgetHydrated cfg after widget = testWidget' cfg (pure ()) (const after) widget
|
||||
|
||||
-- | Test a widget by running some webdriver commands before and after
|
||||
-- hydration. Like 'testWidget', but you can use the result of the webdriver
|
||||
-- commands from before hydration in the post hydration test.
|
||||
testWidget'
|
||||
:: TestWidgetConfig
|
||||
-> WD a
|
||||
@ -156,7 +169,7 @@ testWidget'
|
||||
-> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
|
||||
-- ^ Widget we are testing (contents of body)
|
||||
-> WD b
|
||||
testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover bodyWidget = do
|
||||
testWidget' (TestWidgetConfig withDebugging headWidget jsaddlePort) beforeJS afterSwitchover bodyWidget = do
|
||||
let putStrLnDebug :: MonadIO m => Text -> m ()
|
||||
putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
|
||||
staticApp = do
|
||||
@ -196,8 +209,8 @@ testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover
|
||||
putStrLnDebug "put waitJSaddle"
|
||||
]
|
||||
-- hSilence to get rid of ConnectionClosed logs
|
||||
silenceIfDebug = if withDebugging then id else hSilence [stderr]
|
||||
jsaddleWarp = silenceIfDebug $ Warp.runSettings settings application
|
||||
silenceIfNotDebugging = if withDebugging then id else hSilence [stderr]
|
||||
jsaddleWarp = silenceIfNotDebugging $ Warp.runSettings settings application
|
||||
withAsync' jsaddleWarp $ do
|
||||
putStrLnDebug "taking waitJSaddle"
|
||||
liftIO $ takeMVar waitJSaddle
|
||||
@ -216,39 +229,21 @@ testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover
|
||||
-- Utilities
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Embed a different spec type by evaluating it directly.
|
||||
embedSpec :: (Hspec.Example a, MonadIO m) => Hspec.Arg a -> a -> m ()
|
||||
embedSpec arg spec = liftIO $ do
|
||||
Hspec.Result _info status <- Hspec.evaluateExample
|
||||
spec
|
||||
Hspec.defaultParams
|
||||
(\actionWith -> actionWith arg)
|
||||
(\_ -> pure ())
|
||||
case status of
|
||||
Hspec.Success -> pure ()
|
||||
Hspec.Pending _ _ -> pure () -- should not happen
|
||||
failure -> throwIO failure
|
||||
|
||||
withAsync' :: (MonadIO m, MonadMask m) => IO a -> m b -> m b
|
||||
withAsync' f g = bracket
|
||||
(liftIO $ Async.async f)
|
||||
(liftIO . Async.uninterruptibleCancel)
|
||||
(const g)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{- Note: a nicer interface?
|
||||
|
||||
This would have lead to a niced interface, but I don't think this solution is
|
||||
expressible with the library
|
||||
|
||||
data SessionData = SessionData
|
||||
{ sessionData_wdConfig :: WD.WDConfig
|
||||
, sessionData_capabilities :: [Capabilities]
|
||||
, sessionData_selenium :: Selenium
|
||||
}
|
||||
|
||||
testSpec = around bracketSelenium $ do
|
||||
describe "createRecipe" $ _what
|
||||
|
||||
bracketSelenium :: (SessionData -> IO ()) -> IO ()
|
||||
bracketSelenium action = do
|
||||
handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
|
||||
isHeadless <- pure True -- (== Nothing) <$> lookupEnv "NO_HEADLESS"
|
||||
withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
|
||||
withSeleniumServer $ \selenium -> do
|
||||
let browserPath = T.strip $ T.pack chromium
|
||||
when (T.null browserPath) $ fail "No browser found"
|
||||
withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
|
||||
let
|
||||
wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
|
||||
chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
|
||||
action (SessionData wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium
|
||||
-}
|
Loading…
Reference in New Issue
Block a user