mirror of
https://github.com/codedownio/sandwich.git
synced 2024-08-17 07:40:39 +03:00
Able to run webdriver demo using Nix
This commit is contained in:
parent
1828e15538
commit
6d36f4fce6
@ -11,7 +11,7 @@ import Test.Sandwich.WebDriver
|
|||||||
|
|
||||||
|
|
||||||
tests :: TopSpec
|
tests :: TopSpec
|
||||||
tests = describe "Selenium tests" $ introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
tests = describe "Selenium tests" $ introduceWebDriver defaultWdOptions $ do
|
||||||
$(getSpecFromFolder defaultGetSpecFromFolderOptions)
|
$(getSpecFromFolder defaultGetSpecFromFolderOptions)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
@ -16,7 +16,7 @@ import Test.WebDriver.Commands
|
|||||||
|
|
||||||
|
|
||||||
simple :: TopSpecWithOptions
|
simple :: TopSpecWithOptions
|
||||||
simple = introduceWebDriverOptions @() (defaultWdOptions "/tmp/tools") $ do
|
simple = introduceWebDriverOptions @() defaultWdOptions $ do
|
||||||
before "Position window" (withSession1 setWindowRightSide) $ do
|
before "Position window" (withSession1 setWindowRightSide) $ do
|
||||||
it "opens Google" $ withSession1 $ do
|
it "opens Google" $ withSession1 $ do
|
||||||
openPage [i|https://www.google.com|]
|
openPage [i|https://www.google.com|]
|
||||||
|
@ -63,7 +63,7 @@ claimWebdriver spec = introduceWith' (
|
|||||||
|
|
||||||
tests :: TopSpecWithOptions
|
tests :: TopSpecWithOptions
|
||||||
tests =
|
tests =
|
||||||
introduceWebDriverPool 4 (defaultWdOptions "/tmp/tools") $
|
introduceWebDriverPool 4 defaultWdOptions $
|
||||||
parallel $
|
parallel $
|
||||||
replicateM_ 20 $
|
replicateM_ 20 $
|
||||||
claimWebdriver $ it "opens Google" $ withSession1 $ openPage "http://www.google.com"
|
claimWebdriver $ it "opens Google" $ withSession1 $ openPage "http://www.google.com"
|
||||||
|
@ -13,7 +13,7 @@ import Test.WebDriver.Commands
|
|||||||
|
|
||||||
|
|
||||||
positioning :: TopSpec
|
positioning :: TopSpec
|
||||||
positioning = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
positioning = introduceWebDriver defaultWdOptions $ do
|
||||||
describe "two windows side by side" $ do
|
describe "two windows side by side" $ do
|
||||||
it "opens Google" $ withSession1 $ do
|
it "opens Google" $ withSession1 $ do
|
||||||
openPage "http://www.google.com"
|
openPage "http://www.google.com"
|
||||||
|
@ -17,7 +17,7 @@ import UnliftIO.Exception
|
|||||||
|
|
||||||
|
|
||||||
manualVideo :: TopSpec
|
manualVideo :: TopSpec
|
||||||
manualVideo = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
manualVideo = introduceWebDriver defaultWdOptions $ do
|
||||||
describe "video recording" $ do
|
describe "video recording" $ do
|
||||||
it "opens Google" $ withSession1 $ do
|
it "opens Google" $ withSession1 $ do
|
||||||
openPage "http://www.google.com"
|
openPage "http://www.google.com"
|
||||||
|
@ -1,8 +1,11 @@
|
|||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE NumericUnderscores #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
@ -11,12 +14,13 @@ import qualified Data.ByteString.Lazy as BL
|
|||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Test.Sandwich
|
import Test.Sandwich
|
||||||
|
import Test.Sandwich.Contexts.Nix
|
||||||
import Test.Sandwich.WebDriver
|
import Test.Sandwich.WebDriver
|
||||||
import Test.WebDriver.Commands
|
import Test.WebDriver.Commands
|
||||||
|
|
||||||
|
|
||||||
simple :: TopSpecWithOptions
|
simple :: TopSpecWithOptions
|
||||||
simple = introduceWebDriverOptions @() (defaultWdOptions "/tmp/tools") $ do
|
simple = introduceNixContext nixpkgsReleaseDefault $ introduceWebDriverViaNix defaultWdOptions $ do
|
||||||
it "opens Google and searches" $ withSession1 $ do
|
it "opens Google and searches" $ withSession1 $ do
|
||||||
openPage [i|https://www.google.com|]
|
openPage [i|https://www.google.com|]
|
||||||
search <- findElem (ByCSS [i|*[title="Search"]|])
|
search <- findElem (ByCSS [i|*[title="Search"]|])
|
||||||
@ -27,7 +31,7 @@ simple = introduceWebDriverOptions @() (defaultWdOptions "/tmp/tools") $ do
|
|||||||
Just dir <- getCurrentFolder
|
Just dir <- getCurrentFolder
|
||||||
screenshot >>= liftIO . BL.writeFile (dir </> "screenshot.png")
|
screenshot >>= liftIO . BL.writeFile (dir </> "screenshot.png")
|
||||||
|
|
||||||
liftIO $ threadDelay 3000000
|
liftIO $ threadDelay 3_000_000
|
||||||
|
|
||||||
testOptions = defaultOptions {
|
testOptions = defaultOptions {
|
||||||
optionsTestArtifactsDirectory = defaultTestArtifactsDirectory
|
optionsTestArtifactsDirectory = defaultTestArtifactsDirectory
|
||||||
|
@ -31,6 +31,7 @@ executable demo-webdriver
|
|||||||
, bytestring
|
, bytestring
|
||||||
, filepath
|
, filepath
|
||||||
, sandwich
|
, sandwich
|
||||||
|
, sandwich-contexts
|
||||||
, sandwich-webdriver
|
, sandwich-webdriver
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, webdriver
|
, webdriver
|
||||||
|
@ -7,6 +7,7 @@ dependencies:
|
|||||||
- bytestring
|
- bytestring
|
||||||
- filepath
|
- filepath
|
||||||
- sandwich
|
- sandwich
|
||||||
|
- sandwich-contexts
|
||||||
- sandwich-webdriver
|
- sandwich-webdriver
|
||||||
- string-interpolate
|
- string-interpolate
|
||||||
- webdriver
|
- webdriver
|
||||||
|
@ -42,7 +42,7 @@ tests = do
|
|||||||
UnitTests1.tests
|
UnitTests1.tests
|
||||||
UnitTests2.tests
|
UnitTests2.tests
|
||||||
|
|
||||||
introduceWebDriver (defaultWdOptions "/tmp/tools") $
|
introduceWebDriver defaultWdOptions $
|
||||||
describe "Selenium tests" $ do
|
describe "Selenium tests" $ do
|
||||||
SeleniumTests1.tests
|
SeleniumTests1.tests
|
||||||
SeleniumTests2.tests
|
SeleniumTests2.tests
|
||||||
@ -71,7 +71,7 @@ import Test.Sandwich.WebDriver
|
|||||||
#insert_test_imports
|
#insert_test_imports
|
||||||
|
|
||||||
tests :: TopSpec
|
tests :: TopSpec
|
||||||
tests = describe "Selenium tests" $ introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
tests = describe "Selenium tests" $ introduceWebDriver defaultWdOptions $ do
|
||||||
$(getSpecFromFolder defaultGetSpecFromFolderOptions)
|
$(getSpecFromFolder defaultGetSpecFromFolderOptions)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
@ -13,7 +13,7 @@ import Test.Sandwich.WebDriver
|
|||||||
import Test.WebDriver
|
import Test.WebDriver
|
||||||
|
|
||||||
spec :: TopSpec
|
spec :: TopSpec
|
||||||
spec = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
spec = introduceWebDriver defaultWdOptions $ do
|
||||||
it "opens Google and searches" $ withSession1 $ do
|
it "opens Google and searches" $ withSession1 $ do
|
||||||
openPage "http://www.google.com"
|
openPage "http://www.google.com"
|
||||||
search <- findElem (ByCSS "*[title='Search']")
|
search <- findElem (ByCSS "*[title='Search']")
|
||||||
@ -36,7 +36,7 @@ For example, the code below opens two windows with a different site in each.
|
|||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
spec :: TopSpec
|
spec :: TopSpec
|
||||||
spec = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
spec = introduceWebDriver defaultWdOptions $ do
|
||||||
describe "two browser sessions" $ do
|
describe "two browser sessions" $ do
|
||||||
it "opens Google" $ withSession1 $ openPage "http://www.google.com"
|
it "opens Google" $ withSession1 $ openPage "http://www.google.com"
|
||||||
it "opens Yahoo" $ withSession2 $ openPage "http://www.yahoo.com"
|
it "opens Yahoo" $ withSession2 $ openPage "http://www.yahoo.com"
|
||||||
@ -49,7 +49,7 @@ The code below extends the previous example with window positioning. You can fin
|
|||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
positioning :: TopSpec
|
positioning :: TopSpec
|
||||||
positioning = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
positioning = introduceWebDriver defaultWdOptions $ do
|
||||||
describe "two windows side by side" $ do
|
describe "two windows side by side" $ do
|
||||||
it "opens Google" $ withSession1 $ do
|
it "opens Google" $ withSession1 $ do
|
||||||
openPage "http://www.google.com"
|
openPage "http://www.google.com"
|
||||||
@ -69,7 +69,7 @@ This package makes it easy to run Selenium tests in the background, using either
|
|||||||
Many browsers now have the ability to natively run in headless mode. For example, passing these modified `WdOptions` to `introduceWebDriver` will run using headless Firefox.
|
Many browsers now have the ability to natively run in headless mode. For example, passing these modified `WdOptions` to `introduceWebDriver` will run using headless Firefox.
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
wdOptions = defaultWdOptions {
|
||||||
capabilities = firefoxCapabilities Nothing
|
capabilities = firefoxCapabilities Nothing
|
||||||
, runMode = RunHeadless defaultHeadlessConfig
|
, runMode = RunHeadless defaultHeadlessConfig
|
||||||
}
|
}
|
||||||
@ -84,7 +84,7 @@ Xvfb can be used to run your browser on a separate, "virtual" X11 display, diffe
|
|||||||
Xvfb mode can be configured manually just like headless mode.
|
Xvfb mode can be configured manually just like headless mode.
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
wdOptions = defaultWdOptions {
|
||||||
capabilities = chromeCapabilities
|
capabilities = chromeCapabilities
|
||||||
, runMode = RunInXvfb XvfbConfig
|
, runMode = RunInXvfb XvfbConfig
|
||||||
}
|
}
|
||||||
@ -106,7 +106,7 @@ Using the methods in [Test.Sandwich.WebDriver.Video](http://hackage.haskell.org/
|
|||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
manualVideo :: TopSpec
|
manualVideo :: TopSpec
|
||||||
manualVideo = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
manualVideo = introduceWebDriver defaultWdOptions $ do
|
||||||
describe "video recording" $ do
|
describe "video recording" $ do
|
||||||
it "opens Google" $ withSession1 $ do
|
it "opens Google" $ withSession1 $ do
|
||||||
openPage "http://www.google.com"
|
openPage "http://www.google.com"
|
||||||
@ -204,7 +204,7 @@ Having written these functions, we can finally write our tests. The following wi
|
|||||||
```haskell
|
```haskell
|
||||||
tests :: TopSpecWithOptions
|
tests :: TopSpecWithOptions
|
||||||
tests =
|
tests =
|
||||||
introduceWebDriverPool 4 (defaultWdOptions "/tmp/tools") $
|
introduceWebDriverPool 4 defaultWdOptions $
|
||||||
parallel $
|
parallel $
|
||||||
replicateM_ 20 $
|
replicateM_ 20 $
|
||||||
claimWebdriver $
|
claimWebdriver $
|
||||||
|
@ -80,7 +80,7 @@ simple = introduceWebDriver wdOptions $ do
|
|||||||
|
|
||||||
-- webdriverPool = Label :: Label "webdriverPool" (Pool WdSession)
|
-- webdriverPool = Label :: Label "webdriverPool" (Pool WdSession)
|
||||||
|
|
||||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
wdOptions = defaultWdOptions {
|
||||||
-- capabilities = chromeCapabilities
|
-- capabilities = chromeCapabilities
|
||||||
capabilities = firefoxCapabilities Nothing
|
capabilities = firefoxCapabilities Nothing
|
||||||
-- capabilities = headlessFirefoxCapabilities
|
-- capabilities = headlessFirefoxCapabilities
|
||||||
|
@ -5,7 +5,7 @@ import Test.Sandwich
|
|||||||
import Test.Sandwich.WebDriver
|
import Test.Sandwich.WebDriver
|
||||||
import Test.WebDriver
|
import Test.WebDriver
|
||||||
|
|
||||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
wdOptions = defaultWdOptions {
|
||||||
capabilities = firefoxCapabilities Nothing
|
capabilities = firefoxCapabilities Nothing
|
||||||
, runMode = RunHeadless defaultHeadlessConfig
|
, runMode = RunHeadless defaultHeadlessConfig
|
||||||
}
|
}
|
||||||
|
@ -34,6 +34,7 @@ library
|
|||||||
Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome
|
Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome
|
||||||
Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox
|
Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox
|
||||||
Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform
|
Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform
|
||||||
|
Test.Sandwich.WebDriver.Internal.BrowserDependencies
|
||||||
Test.Sandwich.WebDriver.Internal.Capabilities
|
Test.Sandwich.WebDriver.Internal.Capabilities
|
||||||
Test.Sandwich.WebDriver.Internal.Capabilities.Extra
|
Test.Sandwich.WebDriver.Internal.Capabilities.Extra
|
||||||
Test.Sandwich.WebDriver.Internal.Screenshots
|
Test.Sandwich.WebDriver.Internal.Screenshots
|
||||||
|
@ -1,7 +1,8 @@
|
|||||||
{-# LANGUAGE TypeOperators #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE QuantifiedConstraints #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
module Test.Sandwich.WebDriver (
|
module Test.Sandwich.WebDriver (
|
||||||
-- * Introducing a WebDriver server
|
-- * Introducing a WebDriver server
|
||||||
@ -35,7 +36,6 @@ module Test.Sandwich.WebDriver (
|
|||||||
, module Test.Sandwich.WebDriver.Types
|
, module Test.Sandwich.WebDriver.Types
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
@ -43,6 +43,7 @@ import Data.IORef
|
|||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
|
import qualified Data.Text as T
|
||||||
import Test.Sandwich
|
import Test.Sandwich
|
||||||
import Test.Sandwich.Contexts.Files
|
import Test.Sandwich.Contexts.Files
|
||||||
import Test.Sandwich.Contexts.Nix
|
import Test.Sandwich.Contexts.Nix
|
||||||
@ -50,6 +51,7 @@ import Test.Sandwich.Internal
|
|||||||
import Test.Sandwich.WebDriver.Class
|
import Test.Sandwich.WebDriver.Class
|
||||||
import Test.Sandwich.WebDriver.Config
|
import Test.Sandwich.WebDriver.Config
|
||||||
import Test.Sandwich.WebDriver.Internal.Action
|
import Test.Sandwich.WebDriver.Internal.Action
|
||||||
|
import Test.Sandwich.WebDriver.Internal.BrowserDependencies
|
||||||
import Test.Sandwich.WebDriver.Internal.StartWebDriver
|
import Test.Sandwich.WebDriver.Internal.StartWebDriver
|
||||||
import Test.Sandwich.WebDriver.Internal.Types
|
import Test.Sandwich.WebDriver.Internal.Types
|
||||||
import Test.Sandwich.WebDriver.Types
|
import Test.Sandwich.WebDriver.Types
|
||||||
@ -57,6 +59,7 @@ import qualified Test.WebDriver as W
|
|||||||
import qualified Test.WebDriver.Config as W
|
import qualified Test.WebDriver.Config as W
|
||||||
import qualified Test.WebDriver.Session as W
|
import qualified Test.WebDriver.Session as W
|
||||||
import UnliftIO.MVar
|
import UnliftIO.MVar
|
||||||
|
import UnliftIO.Process
|
||||||
|
|
||||||
|
|
||||||
-- | This is the main 'introduce' method for creating a WebDriver.
|
-- | This is the main 'introduce' method for creating a WebDriver.
|
||||||
@ -65,24 +68,39 @@ introduceWebDriver :: (
|
|||||||
) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
||||||
introduceWebDriver wdOptions = undefined -- introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
introduceWebDriver wdOptions = undefined -- introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
||||||
|
|
||||||
introduceWebDriverViaNix :: (
|
type ContextWithWebdriverDeps context =
|
||||||
BaseMonadContext m context, HasNixContext context, HasFile context "java"
|
LabelValue "webdriver" WebDriver
|
||||||
) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
:> LabelValue "browserDependencies" BrowserDependencies
|
||||||
|
:> LabelValue "file-java" (EnvironmentFile "java")
|
||||||
|
:> LabelValue "file-selenium.jar" (EnvironmentFile "selenium.jar")
|
||||||
|
:> context
|
||||||
|
|
||||||
|
introduceWebDriverViaNix :: forall m context. (
|
||||||
|
BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
|
||||||
|
) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
|
||||||
introduceWebDriverViaNix wdOptions =
|
introduceWebDriverViaNix wdOptions =
|
||||||
introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
introduceFileViaNixPackage @"selenium.jar" "selenium-server-standalone" tryFindSeleniumJar
|
||||||
|
. introduceBinaryViaNixPackage @"java" "jre"
|
||||||
|
. introduceBrowserDependencies
|
||||||
|
. introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
||||||
|
where
|
||||||
|
tryFindSeleniumJar :: FilePath -> IO FilePath
|
||||||
|
tryFindSeleniumJar path = (T.unpack . T.strip . T.pack) <$> readCreateProcess (proc "find" [path, "-name", "*.jar"]) ""
|
||||||
|
|
||||||
-- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
|
-- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
|
||||||
introduceWebDriverOptions :: forall a context m. (
|
introduceWebDriverOptions :: forall a context m. (
|
||||||
BaseMonadContext m context, HasCommandLineOptions context a, HasFile context "java"
|
BaseMonadContext m context, HasSomeCommandLineOptions context
|
||||||
)
|
)
|
||||||
=> WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
=> WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
||||||
introduceWebDriverOptions wdOptions = introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
|
introduceWebDriverOptions wdOptions = undefined -- introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
|
||||||
where alloc = do
|
-- where alloc = do
|
||||||
clo <- getCommandLineOptions
|
-- clo <- getCommandLineOptions
|
||||||
allocateWebDriver (addCommandLineOptionsToWdOptions @a clo wdOptions)
|
-- allocateWebDriver (addCommandLineOptionsToWdOptions @a clo wdOptions)
|
||||||
|
|
||||||
-- | Allocate a WebDriver using the given options.
|
-- | Allocate a WebDriver using the given options.
|
||||||
allocateWebDriver :: (BaseMonad m, HasBaseContext context, HasFile context "java") => WdOptions -> ExampleT context m WebDriver
|
allocateWebDriver :: (
|
||||||
|
BaseMonad m, HasBaseContext context, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
|
||||||
|
) => WdOptions -> ExampleT context m WebDriver
|
||||||
allocateWebDriver wdOptions = do
|
allocateWebDriver wdOptions = do
|
||||||
debug "Beginning allocateWebDriver"
|
debug "Beginning allocateWebDriver"
|
||||||
dir <- fromMaybe "/tmp" <$> getCurrentFolder
|
dir <- fromMaybe "/tmp" <$> getCurrentFolder
|
||||||
@ -91,7 +109,10 @@ allocateWebDriver wdOptions = do
|
|||||||
-- | Allocate a WebDriver using the given options and putting logs under the given path.
|
-- | Allocate a WebDriver using the given options and putting logs under the given path.
|
||||||
allocateWebDriver' :: FilePath -> WdOptions -> IO WebDriver
|
allocateWebDriver' :: FilePath -> WdOptions -> IO WebDriver
|
||||||
allocateWebDriver' runRoot wdOptions = do
|
allocateWebDriver' runRoot wdOptions = do
|
||||||
runNoLoggingT $ flip runReaderT (undefined :: LabelValue "file-java" (EnvironmentFile "java")) $ startWebDriver wdOptions runRoot
|
let ctx = (undefined :: LabelValue "file-java" (EnvironmentFile "java"))
|
||||||
|
:> (undefined :: LabelValue "file-selenium.jar" (EnvironmentFile "selenium.jar"))
|
||||||
|
:> (undefined :: LabelValue "browserDependencies" BrowserDependencies)
|
||||||
|
runNoLoggingT $ flip runReaderT ctx $ startWebDriver wdOptions runRoot
|
||||||
|
|
||||||
-- | Clean up the given WebDriver.
|
-- | Clean up the given WebDriver.
|
||||||
cleanupWebDriver :: (BaseMonad m) => WebDriver -> ExampleT context m ()
|
cleanupWebDriver :: (BaseMonad m) => WebDriver -> ExampleT context m ()
|
||||||
@ -107,7 +128,9 @@ cleanupWebDriver' sess = do
|
|||||||
stopWebDriver sess
|
stopWebDriver sess
|
||||||
|
|
||||||
-- | Run a given example using a given Selenium session.
|
-- | Run a given example using a given Selenium session.
|
||||||
withSession :: forall m context a. (WebDriverMonad m context) => Session -> ExampleT (ContextWithSession context) m a -> ExampleT context m a
|
withSession :: forall m context a. (
|
||||||
|
WebDriverMonad m context
|
||||||
|
) => Session -> ExampleT (ContextWithSession context) m a -> ExampleT context m a
|
||||||
withSession session (ExampleT readerMonad) = do
|
withSession session (ExampleT readerMonad) = do
|
||||||
WebDriver {..} <- getContext webdriver
|
WebDriver {..} <- getContext webdriver
|
||||||
-- Create new session if necessary (this can throw an exception)
|
-- Create new session if necessary (this can throw an exception)
|
||||||
@ -145,30 +168,9 @@ getSessions = do
|
|||||||
-- | Merge the options from the 'CommandLineOptions' into some 'WdOptions'.
|
-- | Merge the options from the 'CommandLineOptions' into some 'WdOptions'.
|
||||||
addCommandLineOptionsToWdOptions :: CommandLineOptions a -> WdOptions -> WdOptions
|
addCommandLineOptionsToWdOptions :: CommandLineOptions a -> WdOptions -> WdOptions
|
||||||
addCommandLineOptionsToWdOptions (CommandLineOptions {optWebdriverOptions=(CommandLineWebdriverOptions {..})}) wdOptions@(WdOptions {..}) = wdOptions {
|
addCommandLineOptionsToWdOptions (CommandLineOptions {optWebdriverOptions=(CommandLineWebdriverOptions {..})}) wdOptions@(WdOptions {..}) = wdOptions {
|
||||||
capabilities = case optFirefox of
|
runMode = case optDisplay of
|
||||||
Just UseFirefox -> firefoxCapabilities fbp
|
Nothing -> runMode
|
||||||
Just UseChrome -> chromeCapabilities cbp
|
Just Headless -> RunHeadless defaultHeadlessConfig
|
||||||
Nothing -> case cbp of
|
Just Xvfb -> RunInXvfb (defaultXvfbConfig { xvfbStartFluxbox = optFluxbox })
|
||||||
Just p -> chromeCapabilities (Just p)
|
Just Current -> Normal
|
||||||
Nothing -> case fbp of
|
|
||||||
Just p -> firefoxCapabilities (Just p)
|
|
||||||
Nothing -> capabilities
|
|
||||||
|
|
||||||
, runMode = case optDisplay of
|
|
||||||
Nothing -> runMode
|
|
||||||
Just Headless -> RunHeadless defaultHeadlessConfig
|
|
||||||
Just Xvfb -> RunInXvfb (defaultXvfbConfig { xvfbStartFluxbox = optFluxbox })
|
|
||||||
Just Current -> Normal
|
|
||||||
|
|
||||||
, seleniumToUse = maybe seleniumToUse UseSeleniumAt optSeleniumJar
|
|
||||||
|
|
||||||
, chromeBinaryPath = cbp
|
|
||||||
, chromeDriverToUse = maybe chromeDriverToUse UseChromeDriverAt optChromeDriver
|
|
||||||
|
|
||||||
, firefoxBinaryPath = fbp
|
|
||||||
, geckoDriverToUse = maybe geckoDriverToUse UseGeckoDriverAt optGeckoDriver
|
|
||||||
}
|
}
|
||||||
|
|
||||||
where
|
|
||||||
cbp = optChromeBinary <|> chromeBinaryPath
|
|
||||||
fbp = optFirefoxBinary <|> firefoxBinaryPath
|
|
||||||
|
@ -4,16 +4,14 @@ module Test.Sandwich.WebDriver.Config (
|
|||||||
WdOptions
|
WdOptions
|
||||||
, defaultWdOptions
|
, defaultWdOptions
|
||||||
, runMode
|
, runMode
|
||||||
, seleniumToUse
|
|
||||||
, chromeBinaryPath
|
|
||||||
, chromeDriverToUse
|
|
||||||
, firefoxBinaryPath
|
|
||||||
, geckoDriverToUse
|
|
||||||
, capabilities
|
, capabilities
|
||||||
, httpManager
|
, httpManager
|
||||||
, httpRetryCount
|
, httpRetryCount
|
||||||
, saveSeleniumMessageHistory
|
, saveSeleniumMessageHistory
|
||||||
|
|
||||||
|
-- * Browser options
|
||||||
|
, BrowserDependencies(..)
|
||||||
|
|
||||||
-- * Run mode constructors
|
-- * Run mode constructors
|
||||||
, RunMode(..)
|
, RunMode(..)
|
||||||
|
|
||||||
|
@ -81,8 +81,8 @@ obtainChromeDriver toolsDir (DownloadChromeDriverVersion chromeDriverVersion) =
|
|||||||
let downloadPath = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform
|
let downloadPath = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform
|
||||||
ExceptT $ downloadAndUnzipToPath downloadPath path
|
ExceptT $ downloadAndUnzipToPath downloadPath path
|
||||||
return path
|
return path
|
||||||
obtainChromeDriver toolsDir (DownloadChromeDriverAutodetect maybeChromePath) = runExceptT $ do
|
obtainChromeDriver toolsDir (DownloadChromeDriverAutodetect chromePath) = runExceptT $ do
|
||||||
version <- ExceptT $ liftIO $ getChromeDriverVersion maybeChromePath
|
version <- ExceptT $ liftIO $ getChromeDriverVersion chromePath
|
||||||
ExceptT $ obtainChromeDriver toolsDir (DownloadChromeDriverVersion version)
|
ExceptT $ obtainChromeDriver toolsDir (DownloadChromeDriverVersion version)
|
||||||
obtainChromeDriver _ (UseChromeDriverAt path) = liftIO (doesFileExist path) >>= \case
|
obtainChromeDriver _ (UseChromeDriverAt path) = liftIO (doesFileExist path) >>= \case
|
||||||
False -> return $ Left [i|Path '#{path}' didn't exist|]
|
False -> return $ Left [i|Path '#{path}' didn't exist|]
|
||||||
@ -135,9 +135,9 @@ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do
|
|||||||
|
|
||||||
return chromeDriverPath
|
return chromeDriverPath
|
||||||
|
|
||||||
downloadChromeDriverIfNecessary :: Constraints m => Maybe FilePath -> FilePath -> m (Either T.Text FilePath)
|
downloadChromeDriverIfNecessary :: Constraints m => FilePath -> FilePath -> m (Either T.Text FilePath)
|
||||||
downloadChromeDriverIfNecessary maybeChromePath toolsDir = runExceptT $ do
|
downloadChromeDriverIfNecessary chromePath toolsDir = runExceptT $ do
|
||||||
chromeDriverVersion <- ExceptT $ liftIO $ getChromeDriverVersion maybeChromePath
|
chromeDriverVersion <- ExceptT $ liftIO $ getChromeDriverVersion chromePath
|
||||||
ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion
|
ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion
|
||||||
|
|
||||||
getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath
|
getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath
|
||||||
|
@ -6,6 +6,8 @@ module Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome (
|
|||||||
detectChromeVersion
|
detectChromeVersion
|
||||||
, getChromeDriverVersion
|
, getChromeDriverVersion
|
||||||
, getChromeDriverDownloadUrl
|
, getChromeDriverDownloadUrl
|
||||||
|
|
||||||
|
, findChromeInEnvironment
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
@ -62,10 +64,8 @@ findChromeInEnvironment =
|
|||||||
, "google-chrome-stable" -- May be found on NixOS
|
, "google-chrome-stable" -- May be found on NixOS
|
||||||
]
|
]
|
||||||
|
|
||||||
detectChromeVersion :: Maybe FilePath -> IO (Either T.Text ChromeVersion)
|
detectChromeVersion :: FilePath -> IO (Either T.Text ChromeVersion)
|
||||||
detectChromeVersion maybeChromePath = leftOnException $ runExceptT $ do
|
detectChromeVersion chromeToUse = leftOnException $ runExceptT $ do
|
||||||
chromeToUse <- liftIO $ maybe findChromeInEnvironment pure maybeChromePath
|
|
||||||
|
|
||||||
(exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (chromeToUse <> " --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"")) ""
|
(exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (chromeToUse <> " --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"")) ""
|
||||||
|
|
||||||
rawString <- case exitCode of
|
rawString <- case exitCode of
|
||||||
@ -76,9 +76,9 @@ detectChromeVersion maybeChromePath = leftOnException $ runExceptT $ do
|
|||||||
[tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ ChromeVersion (w, x, y, z)
|
[tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ ChromeVersion (w, x, y, z)
|
||||||
_ -> throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]
|
_ -> throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]
|
||||||
|
|
||||||
getChromeDriverVersion :: Maybe FilePath -> IO (Either T.Text ChromeDriverVersion)
|
getChromeDriverVersion :: FilePath -> IO (Either T.Text ChromeDriverVersion)
|
||||||
getChromeDriverVersion maybeChromePath = runExceptT $ do
|
getChromeDriverVersion chromePath = runExceptT $ do
|
||||||
chromeVersion <- ExceptT $ liftIO $ detectChromeVersion maybeChromePath
|
chromeVersion <- ExceptT $ liftIO $ detectChromeVersion chromePath
|
||||||
ExceptT $ getChromeDriverVersion' chromeVersion
|
ExceptT $ getChromeDriverVersion' chromeVersion
|
||||||
|
|
||||||
getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)
|
getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)
|
||||||
|
@ -0,0 +1,37 @@
|
|||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE QuantifiedConstraints #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
|
module Test.Sandwich.WebDriver.Internal.BrowserDependencies where
|
||||||
|
|
||||||
|
import Control.Monad.IO.Unlift
|
||||||
|
import Data.String.Interpolate
|
||||||
|
import Test.Sandwich
|
||||||
|
import Test.Sandwich.Contexts.Files
|
||||||
|
import Test.Sandwich.Contexts.Nix
|
||||||
|
import Test.Sandwich.WebDriver.Internal.Types
|
||||||
|
|
||||||
|
|
||||||
|
introduceBrowserDependencies :: forall m context. (
|
||||||
|
MonadUnliftIO m, HasBaseContext context, HasNixContext context, HasSomeCommandLineOptions context
|
||||||
|
) => SpecFree (LabelValue "browserDependencies" BrowserDependencies :> context) m () -> SpecFree context m ()
|
||||||
|
introduceBrowserDependencies = introduce "Introduce browser dependencies" browserDependencies alloc (const $ return ())
|
||||||
|
where
|
||||||
|
alloc = do
|
||||||
|
SomeCommandLineOptions (CommandLineOptions {optWebdriverOptions=(CommandLineWebdriverOptions {..})}) <- getSomeCommandLineOptions
|
||||||
|
|
||||||
|
deps <- case optFirefox of
|
||||||
|
Just UseChrome ->
|
||||||
|
BrowserDependenciesChrome <$> getBinaryViaNixPackage @"google-chrome-stable" "google-chrome"
|
||||||
|
<*> getBinaryViaNixPackage @"chromedriver" "chromedriver"
|
||||||
|
Just UseFirefox ->
|
||||||
|
BrowserDependenciesFirefox <$> getBinaryViaNixPackage @"firefox" "firefox"
|
||||||
|
<*> getBinaryViaNixPackage @"geckodriver" "geckodriver"
|
||||||
|
_ ->
|
||||||
|
BrowserDependenciesFirefox <$> getBinaryViaNixPackage @"firefox" "firefox"
|
||||||
|
<*> getBinaryViaNixPackage @"geckodriver" "geckodriver"
|
||||||
|
debug [i|Got browser dependencies: #{deps}|]
|
||||||
|
return deps
|
@ -45,9 +45,13 @@ fromText = id
|
|||||||
type Constraints m = (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadBaseControl IO m, MonadMask m)
|
type Constraints m = (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadBaseControl IO m, MonadMask m)
|
||||||
|
|
||||||
-- | Add headless configuration to the Chrome browser
|
-- | Add headless configuration to the Chrome browser
|
||||||
configureHeadlessCapabilities :: Constraints m => WdOptions -> RunMode -> W.Capabilities -> m W.Capabilities
|
configureHeadlessCapabilities :: (Constraints m) => WdOptions -> RunMode -> W.Capabilities -> m W.Capabilities
|
||||||
configureHeadlessCapabilities wdOptions (RunHeadless (HeadlessConfig {..})) caps@(W.Capabilities {W.browser=browser@(W.Chrome {..})}) = do
|
configureHeadlessCapabilities wdOptions (RunHeadless (HeadlessConfig {..})) caps@(W.Capabilities {W.browser=browser@(W.Chrome {..})}) = do
|
||||||
headlessArg <- liftIO (detectChromeVersion (chromeBinaryPath wdOptions)) >>= \case
|
chromeBinaryPath <- case chromeBinary of
|
||||||
|
Nothing -> expectationFailure [i|Chrome capabilities didn't define chromeBinary in configureHeadlessCapabilities|]
|
||||||
|
Just x -> pure x
|
||||||
|
|
||||||
|
headlessArg <- liftIO (detectChromeVersion chromeBinaryPath) >>= \case
|
||||||
Left err -> do
|
Left err -> do
|
||||||
warn [i|Couldn't determine chrome version when configuring headless capabilities (err: #{err}); passing --headless|]
|
warn [i|Couldn't determine chrome version when configuring headless capabilities (err: #{err}); passing --headless|]
|
||||||
return "--headless"
|
return "--headless"
|
||||||
|
@ -29,12 +29,13 @@ import Test.Sandwich
|
|||||||
import Test.Sandwich.Contexts.Files
|
import Test.Sandwich.Contexts.Files
|
||||||
import Test.Sandwich.Contexts.Util.Ports (findFreePortOrException)
|
import Test.Sandwich.Contexts.Util.Ports (findFreePortOrException)
|
||||||
import Test.Sandwich.Util.Process
|
import Test.Sandwich.Util.Process
|
||||||
import Test.Sandwich.WebDriver.Internal.Binaries
|
|
||||||
import Test.Sandwich.WebDriver.Internal.Capabilities.Extra
|
import Test.Sandwich.WebDriver.Internal.Capabilities.Extra
|
||||||
import Test.Sandwich.WebDriver.Internal.Types
|
import Test.Sandwich.WebDriver.Internal.Types
|
||||||
import Test.Sandwich.WebDriver.Internal.Util
|
import Test.Sandwich.WebDriver.Internal.Util
|
||||||
import qualified Test.WebDriver as W
|
import qualified Test.WebDriver as W
|
||||||
|
import UnliftIO.Async
|
||||||
import UnliftIO.Process
|
import UnliftIO.Process
|
||||||
|
import UnliftIO.Timeout
|
||||||
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
|
import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
|
||||||
@ -45,9 +46,10 @@ type Constraints m = (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadBaseCon
|
|||||||
|
|
||||||
-- | Spin up a Selenium WebDriver and create a WebDriver
|
-- | Spin up a Selenium WebDriver and create a WebDriver
|
||||||
startWebDriver :: (
|
startWebDriver :: (
|
||||||
Constraints m, MonadReader context m, HasFile context "java"
|
Constraints m, MonadReader context m
|
||||||
|
, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
|
||||||
) => WdOptions -> FilePath -> m WebDriver
|
) => WdOptions -> FilePath -> m WebDriver
|
||||||
startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot = do
|
startWebDriver wdOptions@(WdOptions {capabilities=capabilities'', ..}) runRoot = do
|
||||||
-- Create a unique name for this webdriver so the folder for its log output doesn't conflict with any others
|
-- Create a unique name for this webdriver so the folder for its log output doesn't conflict with any others
|
||||||
webdriverName <- ("webdriver_" <>) <$> liftIO makeUUID
|
webdriverName <- ("webdriver_" <>) <$> liftIO makeUUID
|
||||||
|
|
||||||
@ -59,26 +61,30 @@ startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot =
|
|||||||
let downloadDir = webdriverRoot </> "Downloads"
|
let downloadDir = webdriverRoot </> "Downloads"
|
||||||
liftIO $ createDirectoryIfMissing True downloadDir
|
liftIO $ createDirectoryIfMissing True downloadDir
|
||||||
|
|
||||||
-- Get selenium and chromedriver
|
-- Get selenium, driver args, and capabilities with browser paths applied
|
||||||
debug [i|Preparing to create the Selenium process|]
|
java <- askFile @"java"
|
||||||
seleniumPath <- obtainSelenium toolsRoot seleniumToUse >>= \case
|
seleniumPath <- askFile @"selenium.jar"
|
||||||
Left err -> error [i|Failed to obtain selenium: '#{err}'|]
|
(driverArgs, capabilities') <- getContext browserDependencies >>= \case
|
||||||
Right p -> return p
|
BrowserDependenciesFirefox {..} -> do
|
||||||
driverArgs <- case W.browser capabilities' of
|
let args = [
|
||||||
W.Firefox {} -> do
|
[i|-Dwebdriver.gecko.driver=#{browserDependenciesFirefoxGeckodriver}|]
|
||||||
obtainGeckoDriver toolsRoot geckoDriverToUse >>= \case
|
-- , [i|-Dwebdriver.gecko.logfile=#{webdriverRoot </> "geckodriver.log"}|]
|
||||||
Left err -> error [i|Failed to obtain geckodriver: '#{err}'|]
|
-- , [i|-Dwebdriver.gecko.verboseLogging=true|]
|
||||||
Right p -> return [[i|-Dwebdriver.gecko.driver=#{p}|]
|
]
|
||||||
-- , [i|-Dwebdriver.gecko.logfile=#{webdriverRoot </> "geckodriver.log"}|]
|
let capabilities' = capabilities'' {
|
||||||
-- , [i|-Dwebdriver.gecko.verboseLogging=true|]
|
W.browser = W.firefox { W.ffBinary = Just browserDependenciesFirefoxFirefox }
|
||||||
]
|
}
|
||||||
W.Chrome {} -> do
|
return (args, capabilities')
|
||||||
obtainChromeDriver toolsRoot chromeDriverToUse >>= \case
|
BrowserDependenciesChrome {..} -> do
|
||||||
Left err -> error [i|Failed to obtain chromedriver: '#{err}'|]
|
let args = [
|
||||||
Right p -> return [[i|-Dwebdriver.chrome.driver=#{p}|]
|
[i|-Dwebdriver.chrome.driver=#{browserDependenciesChromeChromedriver}|]
|
||||||
, [i|-Dwebdriver.chrome.logfile=#{webdriverRoot </> "chromedriver.log"}|]
|
, [i|-Dwebdriver.chrome.logfile=#{webdriverRoot </> "chromedriver.log"}|]
|
||||||
, [i|-Dwebdriver.chrome.verboseLogging=true|]]
|
, [i|-Dwebdriver.chrome.verboseLogging=true|]
|
||||||
x -> error [i|Browser #{x} is not supported yet|]
|
]
|
||||||
|
let capabilities' = capabilities'' {
|
||||||
|
W.browser = W.chrome { W.chromeBinary = Just browserDependenciesChromeChrome }
|
||||||
|
}
|
||||||
|
return (args, capabilities')
|
||||||
|
|
||||||
(maybeXvfbSession, javaEnv) <- case runMode of
|
(maybeXvfbSession, javaEnv) <- case runMode of
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
@ -93,9 +99,6 @@ startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot =
|
|||||||
let webdriverProcessRoot = webdriverRoot </> T.unpack webdriverProcessName
|
let webdriverProcessRoot = webdriverRoot </> T.unpack webdriverProcessName
|
||||||
liftIO $ createDirectoryIfMissing True webdriverProcessRoot
|
liftIO $ createDirectoryIfMissing True webdriverProcessRoot
|
||||||
|
|
||||||
java <- askFile @"java"
|
|
||||||
-- seleniumJar <- askFile @"selenium.jar"
|
|
||||||
|
|
||||||
-- Retry up to 10 times
|
-- Retry up to 10 times
|
||||||
-- This is necessary because sometimes we get a race for the port we get from findFreePortOrException.
|
-- This is necessary because sometimes we get a race for the port we get from findFreePortOrException.
|
||||||
-- There doesn't seem to be any way to make Selenium choose its own port.
|
-- There doesn't seem to be any way to make Selenium choose its own port.
|
||||||
@ -124,17 +127,19 @@ startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot =
|
|||||||
|
|
||||||
-- Read from the (combined) output stream until we see the up and running message,
|
-- Read from the (combined) output stream until we see the up and running message,
|
||||||
-- or the process ends and we get an exception from hGetLine
|
-- or the process ends and we get an exception from hGetLine
|
||||||
fix $ \loop -> do
|
startupResult <- timeout 10_000_000 $ fix $ \loop -> do
|
||||||
line <- fmap T.pack $ liftIO $ hGetLine hRead
|
line <- fmap T.pack $ liftIO $ hGetLine hRead
|
||||||
debug line
|
debug line
|
||||||
|
|
||||||
if | "Selenium Server is up and running" `T.isInfixOf` line -> return ()
|
if | "Selenium Server is up and running" `T.isInfixOf` line -> return ()
|
||||||
| otherwise -> loop
|
| otherwise -> loop
|
||||||
|
|
||||||
return (port, hRead, p)
|
case startupResult of
|
||||||
|
Nothing -> expectationFailure [i|Didn't see "up and running" line in Selenium output.|]
|
||||||
|
Just () -> return (port, hRead, p)
|
||||||
|
|
||||||
-- TODO: save this in the WebDriver to tear it down later?
|
-- TODO: save this in the WebDriver to tear it down later?
|
||||||
logAsync <- forever $ liftIO (hGetLine hRead) >>= (debug . T.pack)
|
_logAsync <- async $ forever (liftIO (hGetLine hRead) >>= (debug . T.pack))
|
||||||
|
|
||||||
-- Final extra capabilities configuration
|
-- Final extra capabilities configuration
|
||||||
capabilities <-
|
capabilities <-
|
||||||
|
@ -55,28 +55,12 @@ data RunMode = Normal
|
|||||||
-- xvfb-run script must be installed and on the PATH.
|
-- xvfb-run script must be installed and on the PATH.
|
||||||
|
|
||||||
data WdOptions = WdOptions {
|
data WdOptions = WdOptions {
|
||||||
toolsRoot :: ToolsRoot
|
capabilities :: W.Capabilities
|
||||||
-- ^ Folder where any necessary binaries (chromedriver, Selenium, etc.) will be downloaded if needed. Required.
|
|
||||||
|
|
||||||
, capabilities :: W.Capabilities
|
|
||||||
-- ^ The WebDriver capabilities to use.
|
-- ^ The WebDriver capabilities to use.
|
||||||
|
|
||||||
, saveSeleniumMessageHistory :: WhenToSave
|
, saveSeleniumMessageHistory :: WhenToSave
|
||||||
-- ^ When to save a record of Selenium requests and responses.
|
-- ^ When to save a record of Selenium requests and responses.
|
||||||
|
|
||||||
, seleniumToUse :: SeleniumToUse
|
|
||||||
-- ^ Which Selenium server JAR file to use.
|
|
||||||
|
|
||||||
, chromeBinaryPath :: Maybe FilePath
|
|
||||||
-- ^ Which chrome binary to use.
|
|
||||||
, chromeDriverToUse :: ChromeDriverToUse
|
|
||||||
-- ^ Which chromedriver executable to use.
|
|
||||||
|
|
||||||
, firefoxBinaryPath :: Maybe FilePath
|
|
||||||
-- ^ Which firefox binary to use.
|
|
||||||
, geckoDriverToUse :: GeckoDriverToUse
|
|
||||||
-- ^ Which geckodriver executable to use.
|
|
||||||
|
|
||||||
, runMode :: RunMode
|
, runMode :: RunMode
|
||||||
-- ^ How to handle opening the browser (in a popup window, headless, etc.).
|
-- ^ How to handle opening the browser (in a popup window, headless, etc.).
|
||||||
|
|
||||||
@ -103,7 +87,7 @@ data ChromeDriverToUse =
|
|||||||
-- ^ Download chromedriver from the given URL to the 'toolsRoot'
|
-- ^ Download chromedriver from the given URL to the 'toolsRoot'
|
||||||
| DownloadChromeDriverVersion ChromeDriverVersion
|
| DownloadChromeDriverVersion ChromeDriverVersion
|
||||||
-- ^ Download the given chromedriver version to the 'toolsRoot'
|
-- ^ Download the given chromedriver version to the 'toolsRoot'
|
||||||
| DownloadChromeDriverAutodetect (Maybe FilePath)
|
| DownloadChromeDriverAutodetect FilePath
|
||||||
-- ^ Autodetect chromedriver to use based on the Chrome version and download it to the 'toolsRoot'
|
-- ^ Autodetect chromedriver to use based on the Chrome version and download it to the 'toolsRoot'
|
||||||
-- Pass the path to the Chrome binary, or else it will be found by looking for google-chrome on the PATH.
|
-- Pass the path to the Chrome binary, or else it will be found by looking for google-chrome on the PATH.
|
||||||
| UseChromeDriverAt FilePath
|
| UseChromeDriverAt FilePath
|
||||||
@ -155,16 +139,10 @@ defaultXvfbConfig = XvfbConfig Nothing False
|
|||||||
|
|
||||||
-- | The default 'WdOptions' object.
|
-- | The default 'WdOptions' object.
|
||||||
-- You should start with this and modify it using the accessors.
|
-- You should start with this and modify it using the accessors.
|
||||||
defaultWdOptions :: FilePath -> WdOptions
|
defaultWdOptions :: WdOptions
|
||||||
defaultWdOptions toolsRoot = WdOptions {
|
defaultWdOptions = WdOptions {
|
||||||
toolsRoot = toolsRoot
|
capabilities = def
|
||||||
, capabilities = def
|
|
||||||
, saveSeleniumMessageHistory = OnException
|
, saveSeleniumMessageHistory = OnException
|
||||||
, seleniumToUse = DownloadSeleniumDefault
|
|
||||||
, chromeBinaryPath = Nothing
|
|
||||||
, chromeDriverToUse = DownloadChromeDriverAutodetect Nothing
|
|
||||||
, firefoxBinaryPath = Nothing
|
|
||||||
, geckoDriverToUse = DownloadGeckoDriverAutodetect Nothing
|
|
||||||
, runMode = Normal
|
, runMode = Normal
|
||||||
, httpManager = Nothing
|
, httpManager = Nothing
|
||||||
, httpRetryCount = 0
|
, httpRetryCount = 0
|
||||||
@ -270,3 +248,18 @@ defaultVideoSettings = VideoSettings {
|
|||||||
, hideMouseWhenRecording = False
|
, hideMouseWhenRecording = False
|
||||||
, logToDisk = True
|
, logToDisk = True
|
||||||
}
|
}
|
||||||
|
|
||||||
|
data BrowserDependencies = BrowserDependenciesChrome {
|
||||||
|
browserDependenciesChromeChrome :: FilePath
|
||||||
|
, browserDependenciesChromeChromedriver :: FilePath
|
||||||
|
}
|
||||||
|
| BrowserDependenciesFirefox {
|
||||||
|
browserDependenciesFirefoxFirefox :: FilePath
|
||||||
|
, browserDependenciesFirefoxGeckodriver :: FilePath
|
||||||
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
browserDependencies :: Label "browserDependencies" BrowserDependencies
|
||||||
|
browserDependencies = Label
|
||||||
|
|
||||||
|
type HasBrowserDependencies context = HasLabel context "browserDependencies" BrowserDependencies
|
||||||
|
@ -155,16 +155,21 @@ runSandwichWithCommandLineArgs' baseOptions userOptionsParser spec = do
|
|||||||
updateGolden (optGoldenDir (optGoldenOptions clo))
|
updateGolden (optGoldenDir (optGoldenOptions clo))
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
-- Awkward, but we need a specific context type to call countItNodes
|
-- Awkward, but we need a specific context type to call countItNodes
|
||||||
let totalTests = countItNodes (spec :: SpecFree (LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
let totalTests = countItNodes (spec :: SpecFree (LabelValue "someCommandLineOptions" SomeCommandLineOptions :> LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
||||||
|
|
||||||
|
let cliNodeOptions = defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
|
||||||
|
, nodeOptionsCreateFolder = False }
|
||||||
|
|
||||||
runWithRepeat repeatCount totalTests $
|
runWithRepeat repeatCount totalTests $
|
||||||
case optIndividualTestModule clo of
|
case optIndividualTestModule clo of
|
||||||
Nothing -> runSandwich' (Just $ clo { optUserOptions = () }) options $
|
Nothing -> runSandwich' (Just $ clo { optUserOptions = () }) options $
|
||||||
introduce' (defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
|
introduce' cliNodeOptions "some command line options" someCommandLineOptions (pure (SomeCommandLineOptions clo)) (const $ return ())
|
||||||
, nodeOptionsCreateFolder = False }) "command line options" commandLineOptions (pure clo) (const $ return ()) spec
|
$ introduce' cliNodeOptions "command line options" commandLineOptions (pure clo) (const $ return ())
|
||||||
|
$ spec
|
||||||
Just (IndividualTestModuleName x) -> runSandwich' (Just $ clo { optUserOptions = () }) options $ filterTreeToModule x $
|
Just (IndividualTestModuleName x) -> runSandwich' (Just $ clo { optUserOptions = () }) options $ filterTreeToModule x $
|
||||||
introduce' (defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
|
introduce' cliNodeOptions "some command line options" someCommandLineOptions (pure (SomeCommandLineOptions clo)) (const $ return ())
|
||||||
, nodeOptionsCreateFolder = False }) "command line options" commandLineOptions (pure clo) (const $ return ()) spec
|
$ introduce' cliNodeOptions "command line options" commandLineOptions (pure clo) (const $ return ())
|
||||||
|
$ spec
|
||||||
Just (IndividualTestMainFn x) -> do
|
Just (IndividualTestMainFn x) -> do
|
||||||
let individualTestFlagStrings = [[ Just ("--" <> shorthand), const ("--" <> shorthand <> "-main") <$> nodeModuleInfoFn ]
|
let individualTestFlagStrings = [[ Just ("--" <> shorthand), const ("--" <> shorthand <> "-main") <$> nodeModuleInfoFn ]
|
||||||
| (NodeModuleInfo {..}, shorthand) <- modulesAndShorthands]
|
| (NodeModuleInfo {..}, shorthand) <- modulesAndShorthands]
|
||||||
|
@ -202,7 +202,7 @@ parseCommandLineArgs' :: forall a. Typeable a => Parser a -> TopSpecWithOptions'
|
|||||||
, [(NodeModuleInfo, T.Text)]
|
, [(NodeModuleInfo, T.Text)]
|
||||||
)
|
)
|
||||||
parseCommandLineArgs' userOptionsParser spec = do
|
parseCommandLineArgs' userOptionsParser spec = do
|
||||||
let modulesAndShorthands = gatherMainFunctions (spec :: SpecFree (LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
let modulesAndShorthands = gatherMainFunctions (spec :: SpecFree (LabelValue "someCommandLineOptions" SomeCommandLineOptions :> LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
||||||
& L.sortOn nodeModuleInfoModuleName
|
& L.sortOn nodeModuleInfoModuleName
|
||||||
& gatherShorthands
|
& gatherShorthands
|
||||||
let individualTestFlags maybeInternal =
|
let individualTestFlags maybeInternal =
|
||||||
|
@ -38,6 +38,12 @@ getCurrentFolder = asks (baseContextPath . getBaseContext)
|
|||||||
getCommandLineOptions :: forall a context m. (HasCommandLineOptions context a, MonadReader context m) => m (CommandLineOptions a)
|
getCommandLineOptions :: forall a context m. (HasCommandLineOptions context a, MonadReader context m) => m (CommandLineOptions a)
|
||||||
getCommandLineOptions = getContext commandLineOptions
|
getCommandLineOptions = getContext commandLineOptions
|
||||||
|
|
||||||
|
-- | Get existentially wrapped command line options, if configured.
|
||||||
|
-- Using the 'runSandwichWithCommandLineArgs' family of main functions will introduce these, or you can
|
||||||
|
-- introduce them manually
|
||||||
|
getSomeCommandLineOptions :: forall context m. (HasSomeCommandLineOptions context, MonadReader context m) => m SomeCommandLineOptions
|
||||||
|
getSomeCommandLineOptions = getContext someCommandLineOptions
|
||||||
|
|
||||||
-- | Get the user command line options, if configured.
|
-- | Get the user command line options, if configured.
|
||||||
-- This just calls 'getCommandLineOptions' and pulls out the user options.
|
-- This just calls 'getCommandLineOptions' and pulls out the user options.
|
||||||
getUserCommandLineOptions :: (HasCommandLineOptions context a, MonadReader context m) => m a
|
getUserCommandLineOptions :: (HasCommandLineOptions context a, MonadReader context m) => m a
|
||||||
|
@ -37,6 +37,8 @@ module Test.Sandwich.Misc (
|
|||||||
, HasBaseContext
|
, HasBaseContext
|
||||||
, HasBaseContextMonad
|
, HasBaseContextMonad
|
||||||
, HasCommandLineOptions
|
, HasCommandLineOptions
|
||||||
|
, SomeCommandLineOptions(..)
|
||||||
|
, HasSomeCommandLineOptions
|
||||||
|
|
||||||
-- * Result types
|
-- * Result types
|
||||||
, Result(..)
|
, Result(..)
|
||||||
|
@ -168,16 +168,25 @@ commandLineOptions = Label :: Label "commandLineOptions" (CommandLineOptions a)
|
|||||||
-- | Has-* class for asserting a 'CommandLineOptions a' is available.
|
-- | Has-* class for asserting a 'CommandLineOptions a' is available.
|
||||||
type HasCommandLineOptions context a = HasLabel context "commandLineOptions" (CommandLineOptions a)
|
type HasCommandLineOptions context a = HasLabel context "commandLineOptions" (CommandLineOptions a)
|
||||||
|
|
||||||
|
-- | Existential wrapper for 'CommandLineOptions a'.
|
||||||
|
someCommandLineOptions :: Label "someCommandLineOptions" SomeCommandLineOptions
|
||||||
|
someCommandLineOptions = Label :: Label "someCommandLineOptions" SomeCommandLineOptions
|
||||||
|
data SomeCommandLineOptions where
|
||||||
|
SomeCommandLineOptions :: CommandLineOptions a -> SomeCommandLineOptions
|
||||||
|
type HasSomeCommandLineOptions context = HasLabel context "someCommandLineOptions" SomeCommandLineOptions
|
||||||
|
|
||||||
type TopSpecWithOptions = forall context. (
|
type TopSpecWithOptions = forall context. (
|
||||||
Typeable context
|
Typeable context
|
||||||
, HasBaseContext context
|
, HasBaseContext context
|
||||||
, HasCommandLineOptions context ()
|
, HasCommandLineOptions context ()
|
||||||
|
, HasSomeCommandLineOptions context
|
||||||
) => SpecFree context IO ()
|
) => SpecFree context IO ()
|
||||||
|
|
||||||
type TopSpecWithOptions' a = forall context. (
|
type TopSpecWithOptions' a = forall context. (
|
||||||
Typeable context
|
Typeable context
|
||||||
, HasBaseContext context
|
, HasBaseContext context
|
||||||
, HasCommandLineOptions context a
|
, HasCommandLineOptions context a
|
||||||
|
, HasSomeCommandLineOptions context
|
||||||
) => SpecFree context IO ()
|
) => SpecFree context IO ()
|
||||||
|
|
||||||
-- * Formatter
|
-- * Formatter
|
||||||
|
Loading…
Reference in New Issue
Block a user