Skip to content

Commit

Permalink
sandwich-webdriver: more haddocks
Browse files Browse the repository at this point in the history
  • Loading branch information
thomasjm committed Oct 17, 2024
1 parent 42bb510 commit d404a88
Show file tree
Hide file tree
Showing 5 changed files with 39 additions and 51 deletions.
22 changes: 14 additions & 8 deletions sandwich-webdriver/src/Test/Sandwich/WebDriver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,14 +39,20 @@ module Test.Sandwich.WebDriver (
, introduceWebDriver'
, addCommandLineOptionsToWdOptions

-- * Types
-- * Context types
-- ** WebDriver
, webdriver
, WebDriver
, HasWebDriverContext
-- ** WebDriverSession
, webdriverSession
, WebDriverSession
, HasWebDriverSessionContext

-- * On demand options
, OnDemandOptions
, defaultOnDemandOptions

-- * Re-exports
, module Test.Sandwich.WebDriver.Config
) where
Expand Down Expand Up @@ -79,7 +85,7 @@ import UnliftIO.MVar
-- | Introduce a 'WebDriver', using the given 'WebDriverDependencies'.
-- A good default is 'defaultWebDriverDependencies'.
introduceWebDriver :: forall context m. (
BaseMonadContext m context, HasSomeCommandLineOptions context
BaseMonad m context, HasSomeCommandLineOptions context
)
-- | How to obtain dependencies
=> WebDriverDependencies
Expand All @@ -99,7 +105,7 @@ introduceWebDriver wdd wdOptions = introduceWebDriver' wdd alloc wdOptions
-- | Introduce a 'WebDriver' using the current 'NixContext'.
-- This will pull everything required from the configured Nixpkgs snapshot.
introduceWebDriverViaNix :: forall m context. (
BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context
)
-- | Options
=> WdOptions
Expand All @@ -109,7 +115,7 @@ introduceWebDriverViaNix = introduceWebDriverViaNix' (defaultNodeOptions { nodeO

-- | Same as 'introduceWebDriverViaNix', but allows passing custom 'NodeOptions'.
introduceWebDriverViaNix' :: forall m context. (
BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context
)
=> NodeOptions
-- | Options
Expand All @@ -135,7 +141,7 @@ introduceWebDriverViaNix' nodeOptions wdOptions =

-- | Same as 'introduceWebDriver', but with a controllable allocation callback.
introduceWebDriver' :: forall m context. (
BaseMonadContext m context
BaseMonad m context
)
-- | Dependencies
=> WebDriverDependencies
Expand All @@ -150,8 +156,8 @@ introduceWebDriver' (WebDriverDependencies {..}) alloc wdOptions =

-- | Allocate a WebDriver using the given options.
allocateWebDriver :: (
BaseMonad m
, HasBaseContext context, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
BaseMonad m context
, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
)
-- | Options
=> WdOptions
Expand All @@ -162,7 +168,7 @@ allocateWebDriver wdOptions onDemandOptions = do
startWebDriver wdOptions onDemandOptions dir

-- | Clean up the given WebDriver.
cleanupWebDriver :: (BaseMonad m) => WebDriver -> ExampleT context m ()
cleanupWebDriver :: (BaseMonad m context) => WebDriver -> ExampleT context m ()
cleanupWebDriver sess = do
closeAllSessions sess
stopWebDriver sess
Expand Down
29 changes: 10 additions & 19 deletions sandwich-webdriver/src/Test/Sandwich/WebDriver/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,48 +8,39 @@ module Test.Sandwich.WebDriver.Config (
, httpManager
, httpRetryCount
, saveSeleniumMessageHistory
, WhenToSave(..)
, RunMode(..)

-- * Accessors for the 'WebDriver' context
, getWdOptions
, getDisplayNumber
, getDownloadDirectory
, getWebDriverName

-- ** Xvfb mode
-- * Xvfb mode
, XvfbConfig
, defaultXvfbConfig
, xvfbResolution
, xvfbStartFluxbox

-- ** Headless mode
-- * Headless mode
, HeadlessConfig
, defaultHeadlessConfig
, headlessResolution

-- * Dependency obtaining options
, SeleniumToUse(..)
, BrowserDependenciesSpec(..)
, ChromeToUse(..)
, ChromeDriverToUse(..)
, FirefoxToUse(..)
, GeckoDriverToUse(..)
, GeckoDriverVersion(..)
, XvfbDependenciesSpec(..)
, XvfbToUse(..)
, FluxboxToUse(..)
, FfmpegToUse(..)
, BrowserDependencies(..)

-- * Browser capabilities
, chromeCapabilities
, headlessChromeCapabilities
, firefoxCapabilities
, headlessFirefoxCapabilities

-- * Types
, WhenToSave(..)
, RunMode(..)
, browserDependencies
, BrowserDependenciesSpec(..)
, BrowserDependencies(..)
, HasBrowserDependencies
) where

import Test.Sandwich.WebDriver.Binaries
import Test.Sandwich.WebDriver.Internal.Capabilities
import Test.Sandwich.WebDriver.Internal.Dependencies
import Test.Sandwich.WebDriver.Internal.Types
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@ import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Binaries.Ffmpeg
import Test.Sandwich.WebDriver.Internal.Binaries.Xvfb
import qualified Test.WebDriver as W
import qualified Test.WebDriver.Class as W
import qualified Test.WebDriver.Session as W
import UnliftIO.Async

Expand All @@ -34,8 +33,6 @@ webdriver = Label
webdriverSession :: Label "webdriverSession" WebDriverSession
webdriverSession = Label

type WebDriverContext context wd = (HasLabel context "webdriver" WebDriver, W.WebDriver (ExampleT context wd))

