sandwich-webdriver 0.1.0.4 → 0.1.0.5
raw patch · 6 files changed
+124/−55 lines, 6 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- README.md +0/−1
- sandwich-webdriver.cabal +34/−11
- src/Test/Sandwich/WebDriver/Internal/Types.hs +37/−26
- src/Test/Sandwich/WebDriver/Video.hs +41/−14
- src/Test/Sandwich/WebDriver/Windows.hs +8/−3
CHANGELOG.md view
@@ -1,3 +1,7 @@ # Changelog for sandwich-webdriver ## Unreleased changes++# 0.1.0.5++* Getting documentation sorted out.
− README.md
@@ -1,1 +0,0 @@-# sandwich-webdriver
sandwich-webdriver.cabal view
@@ -1,15 +1,15 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 48607d2e4674c46fdff451b60b31ca742f166a2a6e40a4281876401f2ceae9cb+-- hash: d0f87b2b7cab058dff99c4329afa43f6e20ee3c5c867a9495f09f543f73f2ed6 name: sandwich-webdriver-version: 0.1.0.4+version: 0.1.0.5 synopsis: Sandwich integration with Selenium WebDriver-description: Please see the documentation at <https://codedownio.github.io/sandwich/docs/extensions/sandwich-webdriver>+description: Please see the <https://codedownio.github.io/sandwich/docs/extensions/sandwich-webdriver documentation>. category: Testing homepage: https://codedownio.github.io/sandwich bug-reports: https://github.com/codedownio/sandwich/issues@@ -20,7 +20,6 @@ license-file: LICENSE build-type: Simple extra-source-files:- README.md CHANGELOG.md source-repository head@@ -50,12 +49,20 @@ Paths_sandwich_webdriver hs-source-dirs: src- default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase+ default-extensions:+ OverloadedStrings+ QuasiQuotes+ NamedFieldPuns+ RecordWildCards+ ScopedTypeVariables+ FlexibleContexts+ FlexibleInstances+ LambdaCase ghc-options: -W build-depends: X11 , aeson- , base <4.15+ , base <5 , containers , convertible , data-default@@ -96,12 +103,20 @@ Paths_sandwich_webdriver hs-source-dirs: app- default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase+ default-extensions:+ OverloadedStrings+ QuasiQuotes+ NamedFieldPuns+ RecordWildCards+ ScopedTypeVariables+ FlexibleContexts+ FlexibleInstances+ LambdaCase ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: X11 , aeson- , base <4.15+ , base <5 , containers , convertible , data-default@@ -143,12 +158,20 @@ Paths_sandwich_webdriver hs-source-dirs: test- default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase+ default-extensions:+ OverloadedStrings+ QuasiQuotes+ NamedFieldPuns+ RecordWildCards+ ScopedTypeVariables+ FlexibleContexts+ FlexibleInstances+ LambdaCase ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: X11 , aeson- , base <4.15+ , base <5 , containers , convertible , data-default
src/Test/Sandwich/WebDriver/Internal/Types.hs view
@@ -24,7 +24,7 @@ import qualified Test.WebDriver.Class as W import qualified Test.WebDriver.Session as W --- | 'Session' is just a 'String' name+-- | 'Session' is just a 'String' name. type Session = String -- * Labels@@ -60,28 +60,28 @@ -- ^ 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- -- ^ 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+ -- ^ Which Selenium server JAR file to use. , chromeDriverToUse :: ChromeDriverToUse- -- ^ Which chromedriver executable to use+ -- ^ Which chromedriver executable to use. , geckoDriverToUse :: GeckoDriverToUse- -- ^ Which geckodriver executable to use+ -- ^ Which geckodriver executable to use. , 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.). , httpManager :: Maybe Manager -- ^ HTTP manager for making requests to Selenium. If not provided, one will be created for each session. , httpRetryCount :: Int- -- ^ Number of times to retry an HTTP request if it times out+ -- ^ Number of times to retry an HTTP request if it times out. } -- | How to obtain the Selenium server JAR file.@@ -126,6 +126,7 @@ -- ^ Resolution for the headless browser. Defaults to (1920, 1080) } +-- | Default headless config. defaultHeadlessConfig = HeadlessConfig Nothing data XvfbConfig = XvfbConfig {@@ -136,9 +137,9 @@ -- ^ Whether to start fluxbox window manager to go with the Xvfb session. fluxbox must be on the path } +-- | Default Xvfb settings. defaultXvfbConfig = XvfbConfig Nothing False - -- | The default 'WdOptions' object. -- You should start with this and modify it using the accessors. defaultWdOptions :: FilePath -> WdOptions@@ -175,7 +176,7 @@ type WebDriverSession = (Session, IORef W.WDSession) --- | Get the 'WdOptions' associated with the 'WebDriver'+-- | Get the 'WdOptions' associated with the 'WebDriver'. getWdOptions :: WebDriver -> WdOptions getWdOptions = wdOptions @@ -185,12 +186,12 @@ getDisplayNumber (WebDriver {wdWebDriver=(_, _, _, _, _, Just (XvfbSession {xvfbDisplayNum}))}) = Just xvfbDisplayNum getDisplayNumber _ = Nothing --- | Get the Xvfb session associated with the 'WebDriver', if present+-- | Get the Xvfb session associated with the 'WebDriver', if present. getXvfbSession :: WebDriver -> Maybe XvfbSession getXvfbSession (WebDriver {wdWebDriver=(_, _, _, _, _, Just sess)}) = Just sess getXvfbSession _ = Nothing --- | Get the name of the 'WebDriver'+-- | Get the name of the 'WebDriver'. getWebDriverName :: WebDriver -> String getWebDriverName (WebDriver {wdName}) = wdName @@ -199,6 +200,7 @@ -- * Video stuff +-- | Default options for fast X11 video recording. fastX11VideoOptions = ["-an" , "-r", "30" , "-vcodec"@@ -206,6 +208,7 @@ , "-qscale:v", "1" , "-threads", "0"] +-- | Default options for quality X11 video recording. qualityX11VideoOptions = ["-an" , "-r", "30" , "-vcodec", "libx264"@@ -213,26 +216,34 @@ , "-crf", "0" , "-threads", "0"] +-- | Default options for AVFoundation recording (for Darwin). defaultAvfoundationOptions = ["-r", "30" , "-an" , "-vcodec", "libxvid" , "-qscale:v", "1" , "-threads", "0"] +-- | Default options for gdigrab recording (for Windows). defaultGdigrabOptions = ["-framerate", "30"] -data VideoSettings = VideoSettings { x11grabOptions :: [String]- -- ^ Arguments to x11grab, used with Linux.- , avfoundationOptions :: [String]- -- ^ Arguments to avfoundation, used with OS X.- , gdigrabOptions :: [String]- -- ^ Arguments to gdigrab, used with Windows.- , hideMouseWhenRecording :: Bool- -- ^ Hide the mouse while recording video. Linux and Windows only.- }+data VideoSettings = VideoSettings {+ x11grabOptions :: [String]+ -- ^ Arguments to x11grab, used with Linux.+ , avfoundationOptions :: [String]+ -- ^ Arguments to avfoundation, used with OS X.+ , gdigrabOptions :: [String]+ -- ^ Arguments to gdigrab, used with Windows.+ , hideMouseWhenRecording :: Bool+ -- ^ Hide the mouse while recording video. Linux and Windows only.+ , logToDisk :: Bool+ -- ^ Log ffmpeg stdout and stderr to disk.+ } -instance Default VideoSettings where- def = VideoSettings { x11grabOptions = fastX11VideoOptions- , avfoundationOptions = defaultAvfoundationOptions- , gdigrabOptions = defaultGdigrabOptions- , hideMouseWhenRecording = False }+-- | Default video settings.+defaultVideoSettings = VideoSettings {+ x11grabOptions = fastX11VideoOptions+ , avfoundationOptions = defaultAvfoundationOptions+ , gdigrabOptions = defaultGdigrabOptions+ , hideMouseWhenRecording = False+ , logToDisk = True+ }
src/Test/Sandwich/WebDriver/Video.hs view
@@ -1,11 +1,27 @@-{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, FlexibleContexts, OverloadedStrings, NamedFieldPuns, ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ConstraintKinds #-} module Test.Sandwich.WebDriver.Video ( startVideoRecording , endVideoRecording + -- * Helpers , startFullScreenVideoRecording , startBrowserVideoRecording++ -- * Configuration+ , VideoSettings(..)+ , defaultVideoSettings+ , fastX11VideoOptions+ , qualityX11VideoOptions+ , defaultAvfoundationOptions+ , defaultGdigrabOptions ) where import Control.Exception.Safe@@ -27,9 +43,13 @@ import Test.WebDriver.Commands -startFullScreenVideoRecording :: (MonadIO m, MonadReader context m, MonadLogger m, HasWebDriverContext context, MonadBaseControl IO m, MonadMask m) =>- FilePath -> VideoSettings -> Bool -> m ProcessHandle-startFullScreenVideoRecording path videoSettings logToDisk = do+type BaseVideoConstraints context m = (MonadLoggerIO m, MonadReader context m, HasWebDriverContext context, MonadBaseControl IO m)++-- | Wrapper around 'startVideoRecording' which uses the full screen dimensions.+startFullScreenVideoRecording :: (+ BaseVideoConstraints context m, MonadMask m+ ) => FilePath -> VideoSettings -> m ProcessHandle+startFullScreenVideoRecording path videoSettings = do sess <- getContext webdriver let maybeXvfbSession = getXvfbSession sess (width, height) <- case maybeXvfbSession of@@ -37,18 +57,22 @@ Nothing -> do (_x, _y, w, h) <- getScreenResolution sess return (fromIntegral w, fromIntegral h)- startVideoRecording path (fromIntegral width, fromIntegral height, 0, 0) videoSettings logToDisk+ startVideoRecording path (fromIntegral width, fromIntegral height, 0, 0) videoSettings -startBrowserVideoRecording :: (MonadIO m, MonadThrow m, MonadReader context m, MonadLogger m, HasWebDriverContext context, HasWebDriverSessionContext context, MonadBaseControl IO m, W.WebDriver m) =>- FilePath -> VideoSettings -> Bool -> m ProcessHandle-startBrowserVideoRecording path videoSettings logToDisk = do+-- | Wrapper around 'startVideoRecording' which uses WebDriver to find the rectangle corresponding to the browser.+startBrowserVideoRecording :: (+ BaseVideoConstraints context m, MonadThrow m, HasWebDriverSessionContext context, W.WebDriver m+ ) => FilePath -> VideoSettings -> m ProcessHandle+startBrowserVideoRecording path videoSettings = do (x, y) <- getWindowPos (w, h) <- getWindowSize- startVideoRecording path (w, h, x, y) videoSettings logToDisk+ startVideoRecording path (w, h, x, y) videoSettings -startVideoRecording :: (MonadIO m, MonadReader context m, MonadLogger m, HasWebDriverContext context, MonadBaseControl IO m) =>- FilePath -> (Word, Word, Int, Int) -> VideoSettings -> Bool -> m ProcessHandle-startVideoRecording path (width, height, x, y) vs logToDisk = do+-- | Record video to a given path, for a given rectangle specified as (width, height, x, y).+startVideoRecording :: (+ BaseVideoConstraints context m+ ) => FilePath -> (Word, Word, Int, Int) -> VideoSettings -> m ProcessHandle+startVideoRecording path (width, height, x, y) vs = do sess <- getContext webdriver let maybeXvfbSession = getXvfbSession sess @@ -59,7 +83,7 @@ ShellCommand s -> debug [i|ffmpeg command: #{s}|] RawCommand p args -> debug [i|ffmpeg command: #{p} #{unwords args}|] - case logToDisk of+ case logToDisk vs of False -> createProcessWithLogging cp True -> do liftIO $ bracket (openFile (path <.> "stdout" <.> "log") AppendMode) hClose $ \hout ->@@ -67,7 +91,10 @@ (_, _, _, p) <- createProcess (cp { std_out = UseHandle hout, std_err = UseHandle herr }) return p -endVideoRecording :: (MonadIO m, MonadLogger m, MonadCatch m) => ProcessHandle -> m ()+-- | Gracefully stop the 'ProcessHandle' returned by 'startVideoRecording'.+endVideoRecording :: (+ MonadLoggerIO m, MonadCatch m+ ) => ProcessHandle -> m () endVideoRecording p = do catchAny (liftIO $ interruptProcessGroupOf p) (\e -> logError [i|Exception in interruptProcessGroupOf in endVideoRecording: #{e}|])
src/Test/Sandwich/WebDriver/Windows.hs view
@@ -1,11 +1,14 @@+-- | Functions for manipulating browser windows.+ {-# LANGUAGE QuasiQuotes #-}--- | Functions for manipulating browser windows module Test.Sandwich.WebDriver.Windows (+ -- * Window positioning setWindowLeftSide , setWindowRightSide , setWindowFullScreen + -- * Querying screen info , getScreenResolution ) where @@ -26,6 +29,7 @@ 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, MonadLogger wd, MonadMask wd) => wd () setWindowLeftSide = do sess <- getContext webdriver@@ -36,6 +40,7 @@ setWindowPos (x + 0, y + 0) setWindowSize (fromIntegral $ B.shift width (-1), fromIntegral height) +-- | Position the window on the right 50% of the screen. setWindowRightSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd () setWindowRightSide = do sess <- getContext webdriver@@ -47,6 +52,7 @@ setWindowPos pos setWindowSize (fromIntegral $ B.shift width (-1), fromIntegral height) +-- | Fullscreen the browser window. setWindowFullScreen :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd () setWindowFullScreen = do sess <- getContext webdriver@@ -57,8 +63,7 @@ setWindowPos (x + 0, y + 0) setWindowSize (fromIntegral width, fromIntegral height) --- * Getting screen dimensions and resolution-+-- | Get the screen resolution as (x, y, width, height). (The x and y coordinates may be nonzero in multi-monitor setups.) getScreenResolution :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => WebDriver -> m (Int, Int, Int, Int) getScreenResolution = getScreenResolutionX11