module Mortred.Types where import RIO import System.Process.Typed (Process) data SessionDependencyConfiguration = SessionDependencyConfiguration { chromeBinary :: FilePath, chromeDriverBinary :: FilePath, seleniumPath :: SeleniumPath } deriving (Eq, Show) data SeleniumProcess = SeleniumProcess { xvfbProcess :: XvfbProcess, process :: Process () () (), port :: SeleniumPort } deriving (Show) data XvfbProcess = XvfbProcess { displayNumber :: DisplayNumber, process :: Process () () () } deriving (Show) newtype DisplayNumber = DisplayNumber {unDisplayNumber :: Int} deriving (Eq, Show) -- | Represents the full path to a Selenium JAR-file. newtype SeleniumPath = SeleniumPath {unSeleniumPath :: FilePath} deriving (Eq, Show) newtype SeleniumPort = SeleniumPort {unSeleniumPort :: Int} deriving (Eq, Show) newtype Url = Url {unUrl :: String} deriving (Eq, Show) newtype MajorVersion = MajorVersion {unMajorVersion :: Int} deriving (Eq, Show) newtype Milliseconds = Milliseconds {unMilliseconds :: Int} deriving (Eq, Show) newtype ChromeVersion = ChromeVersion {unChromeVersion :: MajorVersion} deriving (Eq, Show) newtype ChromeDriverVersion = ChromeDriverVersion {unChromeDriverVersion :: MajorVersion} deriving (Eq, Show)