type ToolsRoot = FilePath

data WhenToSave = Always | OnException | Never deriving (Show, Eq)
Expand Down Expand Up @@ -69,6 +66,8 @@ data WdOptions = WdOptions {
-- ^ Number of times to retry an HTTP request if it times out.
}

-- | How to obtain certain binaries "on demand". These may or not be needed based on 'WdOptions', so
-- they will be obtained as needed.
data OnDemandOptions = OnDemandOptions {
-- | How to obtain ffmpeg binary.
ffmpegToUse :: FfmpegToUse
Expand Down
24 changes: 8 additions & 16 deletions sandwich-webdriver/src/Test/Sandwich/WebDriver/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,21 +7,15 @@

module Test.Sandwich.WebDriver.Types (
-- * Type aliases to make signatures shorter
ContextWithWebdriverDeps
BaseMonad
, ContextWithWebdriverDeps
, ContextWithBaseDeps
, WebDriverMonad

-- * Constraint synonyms
, BaseMonad
, BaseMonadContext
-- * Context aliases
, HasBrowserDependencies
, HasWebDriverContext
, HasWebDriverSessionContext
, WebDriverMonad
, WebDriverSessionMonad

-- * On demand options
, OnDemandOptions
, defaultOnDemandOptions

-- * The Xvfb session
, XvfbSession(..)
Expand Down Expand Up @@ -49,7 +43,7 @@ import qualified Test.WebDriver.Session as W
import UnliftIO.Exception as ES


instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession) => W.WDSessionState (ExampleT context m) where
instance (MonadIO m, HasWebDriverSessionContext context) => W.WDSessionState (ExampleT context m) where
getSession = do
(_, sessVar) <- getContext webdriverSession
liftIO $ readIORef sessVar
Expand All @@ -58,7 +52,7 @@ instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession) => W.
liftIO $ writeIORef sessVar sess

-- Implementation copied from that of the WD monad implementation
instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession, MonadBaseControl IO m) => W.WebDriver (ExampleT context m) where
instance (MonadIO m, MonadBaseControl IO m, HasWebDriverSessionContext context) => W.WebDriver (ExampleT context m) where
doCommand method path args = WI.mkRequest method path args
>>= WI.sendHTTPRequest
>>= either throwIO return
Expand Down Expand Up @@ -86,7 +80,5 @@ hoistExample :: ExampleT context IO a -> ExampleT (LabelValue "webdriverSession"
hoistExample (ExampleT r) = ExampleT $ transformContext r
where transformContext = withReaderT (\(_ :> ctx) -> ctx)

type WebDriverMonad m context = (HasCallStack, HasLabel context "webdriver" WebDriver, MonadUnliftIO m, MonadBaseControl IO m)
type WebDriverSessionMonad m context = (WebDriverMonad m context, MonadReader context m, HasLabel context "webdriverSession" WebDriverSession)
type BaseMonad m = (HasCallStack, MonadUnliftIO m, MonadMask m)
type BaseMonadContext m context = (BaseMonad m, HasBaseContext context)
type BaseMonad m context = (HasCallStack, MonadUnliftIO m, MonadMask m, HasBaseContext context)
type WebDriverMonad m context = (HasCallStack, MonadUnliftIO m, HasWebDriverContext context)
10 changes: 5 additions & 5 deletions sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,16 +13,16 @@ module Test.Sandwich.WebDriver.Windows (
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Maybe
import GHC.Stack
import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Resolution
import Test.Sandwich.WebDriver.Types
import Test.WebDriver
import qualified Test.WebDriver.Class as W


-- | Position the window on the left 50% of the screen.
setWindowLeftSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd) => wd ()
setWindowLeftSide :: (WebDriverMonad m context, MonadReader context m, W.WebDriver m) => m ()
setWindowLeftSide = do
sess <- getContext webdriver
(x, y, width, height) <- case runMode $ wdOptions sess of
Expand All @@ -36,7 +36,7 @@ setWindowLeftSide = do
setWindowSize (round (screenWidth / 2.0), round screenHeight)

-- | Position the window on the right 50% of the screen.
setWindowRightSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd) => wd ()
setWindowRightSide :: (WebDriverMonad m context, MonadReader context m, W.WebDriver m) => m ()
setWindowRightSide = do
sess <- getContext webdriver
(x, y, width, height) <- case runMode $ wdOptions sess of
Expand All @@ -50,7 +50,7 @@ setWindowRightSide = do
setWindowSize (round (screenWidth / 2.0), round screenHeight)

-- | Fullscreen the browser window.
setWindowFullScreen :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd) => wd ()
setWindowFullScreen :: (WebDriverMonad m context, MonadReader context m, W.WebDriver m) => m ()
setWindowFullScreen = do
sess <- getContext webdriver
(x, y, width, height) <- case runMode $ wdOptions sess of
Expand All @@ -69,7 +69,7 @@ getScreenResolution (WebDriver {wdWebDriver=(_, maybeXvfbSession)}) = case maybe
Nothing -> liftIO getResolution
Just (XvfbSession {..}) -> liftIO $ getResolutionForDisplay xvfbDisplayNum

getScreenPixelDimensions :: (MonadIO wd, W.WebDriver wd) => Int -> Int -> wd (Double, Double)
getScreenPixelDimensions :: (MonadIO m, W.WebDriver m) => Int -> Int -> m (Double, Double)
getScreenPixelDimensions width height = do
devicePixelRatio <- executeJS [] "return window.devicePixelRatio" >>= \case
Just (ratio :: Double) -> pure ratio
Expand Down

0 comments on commit d404a88

Please sign in to comment.