{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}
module Test.Sandwich.WebDriver.Internal.Types where
import Control.Concurrent.MVar
import Control.Exception
import Data.Default
import Data.IORef
import qualified Data.Map as M
import Data.String.Interpolate
import Data.Text as T
import Network.HTTP.Client (Manager)
import System.IO
import System.Process
import Test.Sandwich
import qualified Test.WebDriver as W
import qualified Test.WebDriver.Class as W
import qualified Test.WebDriver.Session as W
type Session = String
webdriver :: Label "webdriver" WebDriver
webdriver = forall {k} (l :: Symbol) (a :: k). Label l a
Label :: Label "webdriver" WebDriver
webdriverSession :: Label "webdriverSession" WebDriverSession
webdriverSession = forall {k} (l :: Symbol) (a :: k). Label l a
Label :: Label "webdriverSession" WebDriverSession
type WebDriverContext context wd = (HasLabel context "webdriver" WebDriver, W.WebDriver (ExampleT context wd))
class HasWebDriver a where
getWebDriver :: a -> WebDriver
instance HasWebDriver WebDriver where
getWebDriver :: WebDriver -> WebDriver
getWebDriver = forall a. a -> a
id
type ToolsRoot = FilePath
data WhenToSave = Always | OnException | Never deriving (Int -> WhenToSave -> ShowS
[WhenToSave] -> ShowS
WhenToSave -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhenToSave] -> ShowS
$cshowList :: [WhenToSave] -> ShowS
show :: WhenToSave -> String
$cshow :: WhenToSave -> String
showsPrec :: Int -> WhenToSave -> ShowS
$cshowsPrec :: Int -> WhenToSave -> ShowS
Show, WhenToSave -> WhenToSave -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhenToSave -> WhenToSave -> Bool
$c/= :: WhenToSave -> WhenToSave -> Bool
== :: WhenToSave -> WhenToSave -> Bool
$c== :: WhenToSave -> WhenToSave -> Bool
Eq)
data RunMode = Normal
| RunHeadless HeadlessConfig
| RunInXvfb XvfbConfig
data WdOptions = WdOptions {
WdOptions -> String
toolsRoot :: ToolsRoot
, WdOptions -> Capabilities
capabilities :: W.Capabilities
, WdOptions -> WhenToSave
saveSeleniumMessageHistory :: WhenToSave
, WdOptions -> SeleniumToUse
seleniumToUse :: SeleniumToUse
, WdOptions -> Maybe String
chromeBinaryPath :: Maybe FilePath
, WdOptions -> ChromeDriverToUse
chromeDriverToUse :: ChromeDriverToUse
, WdOptions -> Maybe String
firefoxBinaryPath :: Maybe FilePath
, WdOptions -> GeckoDriverToUse
geckoDriverToUse :: GeckoDriverToUse
, WdOptions -> RunMode
runMode :: RunMode
, WdOptions -> Maybe Manager
httpManager :: Maybe Manager
, WdOptions -> Int
httpRetryCount :: Int
}
data SeleniumToUse =
DownloadSeleniumFrom String
| DownloadSeleniumDefault
| UseSeleniumAt FilePath
deriving Int -> SeleniumToUse -> ShowS
[SeleniumToUse] -> ShowS
SeleniumToUse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeleniumToUse] -> ShowS
$cshowList :: [SeleniumToUse] -> ShowS
show :: SeleniumToUse -> String
$cshow :: SeleniumToUse -> String
showsPrec :: Int -> SeleniumToUse -> ShowS
$cshowsPrec :: Int -> SeleniumToUse -> ShowS
Show
data ChromeDriverToUse =
DownloadChromeDriverFrom String
| DownloadChromeDriverVersion ChromeDriverVersion
| DownloadChromeDriverAutodetect (Maybe FilePath)
| UseChromeDriverAt FilePath
deriving Int -> ChromeDriverToUse -> ShowS
[ChromeDriverToUse] -> ShowS
ChromeDriverToUse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeDriverToUse] -> ShowS
$cshowList :: [ChromeDriverToUse] -> ShowS
show :: ChromeDriverToUse -> String
$cshow :: ChromeDriverToUse -> String
showsPrec :: Int -> ChromeDriverToUse -> ShowS
$cshowsPrec :: Int -> ChromeDriverToUse -> ShowS
Show
data GeckoDriverToUse =
DownloadGeckoDriverFrom String
| DownloadGeckoDriverVersion GeckoDriverVersion
| DownloadGeckoDriverAutodetect (Maybe FilePath)
| UseGeckoDriverAt FilePath
deriving Int -> GeckoDriverToUse -> ShowS
[GeckoDriverToUse] -> ShowS
GeckoDriverToUse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeckoDriverToUse] -> ShowS
$cshowList :: [GeckoDriverToUse] -> ShowS
show :: GeckoDriverToUse -> String
$cshow :: GeckoDriverToUse -> String
showsPrec :: Int -> GeckoDriverToUse -> ShowS
$cshowsPrec :: Int -> GeckoDriverToUse -> ShowS
Show
newtype ChromeVersion = ChromeVersion (Int, Int, Int, Int) deriving Int -> ChromeVersion -> ShowS
[ChromeVersion] -> ShowS
ChromeVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeVersion] -> ShowS
$cshowList :: [ChromeVersion] -> ShowS
show :: ChromeVersion -> String
$cshow :: ChromeVersion -> String
showsPrec :: Int -> ChromeVersion -> ShowS
$cshowsPrec :: Int -> ChromeVersion -> ShowS
Show
data ChromeDriverVersion =
ChromeDriverVersionTuple (Int, Int, Int, Int)
| ChromeDriverVersionExactUrl (Int, Int, Int, Int) Text
deriving Int -> ChromeDriverVersion -> ShowS
[ChromeDriverVersion] -> ShowS
ChromeDriverVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeDriverVersion] -> ShowS
$cshowList :: [ChromeDriverVersion] -> ShowS
show :: ChromeDriverVersion -> String
$cshow :: ChromeDriverVersion -> String
showsPrec :: Int -> ChromeDriverVersion -> ShowS
$cshowsPrec :: Int -> ChromeDriverVersion -> ShowS
Show
newtype FirefoxVersion = FirefoxVersion (Int, Int, Int) deriving Int -> FirefoxVersion -> ShowS
[FirefoxVersion] -> ShowS
FirefoxVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirefoxVersion] -> ShowS
$cshowList :: [FirefoxVersion] -> ShowS
show :: FirefoxVersion -> String
$cshow :: FirefoxVersion -> String
showsPrec :: Int -> FirefoxVersion -> ShowS
$cshowsPrec :: Int -> FirefoxVersion -> ShowS
Show
newtype GeckoDriverVersion = GeckoDriverVersion (Int, Int, Int) deriving Int -> GeckoDriverVersion -> ShowS
[GeckoDriverVersion] -> ShowS
GeckoDriverVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeckoDriverVersion] -> ShowS
$cshowList :: [GeckoDriverVersion] -> ShowS
show :: GeckoDriverVersion -> String
$cshow :: GeckoDriverVersion -> String
showsPrec :: Int -> GeckoDriverVersion -> ShowS
$cshowsPrec :: Int -> GeckoDriverVersion -> ShowS
Show
data HeadlessConfig = HeadlessConfig {
HeadlessConfig -> Maybe (Int, Int)
headlessResolution :: Maybe (Int, Int)
}
defaultHeadlessConfig :: HeadlessConfig
defaultHeadlessConfig = Maybe (Int, Int) -> HeadlessConfig
HeadlessConfig forall a. Maybe a
Nothing
data XvfbConfig = XvfbConfig {
XvfbConfig -> Maybe (Int, Int)
xvfbResolution :: Maybe (Int, Int)
, XvfbConfig -> Bool
xvfbStartFluxbox :: Bool
}
defaultXvfbConfig :: XvfbConfig
defaultXvfbConfig = Maybe (Int, Int) -> Bool -> XvfbConfig
XvfbConfig forall a. Maybe a
Nothing Bool
False
defaultWdOptions :: FilePath -> WdOptions
defaultWdOptions :: String -> WdOptions
defaultWdOptions String
toolsRoot = WdOptions {
toolsRoot :: String
toolsRoot = String
toolsRoot
, capabilities :: Capabilities
capabilities = forall a. Default a => a
def
, saveSeleniumMessageHistory :: WhenToSave
saveSeleniumMessageHistory = WhenToSave
OnException
, seleniumToUse :: SeleniumToUse
seleniumToUse = SeleniumToUse
DownloadSeleniumDefault
, chromeBinaryPath :: Maybe String
chromeBinaryPath = forall a. Maybe a
Nothing
, chromeDriverToUse :: ChromeDriverToUse
chromeDriverToUse = Maybe String -> ChromeDriverToUse
DownloadChromeDriverAutodetect forall a. Maybe a
Nothing
, firefoxBinaryPath :: Maybe String
firefoxBinaryPath = forall a. Maybe a
Nothing
, geckoDriverToUse :: GeckoDriverToUse
geckoDriverToUse = Maybe String -> GeckoDriverToUse
DownloadGeckoDriverAutodetect forall a. Maybe a
Nothing
, runMode :: RunMode
runMode = RunMode
Normal
, httpManager :: Maybe Manager
httpManager = forall a. Maybe a
Nothing
, httpRetryCount :: Int
httpRetryCount = Int
0
}
data WebDriver = WebDriver {
WebDriver -> String
wdName :: String
, WebDriver
-> (Handle, Handle, ProcessHandle, String, String,
Maybe XvfbSession)
wdWebDriver :: (Handle, Handle, ProcessHandle, FilePath, FilePath, Maybe XvfbSession)
, WebDriver -> WdOptions
wdOptions :: WdOptions
, WebDriver -> MVar (Map String WDSession)
wdSessionMap :: MVar (M.Map Session W.WDSession)
, WebDriver -> WDConfig
wdConfig :: W.WDConfig
, WebDriver -> String
wdDownloadDir :: FilePath
}
data InvalidLogsException = InvalidLogsException [W.LogEntry]
deriving (Int -> InvalidLogsException -> ShowS
[InvalidLogsException] -> ShowS
InvalidLogsException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidLogsException] -> ShowS
$cshowList :: [InvalidLogsException] -> ShowS
show :: InvalidLogsException -> String
$cshow :: InvalidLogsException -> String
showsPrec :: Int -> InvalidLogsException -> ShowS
$cshowsPrec :: Int -> InvalidLogsException -> ShowS
Show)
instance Exception InvalidLogsException
data XvfbSession = XvfbSession { XvfbSession -> Int
xvfbDisplayNum :: Int
, XvfbSession -> String
xvfbXauthority :: FilePath
, XvfbSession -> (Int, Int)
xvfbDimensions :: (Int, Int)
, XvfbSession -> ProcessHandle
xvfbProcess :: ProcessHandle
, XvfbSession -> Maybe ProcessHandle
xvfbFluxboxProcess :: Maybe ProcessHandle }
type WebDriverSession = (Session, IORef W.WDSession)
getWdOptions :: WebDriver -> WdOptions
getWdOptions :: WebDriver -> WdOptions
getWdOptions = WebDriver -> WdOptions
wdOptions
getDisplayNumber :: WebDriver -> Maybe Int
getDisplayNumber :: WebDriver -> Maybe Int
getDisplayNumber (WebDriver {wdWebDriver :: WebDriver
-> (Handle, Handle, ProcessHandle, String, String,
Maybe XvfbSession)
wdWebDriver=(Handle
_, Handle
_, ProcessHandle
_, String
_, String
_, Just (XvfbSession {Int
xvfbDisplayNum :: Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum}))}) = forall a. a -> Maybe a
Just Int
xvfbDisplayNum
getDisplayNumber WebDriver
_ = forall a. Maybe a
Nothing
getXvfbSession :: WebDriver -> Maybe XvfbSession
getXvfbSession :: WebDriver -> Maybe XvfbSession
getXvfbSession (WebDriver {wdWebDriver :: WebDriver
-> (Handle, Handle, ProcessHandle, String, String,
Maybe XvfbSession)
wdWebDriver=(Handle
_, Handle
_, ProcessHandle
_, String
_, String
_, Just XvfbSession
sess)}) = forall a. a -> Maybe a
Just XvfbSession
sess
getXvfbSession WebDriver
_ = forall a. Maybe a
Nothing
getWebDriverName :: WebDriver -> String
getWebDriverName :: WebDriver -> String
getWebDriverName (WebDriver {String
wdName :: String
wdName :: WebDriver -> String
wdName}) = String
wdName
instance Show XvfbSession where
show :: XvfbSession -> String
show (XvfbSession {Int
xvfbDisplayNum :: Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum}) = [i|<XVFB session with server num #{xvfbDisplayNum}>|]
fastX11VideoOptions :: [String]
fastX11VideoOptions = [String
"-an"
, String
"-r", String
"30"
, String
"-vcodec"
, String
"libxvid"
, String
"-qscale:v", String
"1"
, String
"-threads", String
"0"]
qualityX11VideoOptions :: [String]
qualityX11VideoOptions = [String
"-an"
, String
"-r", String
"30"
, String
"-vcodec", String
"libx264"
, String
"-preset", String
"veryslow"
, String
"-crf", String
"0"
, String
"-threads", String
"0"]
defaultAvfoundationOptions :: [String]
defaultAvfoundationOptions = [String
"-r", String
"30"
, String
"-an"
, String
"-vcodec", String
"libxvid"
, String
"-qscale:v", String
"1"
, String
"-threads", String
"0"]
defaultGdigrabOptions :: [String]
defaultGdigrabOptions = [String
"-framerate", String
"30"]
data VideoSettings = VideoSettings {
VideoSettings -> [String]
x11grabOptions :: [String]
, VideoSettings -> [String]
avfoundationOptions :: [String]
, VideoSettings -> [String]
gdigrabOptions :: [String]
, VideoSettings -> Bool
hideMouseWhenRecording :: Bool
, VideoSettings -> Bool
logToDisk :: Bool
}
defaultVideoSettings :: VideoSettings
defaultVideoSettings = VideoSettings {
x11grabOptions :: [String]
x11grabOptions = [String]
fastX11VideoOptions
, avfoundationOptions :: [String]
avfoundationOptions = [String]
defaultAvfoundationOptions
, gdigrabOptions :: [String]
gdigrabOptions = [String]
defaultGdigrabOptions
, hideMouseWhenRecording :: Bool
hideMouseWhenRecording = Bool
False
, logToDisk :: Bool
logToDisk = Bool
True
}