diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ # Changelog for sandwich-webdriver ## Unreleased changes + +# 0.1.0.5 + +* Getting documentation sorted out. diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,1 +0,0 @@ -# sandwich-webdriver diff --git a/sandwich-webdriver.cabal b/sandwich-webdriver.cabal --- a/sandwich-webdriver.cabal +++ b/sandwich-webdriver.cabal @@ -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 +description: Please see the . 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 diff --git a/src/Test/Sandwich/WebDriver/Internal/Types.hs b/src/Test/Sandwich/WebDriver/Internal/Types.hs --- a/src/Test/Sandwich/WebDriver/Internal/Types.hs +++ b/src/Test/Sandwich/WebDriver/Internal/Types.hs @@ -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 + } diff --git a/src/Test/Sandwich/WebDriver/Video.hs b/src/Test/Sandwich/WebDriver/Video.hs --- a/src/Test/Sandwich/WebDriver/Video.hs +++ b/src/Test/Sandwich/WebDriver/Video.hs @@ -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}|]) diff --git a/src/Test/Sandwich/WebDriver/Windows.hs b/src/Test/Sandwich/WebDriver/Windows.hs --- a/src/Test/Sandwich/WebDriver/Windows.hs +++ b/src/Test/Sandwich/WebDriver/Windows.hs @@ -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