{- |
Module      : Test.Tasty.WebDriver
Description : WebDriverT integration with the Tasty test framework.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

Tasty integration for `WebDriverT` tests.
-}

{-# LANGUAGE DeriveDataTypeable, RecordWildCards, Rank2Types, OverloadedStrings #-}
module Test.Tasty.WebDriver (
    defaultWebDriverMain

  -- * Test Case Constructors
  , testCase
  , testCaseM
  , testCaseT
  , testCaseTM
  , testCaseWithSetup
  , testCaseWithSetupM
  , testCaseWithSetupT
  , testCaseWithSetupTM

  -- * Branching
  , ifDriverIs
  , ifTierIs
  , ifHeadless
  , unlessDriverIs
  , unlessTierIs
  , unlessHeadless

  -- * Options
  , Driver(..)
  , DriverName(..)
  , DataPath(..)
  , Deployment(..)
  , DeploymentTier(..)
  , BrowserPath(..)
  , ApiResponseFormat(..)
  , WebDriverApiVersion(..)
  , LogHandle(..)
  , TestDelay(..)
  , NumRetries(..)
  , LogNoiseLevel(..)
  , ConsoleInHandle(..)
  , ConsoleOutHandle(..)
  , RemoteEndRef(..)
  , Headless(..)
  , LogColors(..)
  , GeckodriverLog(..)
  , PrivateMode(..)

  , module Test.Tasty.WebDriver.Config
  ) where



import Control.Monad.Trans.Class
  ( MonadTrans(..) )
import Control.Monad.Trans.Identity
  ( IdentityT(..) )
import Data.Typeable
  ( Typeable, Proxy(Proxy) )
import System.IO
  ( Handle, stdout, stderr, stdin, openFile, IOMode(..), hClose )
import Control.Concurrent
  ( threadDelay )
import Control.Concurrent.MVar
  ( newMVar )
import Control.Concurrent.STM
  
import Control.Lens
  ((.~), (&))
import qualified Data.ByteString.Lazy.Char8 as BS
  ( pack )
import qualified Data.Digest.Pure.SHA as SHA
  ( showDigest, sha1 )
import Data.Maybe
  ( fromMaybe, catMaybes )
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Data.String
import Network.HTTP.Client
  ( defaultManagerSettings, managerResponseTimeout
  , responseTimeoutNone )
import qualified Network.Wreq as Wreq
  ( defaults, manager )
import qualified System.Environment as SE
  ( getEnv, setEnv, getArgs, lookupEnv )
import System.Exit
  ( exitFailure )
import Text.Read
  ( readMaybe )

import qualified Data.Map.Strict as MS
import Data.Text (Text)
import qualified Test.Tasty as T
import qualified Test.Tasty.Providers as TT
import qualified Test.Tasty.Options as TO

import Web.Api.WebDriver
import Test.Tasty.WebDriver.Config



_OPT_LOG_HANDLE :: (IsString t) => t
_OPT_LOG_HANDLE :: t
_OPT_LOG_HANDLE = t
"wd-log"

_OPT_CONSOLE_OUT :: (IsString t) => t
_OPT_CONSOLE_OUT :: t
_OPT_CONSOLE_OUT = t
"wd-console-out"

_OPT_CONSOLE_IN :: (IsString t) => t
_OPT_CONSOLE_IN :: t
_OPT_CONSOLE_IN = t
"wd-console-in"

_OPT_COLOR :: (IsString t) => t
_OPT_COLOR :: t
_OPT_COLOR = t
"wd-color"

_OPT_HEADLESS :: (IsString t) => t
_OPT_HEADLESS :: t
_OPT_HEADLESS = t
"wd-headless"

_OPT_DRIVER :: (IsString t) => t
_OPT_DRIVER :: t
_OPT_DRIVER = t
"wd-driver"

_OPT_GECKODRIVER_LOG :: (IsString t) => t
_OPT_GECKODRIVER_LOG :: t
_OPT_GECKODRIVER_LOG = t
"wd-geckodriver-log"

_OPT_BROWSERPATH :: (IsString t) => t
_OPT_BROWSERPATH :: t
_OPT_BROWSERPATH = t
"wd-browserpath"

_OPT_DEPLOYMENT :: (IsString t) => t
_OPT_DEPLOYMENT :: t
_OPT_DEPLOYMENT = t
"wd-deploy"

_OPT_REMOTE_ENDS :: (IsString t) => t
_OPT_REMOTE_ENDS :: t
_OPT_REMOTE_ENDS = t
"wd-remote-ends"

_OPT_DATA_PATH :: (IsString t) => t
_OPT_DATA_PATH :: t
_OPT_DATA_PATH = t
"wd-data-path"

_OPT_RESPONSE_FORMAT :: (IsString t) => t
_OPT_RESPONSE_FORMAT :: t
_OPT_RESPONSE_FORMAT = t
"wd-response-format"

_OPT_API_VERSION :: (IsString t) => t
_OPT_API_VERSION :: t
_OPT_API_VERSION = t
"wd-api-version"

_OPT_VERBOSITY :: (IsString t) => t
_OPT_VERBOSITY :: t
_OPT_VERBOSITY = t
"wd-verbosity"

_OPT_NUM_RETRIES :: (IsString t) => t
_OPT_NUM_RETRIES :: t
_OPT_NUM_RETRIES = t
"wd-num-retries"

_OPT_DELAY :: (IsString t) => t
_OPT_DELAY :: t
_OPT_DELAY = t
"wd-delay"

_OPT_REMOTE_ENDS_CONFIG :: (IsString t) => t
_OPT_REMOTE_ENDS_CONFIG :: t
_OPT_REMOTE_ENDS_CONFIG = t
"wd-remote-ends-config"

_OPT_PRIVATE_MODE :: (IsString t) => t
_OPT_PRIVATE_MODE :: t
_OPT_PRIVATE_MODE = t
"wd-private-mode"



data WebDriverTest t eff = WebDriverTest
  { WebDriverTest t eff -> Text
wdTestName :: Text
  , WebDriverTest t eff -> WebDriverTT t eff ()
wdTestSession :: WebDriverTT t eff ()
  , WebDriverTest t eff -> forall a. P WDAct a -> eff a
wdEval :: forall a. P WDAct a -> eff a
  , WebDriverTest t eff -> forall a. t eff a -> IO a
wdToIO :: forall a. t eff a -> IO a
  }



instance
  (Monad eff, Monad (t eff), MonadTrans t, Typeable eff, Typeable t)
    => TT.IsTest (WebDriverTest t eff) where
  testOptions :: Tagged (WebDriverTest t eff) [OptionDescription]
testOptions = [OptionDescription]
-> Tagged (WebDriverTest t eff) [OptionDescription]
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ Proxy Driver -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy Driver
forall k (t :: k). Proxy t
Proxy :: Proxy Driver)
    , Proxy Headless -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy Headless
forall k (t :: k). Proxy t
Proxy :: Proxy Headless)
    , Proxy ApiResponseFormat -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy ApiResponseFormat
forall k (t :: k). Proxy t
Proxy :: Proxy ApiResponseFormat)
    , Proxy WebDriverApiVersion -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy WebDriverApiVersion
forall k (t :: k). Proxy t
Proxy :: Proxy WebDriverApiVersion)
    , Proxy LogHandle -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy LogHandle
forall k (t :: k). Proxy t
Proxy :: Proxy LogHandle)
    , Proxy LogNoiseLevel -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy LogNoiseLevel
forall k (t :: k). Proxy t
Proxy :: Proxy LogNoiseLevel)
    , Proxy ConsoleInHandle -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy ConsoleInHandle
forall k (t :: k). Proxy t
Proxy :: Proxy ConsoleInHandle)
    , Proxy ConsoleOutHandle -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy ConsoleOutHandle
forall k (t :: k). Proxy t
Proxy :: Proxy ConsoleOutHandle)
    , Proxy Deployment -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy Deployment
forall k (t :: k). Proxy t
Proxy :: Proxy Deployment)
    , Proxy DataPath -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy DataPath
forall k (t :: k). Proxy t
Proxy :: Proxy DataPath)
    , Proxy BrowserPath -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy BrowserPath
forall k (t :: k). Proxy t
Proxy :: Proxy BrowserPath)
    , Proxy TestDelay -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy TestDelay
forall k (t :: k). Proxy t
Proxy :: Proxy TestDelay)
    , Proxy RemoteEndRef -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy RemoteEndRef
forall k (t :: k). Proxy t
Proxy :: Proxy RemoteEndRef)
    , Proxy RemoteEndOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy RemoteEndOpt
forall k (t :: k). Proxy t
Proxy :: Proxy RemoteEndOpt)
    , Proxy NumRetries -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy NumRetries
forall k (t :: k). Proxy t
Proxy :: Proxy NumRetries)
    , Proxy LogColors -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy LogColors
forall k (t :: k). Proxy t
Proxy :: Proxy LogColors)
    , Proxy GeckodriverLog -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy GeckodriverLog
forall k (t :: k). Proxy t
Proxy :: Proxy GeckodriverLog)
    , Proxy PrivateMode -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
TO.Option (Proxy PrivateMode
forall k (t :: k). Proxy t
Proxy :: Proxy PrivateMode)
    ]

  run :: OptionSet
-> WebDriverTest t eff -> (Progress -> IO ()) -> IO Result
run OptionSet
opts WebDriverTest{Text
WebDriverTT t eff ()
forall a. t eff a -> IO a
forall a. P WDAct a -> eff a
wdToIO :: forall a. t eff a -> IO a
wdEval :: forall a. P WDAct a -> eff a
wdTestSession :: WebDriverTT t eff ()
wdTestName :: Text
wdToIO :: forall (t :: (* -> *) -> * -> *) (eff :: * -> *).
WebDriverTest t eff -> forall a. t eff a -> IO a
wdEval :: forall (t :: (* -> *) -> * -> *) (eff :: * -> *).
WebDriverTest t eff -> forall a. P WDAct a -> eff a
wdTestSession :: forall (t :: (* -> *) -> * -> *) (eff :: * -> *).
WebDriverTest t eff -> WebDriverTT t eff ()
wdTestName :: forall (t :: (* -> *) -> * -> *) (eff :: * -> *).
WebDriverTest t eff -> Text
..} Progress -> IO ()
_ = do
    let
      Driver DriverName
driver = OptionSet -> Driver
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      Headless Bool
headless = OptionSet -> Headless
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      ApiResponseFormat ResponseFormat
format = OptionSet -> ApiResponseFormat
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      WebDriverApiVersion ApiVersion
version = OptionSet -> WebDriverApiVersion
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      LogHandle Handle
logHandle = OptionSet -> LogHandle
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      logNoiseLevel :: LogNoiseLevel
logNoiseLevel = OptionSet -> LogNoiseLevel
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      ConsoleInHandle Handle
cinHandle = OptionSet -> ConsoleInHandle
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      TestDelay Int
delay = OptionSet -> TestDelay
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      ConsoleOutHandle Handle
coutHandle = OptionSet -> ConsoleOutHandle
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      DataPath Maybe FilePath
datas = OptionSet -> DataPath
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      BrowserPath Maybe FilePath
browserPath = OptionSet -> BrowserPath
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      RemoteEndRef Maybe (TVar RemoteEndPool)
remotes = OptionSet -> RemoteEndRef
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      NumRetries Int
numRetries = OptionSet -> NumRetries
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      LogColors Bool
logColors = OptionSet -> LogColors
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      GeckodriverLog LogLevel
geckoLogLevel = OptionSet -> GeckodriverLog
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts
      PrivateMode Bool
privateMode = OptionSet -> PrivateMode
forall v. IsOption v => OptionSet -> v
TO.lookupOption OptionSet
opts

    let
      title :: WebDriverTT t eff ()
title = Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
comment Text
wdTestName

      attemptLabel :: a -> WebDriverTT t eff ()
attemptLabel a
k = Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
comment (Text -> WebDriverTT t eff ()) -> Text -> WebDriverTT t eff ()
forall a b. (a -> b) -> a -> b
$ Text
"Attempt #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (a -> FilePath
forall a. Show a => a -> FilePath
show a
k)

      logNoise :: Bool
logNoise = case LogNoiseLevel
logNoiseLevel of
        LogNoiseLevel
NoisyLog -> Bool
False
        LogNoiseLevel
SilentLog -> Bool
True

      caps :: Capabilities
caps = case DriverName
driver of
        DriverName
Geckodriver -> Capabilities
emptyCapabilities
          { _browserName :: Maybe BrowserName
_browserName = BrowserName -> Maybe BrowserName
forall a. a -> Maybe a
Just BrowserName
Firefox
          , _firefoxOptions :: Maybe FirefoxOptions
_firefoxOptions = FirefoxOptions -> Maybe FirefoxOptions
forall a. a -> Maybe a
Just FirefoxOptions
defaultFirefoxOptions
            { _firefoxBinary :: Maybe FilePath
_firefoxBinary = Maybe FilePath
browserPath
            , _firefoxArgs :: Maybe [Text]
_firefoxArgs = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
              [ if Bool
headless then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-headless" else Maybe Text
forall a. Maybe a
Nothing
              , if Bool
privateMode then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-private" else Maybe Text
forall a. Maybe a
Nothing
              ]
            , _firefoxLog :: Maybe FirefoxLog
_firefoxLog = FirefoxLog -> Maybe FirefoxLog
forall a. a -> Maybe a
Just FirefoxLog :: Maybe LogLevel -> FirefoxLog
FirefoxLog
              { _firefoxLogLevel :: Maybe LogLevel
_firefoxLogLevel = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
geckoLogLevel
              }
            }
          }

        DriverName
Chromedriver -> Capabilities
emptyCapabilities
          { _browserName :: Maybe BrowserName
_browserName = BrowserName -> Maybe BrowserName
forall a. a -> Maybe a
Just BrowserName
Chrome
          , _chromeOptions :: Maybe ChromeOptions
_chromeOptions = ChromeOptions -> Maybe ChromeOptions
forall a. a -> Maybe a
Just (ChromeOptions -> Maybe ChromeOptions)
-> ChromeOptions -> Maybe ChromeOptions
forall a b. (a -> b) -> a -> b
$ ChromeOptions
defaultChromeOptions
            { _chromeBinary :: Maybe FilePath
_chromeBinary = Maybe FilePath
browserPath
            , _chromeArgs :: Maybe [Text]
_chromeArgs = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
              [ if Bool
headless then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"--headless" else Maybe Text
forall a. Maybe a
Nothing
              , if Bool
privateMode then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"--incognito" else Maybe Text
forall a. Maybe a
Nothing
              ]
            }
          }

    FilePath
dataPath <- case Maybe FilePath
datas of
      Maybe FilePath
Nothing -> (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/.webdriver") (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
SE.getEnv FilePath
"HOME"
      Just FilePath
dpath -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dpath

    TVar RemoteEndPool
remotesRef <- case Maybe (TVar RemoteEndPool)
remotes of
      Just TVar RemoteEndPool
ref -> TVar RemoteEndPool -> IO (TVar RemoteEndPool)
forall (m :: * -> *) a. Monad m => a -> m a
return TVar RemoteEndPool
ref
      Maybe (TVar RemoteEndPool)
Nothing -> do
        FilePath -> IO ()
putStrLn FilePath
"Error: no remote ends specified."
        IO (TVar RemoteEndPool)
forall a. IO a
exitFailure

    MVar ()
logLock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()

    let
      attempt :: Int -> IO TT.Result
      attempt :: Int -> IO Result
attempt Int
attemptNumber = do

        RemoteEnd
remote <- TVar RemoteEndPool -> Int -> DriverName -> IO RemoteEnd
acquireRemoteEnd TVar RemoteEndPool
remotesRef Int
delay DriverName
driver

        let
          uid :: Text
uid = Text -> Text
forall a. Show a => a -> Text
digest Text
wdTestName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
attemptNumber) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (RemoteEnd -> FilePath
forall a. Show a => a -> FilePath
show RemoteEnd
remote)
            where
              digest :: (Show a) => a -> Text
              digest :: a -> Text
digest = FilePath -> Text
Text.pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
8 (FilePath -> FilePath) -> (a -> FilePath) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA1State -> FilePath
forall t. Digest t -> FilePath
SHA.showDigest (Digest SHA1State -> FilePath)
-> (a -> Digest SHA1State) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
SHA.sha1 (ByteString -> Digest SHA1State)
-> (a -> ByteString) -> a -> Digest SHA1State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> (a -> FilePath) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show

          config :: WebDriverConfig eff
config = WDConfig :: forall (eff :: * -> *).
S WDState
-> R WDError WDLog WDEnv
-> (forall a. P WDAct a -> eff a)
-> WebDriverConfig eff
WDConfig
            { _evaluator :: forall a. P WDAct a -> eff a
_evaluator = forall a. P WDAct a -> eff a
wdEval
            , _initialState :: S WDState
_initialState = S :: forall s. Options -> Maybe Session -> s -> S s
S
              { _httpOptions :: Options
_httpOptions = Options
Wreq.defaults
                  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Either ManagerSettings Manager
 -> Identity (Either ManagerSettings Manager))
-> Options -> Identity Options
Lens' Options (Either ManagerSettings Manager)
Wreq.manager ((Either ManagerSettings Manager
  -> Identity (Either ManagerSettings Manager))
 -> Options -> Identity Options)
-> Either ManagerSettings Manager -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ManagerSettings -> Either ManagerSettings Manager
forall a b. a -> Either a b
Left (ManagerSettings
defaultManagerSettings 
                    { managerResponseTimeout :: ResponseTimeout
managerResponseTimeout = ResponseTimeout
responseTimeoutNone } )
              , _httpSession :: Maybe Session
_httpSession = Maybe Session
forall a. Maybe a
Nothing
              , _userState :: WDState
_userState = WDState :: Maybe Text -> BreakpointSetting -> WDState
WDState
                { _sessionId :: Maybe Text
_sessionId = Maybe Text
forall a. Maybe a
Nothing
                , _breakpoints :: BreakpointSetting
_breakpoints = BreakpointSetting
BreakpointsOff
                }
              }
            , _environment :: R WDError WDLog WDEnv
_environment = R WDError WDLog WDEnv
defaultWebDriverEnvironment
              { _logHandle :: Handle
_logHandle = Handle
logHandle
              , _logLock :: Maybe (MVar ())
_logLock = MVar () -> Maybe (MVar ())
forall a. a -> Maybe a
Just MVar ()
logLock
              , _uid :: Text
_uid = Text
uid
              , _logOptions :: LogOptions WDError WDLog
_logOptions = LogOptions WDError WDLog
defaultWebDriverLogOptions
                { _logColor :: Bool
_logColor = Bool
logColors
                , _logJson :: Bool
_logJson = Bool
True
                , _logHeaders :: Bool
_logHeaders = Bool
False
                , _logSilent :: Bool
_logSilent = Bool
logNoise
                }
              , _env :: WDEnv
_env = WDEnv :: Text
-> Int
-> Text
-> FilePath
-> ResponseFormat
-> ApiVersion
-> Handle
-> Handle
-> WDEnv
WDEnv
                { _remoteHostname :: Text
_remoteHostname = RemoteEnd -> Text
remoteEndHost RemoteEnd
remote
                , _remotePort :: Int
_remotePort = RemoteEnd -> Int
remoteEndPort RemoteEnd
remote
                , _remotePath :: Text
_remotePath = RemoteEnd -> Text
remoteEndPath RemoteEnd
remote
                , _responseFormat :: ResponseFormat
_responseFormat = ResponseFormat
format
                , _apiVersion :: ApiVersion
_apiVersion = ApiVersion
version
                , _dataPath :: FilePath
_dataPath = FilePath
dataPath
                , _stdout :: Handle
_stdout = Handle
coutHandle
                , _stdin :: Handle
_stdin = Handle
cinHandle
                }
              }
            }

        (Either Text ()
result, AssertionSummary
summary) <- t eff (Either Text (), AssertionSummary)
-> IO (Either Text (), AssertionSummary)
forall a. t eff a -> IO a
wdToIO (t eff (Either Text (), AssertionSummary)
 -> IO (Either Text (), AssertionSummary))
-> t eff (Either Text (), AssertionSummary)
-> IO (Either Text (), AssertionSummary)
forall a b. (a -> b) -> a -> b
$ WebDriverConfig eff
-> WebDriverTT t eff () -> t eff (Either Text (), AssertionSummary)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverConfig eff
-> WebDriverTT t eff a -> t eff (Either Text a, AssertionSummary)
debugWebDriverTT WebDriverConfig eff
config (WebDriverTT t eff () -> t eff (Either Text (), AssertionSummary))
-> WebDriverTT t eff () -> t eff (Either Text (), AssertionSummary)
forall a b. (a -> b) -> a -> b
$
            WebDriverTT t eff ()
title WebDriverTT t eff ()
-> WebDriverTT t eff () -> WebDriverTT t eff ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t, Show a) =>
a -> WebDriverTT t eff ()
attemptLabel Int
attemptNumber WebDriverTT t eff ()
-> WebDriverTT t eff () -> WebDriverTT t eff ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Capabilities -> WebDriverTT t eff () -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
Capabilities -> WebDriverTT t eff a -> WebDriverTT t eff ()
runIsolated_ Capabilities
caps WebDriverTT t eff ()
wdTestSession

        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar RemoteEndPool -> DriverName -> RemoteEnd -> STM ()
releaseRemoteEnd TVar RemoteEndPool
remotesRef DriverName
driver RemoteEnd
remote

        case Either Text ()
result of
          Right ()
_ ->
            Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ AssertionSummary -> Result
webDriverAssertionsToResult AssertionSummary
summary
          Left Text
err -> if Int
attemptNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numRetries
            then Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ FilePath -> Result
TT.testFailed (FilePath -> Result) -> FilePath -> Result
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
"Unhandled error!\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
            else Int -> IO Result
attempt (Int
attemptNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    Int -> IO Result
attempt Int
1



webDriverAssertionsToResult :: AssertionSummary -> TT.Result
webDriverAssertionsToResult :: AssertionSummary -> Result
webDriverAssertionsToResult AssertionSummary
x =
  if AssertionSummary -> Integer
numFailures AssertionSummary
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
    then FilePath -> Result
TT.testFailed (FilePath -> Result) -> FilePath -> Result
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (Assertion -> FilePath) -> [Assertion] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
Text.unpack (Text -> FilePath) -> (Assertion -> Text) -> Assertion -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Text
printAssertion) ([Assertion] -> [FilePath]) -> [Assertion] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ AssertionSummary -> [Assertion]
failures AssertionSummary
x
    else FilePath -> Result
TT.testPassed (FilePath -> Result) -> FilePath -> Result
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show (AssertionSummary -> Integer
numSuccesses AssertionSummary
x) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" assertion(s)"



-- | `WebDriver` test case with the default `IO` effect evaluator.
testCase
  :: TT.TestName
  -> WebDriverT IO () -- ^ The test
  -> TT.TestTree
testCase :: FilePath -> WebDriverT IO () -> TestTree
testCase FilePath
name WebDriverT IO ()
test =
  FilePath
-> WebDriverT IO ()
-> (() -> WebDriverT IO ())
-> (() -> WebDriverT IO ())
-> TestTree
forall u v.
FilePath
-> WebDriverT IO u
-> (v -> WebDriverT IO ())
-> (u -> WebDriverT IO v)
-> TestTree
testCaseWithSetup FilePath
name (() -> WebDriverT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () -> WebDriverT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (WebDriverT IO () -> () -> WebDriverT IO ()
forall a b. a -> b -> a
const WebDriverT IO ()
test)


-- | `WebDriver` test case with a custom effect evaluator.
testCaseM
  :: (Monad eff, Typeable eff)
  => TT.TestName
  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator
  -> (forall a. eff a -> IO a) -- ^ Conversion to `IO`
  -> WebDriverT eff ()
  -> TT.TestTree
testCaseM :: FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. eff a -> IO a)
-> WebDriverT eff ()
-> TestTree
testCaseM FilePath
name forall a. P WDAct a -> eff a
eval forall a. eff a -> IO a
toIO WebDriverT eff ()
test =
  FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. eff a -> IO a)
-> WebDriverT eff ()
-> (() -> WebDriverT eff ())
-> (() -> WebDriverT eff ())
-> TestTree
forall (eff :: * -> *) u v.
(Monad eff, Typeable eff) =>
FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. eff a -> IO a)
-> WebDriverT eff u
-> (v -> WebDriverT eff ())
-> (u -> WebDriverT eff v)
-> TestTree
testCaseWithSetupM FilePath
name forall a. P WDAct a -> eff a
eval forall a. eff a -> IO a
toIO (() -> WebDriverT eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () -> WebDriverT eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return (WebDriverT eff () -> () -> WebDriverT eff ()
forall a b. a -> b -> a
const WebDriverT eff ()
test)


-- | `WebDriverT` test case with the default `IO` effect evaluator.
testCaseT
  :: (Monad (t IO), MonadTrans t, Typeable t)
  => TT.TestName
  -> (forall a. t IO a -> IO a) -- ^ Conversion to `IO`
  -> WebDriverTT t IO () -- ^ The test
  -> TT.TestTree
testCaseT :: FilePath
-> (forall a. t IO a -> IO a) -> WebDriverTT t IO () -> TestTree
testCaseT FilePath
name forall a. t IO a -> IO a
toIO WebDriverTT t IO ()
test =
  FilePath
-> (forall a. t IO a -> IO a)
-> WebDriverTT t IO ()
-> (() -> WebDriverTT t IO ())
-> (() -> WebDriverTT t IO ())
-> TestTree
forall (t :: (* -> *) -> * -> *) u v.
(Monad (t IO), MonadTrans t, Typeable t) =>
FilePath
-> (forall a. t IO a -> IO a)
-> WebDriverTT t IO u
-> (v -> WebDriverTT t IO ())
-> (u -> WebDriverTT t IO v)
-> TestTree
testCaseWithSetupT FilePath
name forall a. t IO a -> IO a
toIO (() -> WebDriverTT t IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () -> WebDriverTT t IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (WebDriverTT t IO () -> () -> WebDriverTT t IO ()
forall a b. a -> b -> a
const WebDriverTT t IO ()
test)


-- | `WebDriverT` test case with a custom effect evaluator.
testCaseTM
  :: (Monad eff, Monad (t eff), MonadTrans t, Typeable eff, Typeable t)
  => TT.TestName
  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator
  -> (forall a. t eff a -> IO a) -- ^ Conversion to `IO`.
  -> WebDriverTT t eff () -- ^ The test
  -> TT.TestTree
testCaseTM :: FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTT t eff ()
-> TestTree
testCaseTM FilePath
name forall a. P WDAct a -> eff a
eval forall a. t eff a -> IO a
toIO WebDriverTT t eff ()
test =
  FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTT t eff ()
-> (() -> WebDriverTT t eff ())
-> (() -> WebDriverTT t eff ())
-> TestTree
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) u v.
(Monad eff, Monad (t eff), MonadTrans t, Typeable eff,
 Typeable t) =>
FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTT t eff u
-> (v -> WebDriverTT t eff ())
-> (u -> WebDriverTT t eff v)
-> TestTree
testCaseWithSetupTM FilePath
name forall a. P WDAct a -> eff a
eval forall a. t eff a -> IO a
toIO (() -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return (WebDriverTT t eff () -> () -> WebDriverTT t eff ()
forall a b. a -> b -> a
const WebDriverTT t eff ()
test)


-- | `WebDriver` test case with additional setup and teardown phases using the default `IO` effect evaluator. Setup runs before the test (for e.g. logging in) and teardown runs after the test (for e.g. deleting temp files).
testCaseWithSetup
  :: TT.TestName
  -> WebDriverT IO u -- ^ Setup
  -> (v -> WebDriverT IO ()) -- ^ Teardown
  -> (u -> WebDriverT IO v) -- ^ The test
  -> TT.TestTree
testCaseWithSetup :: FilePath
-> WebDriverT IO u
-> (v -> WebDriverT IO ())
-> (u -> WebDriverT IO v)
-> TestTree
testCaseWithSetup FilePath
name =
  FilePath
-> (forall a. P WDAct a -> IO a)
-> (forall a. IO a -> IO a)
-> WebDriverT IO u
-> (v -> WebDriverT IO ())
-> (u -> WebDriverT IO v)
-> TestTree
forall (eff :: * -> *) u v.
(Monad eff, Typeable eff) =>
FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. eff a -> IO a)
-> WebDriverT eff u
-> (v -> WebDriverT eff ())
-> (u -> WebDriverT eff v)
-> TestTree
testCaseWithSetupM FilePath
name ((WDAct a -> IO a) -> P WDAct a -> IO a
forall (p :: * -> *) a. (p a -> IO a) -> P p a -> IO a
evalIO WDAct a -> IO a
forall a. WDAct a -> IO a
evalWDAct) forall a. a -> a
forall a. IO a -> IO a
id


-- | `WebDriver` test case with additional setup and teardown phases and a custom effect evaluator. Setup runs before the test (for e.g. logging in) and teardown runs after the test (for e.g. deleting temp files).
testCaseWithSetupM
  :: (Monad eff, Typeable eff)
  => TT.TestName
  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator
  -> (forall a. eff a -> IO a) -- ^ Conversion to `IO`
  -> WebDriverT eff u -- ^ Setup
  -> (v -> WebDriverT eff ()) -- ^ Teardown
  -> (u -> WebDriverT eff v) -- ^ The test
  -> TT.TestTree
testCaseWithSetupM :: FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. eff a -> IO a)
-> WebDriverT eff u
-> (v -> WebDriverT eff ())
-> (u -> WebDriverT eff v)
-> TestTree
testCaseWithSetupM FilePath
name forall a. P WDAct a -> eff a
eval forall a. eff a -> IO a
toIO =
  FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. IdentityT eff a -> IO a)
-> WebDriverT eff u
-> (v -> WebDriverT eff ())
-> (u -> WebDriverT eff v)
-> TestTree
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) u v.
(Monad eff, Monad (t eff), MonadTrans t, Typeable eff,
 Typeable t) =>
FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTT t eff u
-> (v -> WebDriverTT t eff ())
-> (u -> WebDriverTT t eff v)
-> TestTree
testCaseWithSetupTM FilePath
name forall a. P WDAct a -> eff a
eval (eff a -> IO a
forall a. eff a -> IO a
toIO (eff a -> IO a)
-> (IdentityT eff a -> eff a) -> IdentityT eff a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT eff a -> eff a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT)


-- | `WebDriverT` test case with additional setup and teardown phases using the default `IO` effect evaluator. Setup runs before the test (for e.g. logging in) and teardown runs after the test (for e.g. deleting temp files).
testCaseWithSetupT
  :: (Monad (t IO), MonadTrans t, Typeable t)
  => TT.TestName
  -> (forall a. t IO a -> IO a) -- ^ Conversion to `IO`
  -> WebDriverTT t IO u -- ^ Setup
  -> (v -> WebDriverTT t IO ()) -- ^ Teardown
  -> (u -> WebDriverTT t IO v) -- ^ Test
  -> TT.TestTree
testCaseWithSetupT :: FilePath
-> (forall a. t IO a -> IO a)
-> WebDriverTT t IO u
-> (v -> WebDriverTT t IO ())
-> (u -> WebDriverTT t IO v)
-> TestTree
testCaseWithSetupT FilePath
name =
  FilePath
-> (forall a. P WDAct a -> IO a)
-> (forall a. t IO a -> IO a)
-> WebDriverTT t IO u
-> (v -> WebDriverTT t IO ())
-> (u -> WebDriverTT t IO v)
-> TestTree
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) u v.
(Monad eff, Monad (t eff), MonadTrans t, Typeable eff,
 Typeable t) =>
FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTT t eff u
-> (v -> WebDriverTT t eff ())
-> (u -> WebDriverTT t eff v)
-> TestTree
testCaseWithSetupTM FilePath
name ((WDAct a -> IO a) -> P WDAct a -> IO a
forall (p :: * -> *) a. (p a -> IO a) -> P p a -> IO a
evalIO WDAct a -> IO a
forall a. WDAct a -> IO a
evalWDAct)


-- | `WebDriverT` test case with additional setup and teardown phases and a custom effect evaluator. Setup runs before the test (for logging in, say) and teardown runs after the test (for deleting temp files, say). 
testCaseWithSetupTM
  :: (Monad eff, Monad (t eff), MonadTrans t, Typeable eff, Typeable t)
  => TT.TestName
  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator
  -> (forall a. t eff a -> IO a) -- ^ Conversion to `IO`.
  -> WebDriverTT t eff u -- ^ Setup
  -> (v -> WebDriverTT t eff ()) -- ^ Teardown
  -> (u -> WebDriverTT t eff v) -- ^ Test
  -> TT.TestTree
testCaseWithSetupTM :: FilePath
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTT t eff u
-> (v -> WebDriverTT t eff ())
-> (u -> WebDriverTT t eff v)
-> TestTree
testCaseWithSetupTM FilePath
name forall a. P WDAct a -> eff a
eval forall a. t eff a -> IO a
toIO WebDriverTT t eff u
setup v -> WebDriverTT t eff ()
teardown u -> WebDriverTT t eff v
test =
  FilePath -> WebDriverTest t eff -> TestTree
forall t. IsTest t => FilePath -> t -> TestTree
TT.singleTest FilePath
name WebDriverTest :: forall (t :: (* -> *) -> * -> *) (eff :: * -> *).
Text
-> WebDriverTT t eff ()
-> (forall a. P WDAct a -> eff a)
-> (forall a. t eff a -> IO a)
-> WebDriverTest t eff
WebDriverTest
    { wdTestName :: Text
wdTestName = FilePath -> Text
Text.pack FilePath
name
    , wdTestSession :: WebDriverTT t eff ()
wdTestSession = WebDriverTT t eff u
setup WebDriverTT t eff u
-> (u -> WebDriverTT t eff v) -> WebDriverTT t eff v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= u -> WebDriverTT t eff v
test WebDriverTT t eff v
-> (v -> WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> WebDriverTT t eff ()
teardown
    , wdEval :: forall a. P WDAct a -> eff a
wdEval = forall a. P WDAct a -> eff a
eval
    , wdToIO :: forall a. t eff a -> IO a
wdToIO = forall a. t eff a -> IO a
toIO
    }



-- | Remote end name.
newtype Driver
  = Driver { Driver -> DriverName
theDriver :: DriverName }
  deriving Typeable

instance TO.IsOption Driver where
  defaultValue :: Driver
defaultValue = DriverName -> Driver
Driver DriverName
Geckodriver
  parseValue :: FilePath -> Maybe Driver
parseValue FilePath
str = case FilePath
str of
    FilePath
"geckodriver" -> Driver -> Maybe Driver
forall a. a -> Maybe a
Just (Driver -> Maybe Driver) -> Driver -> Maybe Driver
forall a b. (a -> b) -> a -> b
$ DriverName -> Driver
Driver DriverName
Geckodriver
    FilePath
"chromedriver" -> Driver -> Maybe Driver
forall a. a -> Maybe a
Just (Driver -> Maybe Driver) -> Driver -> Maybe Driver
forall a b. (a -> b) -> a -> b
$ DriverName -> Driver
Driver DriverName
Chromedriver
    FilePath
_ -> Maybe Driver
forall a. Maybe a
Nothing
  optionName :: Tagged Driver FilePath
optionName = FilePath -> Tagged Driver FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_DRIVER
  optionHelp :: Tagged Driver FilePath
optionHelp = FilePath -> Tagged Driver FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"remote end name: (geckodriver), chromedriver"



-- | Governs whether logs are printed in color
newtype LogColors
  = LogColors { LogColors -> Bool
theLogColors :: Bool }
  deriving Typeable

instance TO.IsOption LogColors where
  defaultValue :: LogColors
defaultValue = Bool -> LogColors
LogColors Bool
True
  parseValue :: FilePath -> Maybe LogColors
parseValue = (Bool -> LogColors) -> Maybe Bool -> Maybe LogColors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> LogColors
LogColors (Maybe Bool -> Maybe LogColors)
-> (FilePath -> Maybe Bool) -> FilePath -> Maybe LogColors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Bool
TO.safeReadBool
  optionName :: Tagged LogColors FilePath
optionName = FilePath -> Tagged LogColors FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_COLOR
  optionHelp :: Tagged LogColors FilePath
optionHelp = FilePath -> Tagged LogColors FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"colored logs: (true), false"



-- | Run in headless mode.
newtype Headless
  = Headless { Headless -> Bool
theHeadless :: Bool }
  deriving Typeable

instance TO.IsOption Headless where
  defaultValue :: Headless
defaultValue = Bool -> Headless
Headless Bool
False
  parseValue :: FilePath -> Maybe Headless
parseValue = (Bool -> Headless) -> Maybe Bool -> Maybe Headless
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Headless
Headless (Maybe Bool -> Maybe Headless)
-> (FilePath -> Maybe Bool) -> FilePath -> Maybe Headless
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Bool
TO.safeReadBool
  optionName :: Tagged Headless FilePath
optionName = FilePath -> Tagged Headless FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_HEADLESS
  optionHelp :: Tagged Headless FilePath
optionHelp = FilePath -> Tagged Headless FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"run in headless mode: (false), true"



-- | Run in private mode.
newtype PrivateMode
  = PrivateMode { PrivateMode -> Bool
thePrivateMode :: Bool }
  deriving Typeable

instance TO.IsOption PrivateMode where
  defaultValue :: PrivateMode
defaultValue = Bool -> PrivateMode
PrivateMode Bool
False
  parseValue :: FilePath -> Maybe PrivateMode
parseValue = (Bool -> PrivateMode) -> Maybe Bool -> Maybe PrivateMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> PrivateMode
PrivateMode (Maybe Bool -> Maybe PrivateMode)
-> (FilePath -> Maybe Bool) -> FilePath -> Maybe PrivateMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Bool
TO.safeReadBool
  optionName :: Tagged PrivateMode FilePath
optionName = FilePath -> Tagged PrivateMode FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_PRIVATE_MODE
  optionHelp :: Tagged PrivateMode FilePath
optionHelp = FilePath -> Tagged PrivateMode FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"run in private mode: (false), true"



-- | Path where secrets are stored.
newtype DataPath
  = DataPath { DataPath -> Maybe FilePath
theDataPath :: Maybe FilePath }
  deriving Typeable

instance TO.IsOption DataPath where
  defaultValue :: DataPath
defaultValue = Maybe FilePath -> DataPath
DataPath Maybe FilePath
forall a. Maybe a
Nothing
  parseValue :: FilePath -> Maybe DataPath
parseValue FilePath
path = DataPath -> Maybe DataPath
forall a. a -> Maybe a
Just (DataPath -> Maybe DataPath) -> DataPath -> Maybe DataPath
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> DataPath
DataPath (Maybe FilePath -> DataPath) -> Maybe FilePath -> DataPath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path
  optionName :: Tagged DataPath FilePath
optionName = FilePath -> Tagged DataPath FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_DATA_PATH
  optionHelp :: Tagged DataPath FilePath
optionHelp = FilePath -> Tagged DataPath FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"data path: (~/.webdriver), PATH"



-- | Verbosity level passed to @geckodriver@
newtype GeckodriverLog
  = GeckodriverLog { GeckodriverLog -> LogLevel
theGeckodriverLog :: LogLevel }
  deriving Typeable

instance TO.IsOption GeckodriverLog where
  defaultValue :: GeckodriverLog
defaultValue = LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogInfo
  parseValue :: FilePath -> Maybe GeckodriverLog
parseValue FilePath
level = case FilePath
level of
    FilePath
"trace" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogTrace
    FilePath
"debug" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogDebug
    FilePath
"config" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogConfig
    FilePath
"info" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogInfo
    FilePath
"warn" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogWarn
    FilePath
"error" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogError
    FilePath
"fatal" -> GeckodriverLog -> Maybe GeckodriverLog
forall a. a -> Maybe a
Just (GeckodriverLog -> Maybe GeckodriverLog)
-> GeckodriverLog -> Maybe GeckodriverLog
forall a b. (a -> b) -> a -> b
$ LogLevel -> GeckodriverLog
GeckodriverLog LogLevel
LogFatal
    FilePath
_ -> Maybe GeckodriverLog
forall a. Maybe a
Nothing
  optionName :: Tagged GeckodriverLog FilePath
optionName = FilePath -> Tagged GeckodriverLog FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_GECKODRIVER_LOG
  optionHelp :: Tagged GeckodriverLog FilePath
optionHelp = FilePath -> Tagged GeckodriverLog FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"log level passed to geckodriver: trace, debug, config, info, warn, error, fatal"



-- | Path to browser binary.
newtype BrowserPath
  = BrowserPath { BrowserPath -> Maybe FilePath
theBrowserPath :: Maybe FilePath }
  deriving Typeable

instance TO.IsOption BrowserPath where
  defaultValue :: BrowserPath
defaultValue = Maybe FilePath -> BrowserPath
BrowserPath Maybe FilePath
forall a. Maybe a
Nothing
  parseValue :: FilePath -> Maybe BrowserPath
parseValue FilePath
path = BrowserPath -> Maybe BrowserPath
forall a. a -> Maybe a
Just (BrowserPath -> Maybe BrowserPath)
-> BrowserPath -> Maybe BrowserPath
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> BrowserPath
BrowserPath (Maybe FilePath -> BrowserPath) -> Maybe FilePath -> BrowserPath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path
  optionName :: Tagged BrowserPath FilePath
optionName = FilePath -> Tagged BrowserPath FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_BROWSERPATH
  optionHelp :: Tagged BrowserPath FilePath
optionHelp = FilePath -> Tagged BrowserPath FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"path to browser binary: (), PATH"



-- | Expected API response format.
newtype ApiResponseFormat
  = ApiResponseFormat { ApiResponseFormat -> ResponseFormat
theApiResponseFormat :: ResponseFormat }
  deriving Typeable

instance TO.IsOption ApiResponseFormat where
  defaultValue :: ApiResponseFormat
defaultValue = ResponseFormat -> ApiResponseFormat
ApiResponseFormat ResponseFormat
SpecFormat
  parseValue :: FilePath -> Maybe ApiResponseFormat
parseValue FilePath
str = case FilePath
str of
    FilePath
"spec" -> ApiResponseFormat -> Maybe ApiResponseFormat
forall a. a -> Maybe a
Just (ApiResponseFormat -> Maybe ApiResponseFormat)
-> ApiResponseFormat -> Maybe ApiResponseFormat
forall a b. (a -> b) -> a -> b
$ ResponseFormat -> ApiResponseFormat
ApiResponseFormat ResponseFormat
SpecFormat
    FilePath
"chromedriver" -> ApiResponseFormat -> Maybe ApiResponseFormat
forall a. a -> Maybe a
Just (ApiResponseFormat -> Maybe ApiResponseFormat)
-> ApiResponseFormat -> Maybe ApiResponseFormat
forall a b. (a -> b) -> a -> b
$ ResponseFormat -> ApiResponseFormat
ApiResponseFormat ResponseFormat
ChromeFormat
    FilePath
_ -> Maybe ApiResponseFormat
forall a. Maybe a
Nothing
  optionName :: Tagged ApiResponseFormat FilePath
optionName = FilePath -> Tagged ApiResponseFormat FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_RESPONSE_FORMAT
  optionHelp :: Tagged ApiResponseFormat FilePath
optionHelp = FilePath -> Tagged ApiResponseFormat FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"JSON response format: (spec), chromedriver"



-- | WebDriver API version.
newtype WebDriverApiVersion
  = WebDriverApiVersion { WebDriverApiVersion -> ApiVersion
theWebDriverApiVersion :: ApiVersion }
  deriving Typeable

instance TO.IsOption WebDriverApiVersion where
  defaultValue :: WebDriverApiVersion
defaultValue = ApiVersion -> WebDriverApiVersion
WebDriverApiVersion ApiVersion
CR_2018_03_04
  parseValue :: FilePath -> Maybe WebDriverApiVersion
parseValue FilePath
str = case FilePath
str of
    FilePath
"cr-2018-03-04" -> WebDriverApiVersion -> Maybe WebDriverApiVersion
forall a. a -> Maybe a
Just (WebDriverApiVersion -> Maybe WebDriverApiVersion)
-> WebDriverApiVersion -> Maybe WebDriverApiVersion
forall a b. (a -> b) -> a -> b
$ ApiVersion -> WebDriverApiVersion
WebDriverApiVersion ApiVersion
CR_2018_03_04
    FilePath
_ -> Maybe WebDriverApiVersion
forall a. Maybe a
Nothing
  optionName :: Tagged WebDriverApiVersion FilePath
optionName = FilePath -> Tagged WebDriverApiVersion FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_API_VERSION
  optionHelp :: Tagged WebDriverApiVersion FilePath
optionHelp = FilePath -> Tagged WebDriverApiVersion FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"WebDriverT API version: (cr-2018-03-04)"



-- | Log location.
newtype LogHandle
  = LogHandle { LogHandle -> Handle
theLogHandle :: Handle }
  deriving Typeable

instance TO.IsOption LogHandle where
  defaultValue :: LogHandle
defaultValue = Handle -> LogHandle
LogHandle Handle
stderr
  parseValue :: FilePath -> Maybe LogHandle
parseValue FilePath
_ = LogHandle -> Maybe LogHandle
forall a. a -> Maybe a
Just (LogHandle -> Maybe LogHandle) -> LogHandle -> Maybe LogHandle
forall a b. (a -> b) -> a -> b
$ Handle -> LogHandle
LogHandle Handle
stderr
  optionName :: Tagged LogHandle FilePath
optionName = FilePath -> Tagged LogHandle FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_LOG_HANDLE
  optionHelp :: Tagged LogHandle FilePath
optionHelp = FilePath -> Tagged LogHandle FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"log destination: (stderr), stdout, PATH"



-- | Log Noise Level.
data LogNoiseLevel
  = NoisyLog
  | SilentLog
  deriving Typeable

instance TO.IsOption LogNoiseLevel where
  defaultValue :: LogNoiseLevel
defaultValue = LogNoiseLevel
NoisyLog
  parseValue :: FilePath -> Maybe LogNoiseLevel
parseValue FilePath
str = case FilePath
str of
    FilePath
"noisy" -> LogNoiseLevel -> Maybe LogNoiseLevel
forall a. a -> Maybe a
Just LogNoiseLevel
NoisyLog
    FilePath
"silent" -> LogNoiseLevel -> Maybe LogNoiseLevel
forall a. a -> Maybe a
Just LogNoiseLevel
SilentLog
    FilePath
_ -> Maybe LogNoiseLevel
forall a. Maybe a
Nothing
  optionName :: Tagged LogNoiseLevel FilePath
optionName = FilePath -> Tagged LogNoiseLevel FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_VERBOSITY
  optionHelp :: Tagged LogNoiseLevel FilePath
optionHelp = FilePath -> Tagged LogNoiseLevel FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"log verbosity: (noisy), silent"



-- | Max number of retries.
newtype NumRetries
  = NumRetries { NumRetries -> Int
theNumRetries :: Int }
  deriving Typeable

instance TO.IsOption NumRetries where
  defaultValue :: NumRetries
defaultValue = Int -> NumRetries
NumRetries Int
1
  parseValue :: FilePath -> Maybe NumRetries
parseValue = (Int -> NumRetries) -> Maybe Int -> Maybe NumRetries
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> NumRetries
NumRetries (Maybe Int -> Maybe NumRetries)
-> (FilePath -> Maybe Int) -> FilePath -> Maybe NumRetries
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe
  optionName :: Tagged NumRetries FilePath
optionName = FilePath -> Tagged NumRetries FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_NUM_RETRIES
  optionHelp :: Tagged NumRetries FilePath
optionHelp = FilePath -> Tagged NumRetries FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"number of times to retry a failed test"



-- | Console in location. Used to mock stdin for testing.
newtype ConsoleInHandle
  = ConsoleInHandle { ConsoleInHandle -> Handle
theConsoleInHandle :: Handle }
  deriving Typeable

instance TO.IsOption ConsoleInHandle where
  defaultValue :: ConsoleInHandle
defaultValue = Handle -> ConsoleInHandle
ConsoleInHandle Handle
stdin
  parseValue :: FilePath -> Maybe ConsoleInHandle
parseValue FilePath
_ = ConsoleInHandle -> Maybe ConsoleInHandle
forall a. a -> Maybe a
Just (ConsoleInHandle -> Maybe ConsoleInHandle)
-> ConsoleInHandle -> Maybe ConsoleInHandle
forall a b. (a -> b) -> a -> b
$ Handle -> ConsoleInHandle
ConsoleInHandle Handle
stdin
  optionName :: Tagged ConsoleInHandle FilePath
optionName = FilePath -> Tagged ConsoleInHandle FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_CONSOLE_IN
  optionHelp :: Tagged ConsoleInHandle FilePath
optionHelp = FilePath -> Tagged ConsoleInHandle FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"console input: (stdin), PATH"



-- | Console out location. Used to mock stdout for testing.
newtype ConsoleOutHandle
  = ConsoleOutHandle { ConsoleOutHandle -> Handle
theConsoleOutHandle :: Handle }
  deriving Typeable

instance TO.IsOption ConsoleOutHandle where
  defaultValue :: ConsoleOutHandle
defaultValue = Handle -> ConsoleOutHandle
ConsoleOutHandle Handle
stdout
  parseValue :: FilePath -> Maybe ConsoleOutHandle
parseValue FilePath
_ = ConsoleOutHandle -> Maybe ConsoleOutHandle
forall a. a -> Maybe a
Just (ConsoleOutHandle -> Maybe ConsoleOutHandle)
-> ConsoleOutHandle -> Maybe ConsoleOutHandle
forall a b. (a -> b) -> a -> b
$ Handle -> ConsoleOutHandle
ConsoleOutHandle Handle
stdout
  optionName :: Tagged ConsoleOutHandle FilePath
optionName = FilePath -> Tagged ConsoleOutHandle FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_CONSOLE_OUT
  optionHelp :: Tagged ConsoleOutHandle FilePath
optionHelp = FilePath -> Tagged ConsoleOutHandle FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"console output: (stdout), stderr, PATH"



-- | Delay between test attempts.
newtype TestDelay = TestDelay
  { TestDelay -> Int
theTestDelay :: Int
  } deriving (TestDelay -> TestDelay -> Bool
(TestDelay -> TestDelay -> Bool)
-> (TestDelay -> TestDelay -> Bool) -> Eq TestDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestDelay -> TestDelay -> Bool
$c/= :: TestDelay -> TestDelay -> Bool
== :: TestDelay -> TestDelay -> Bool
$c== :: TestDelay -> TestDelay -> Bool
Eq, Int -> TestDelay -> FilePath -> FilePath
[TestDelay] -> FilePath -> FilePath
TestDelay -> FilePath
(Int -> TestDelay -> FilePath -> FilePath)
-> (TestDelay -> FilePath)
-> ([TestDelay] -> FilePath -> FilePath)
-> Show TestDelay
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [TestDelay] -> FilePath -> FilePath
$cshowList :: [TestDelay] -> FilePath -> FilePath
show :: TestDelay -> FilePath
$cshow :: TestDelay -> FilePath
showsPrec :: Int -> TestDelay -> FilePath -> FilePath
$cshowsPrec :: Int -> TestDelay -> FilePath -> FilePath
Show, Typeable)

instance TO.IsOption TestDelay where
  defaultValue :: TestDelay
defaultValue = Int -> TestDelay
TestDelay Int
800000
  parseValue :: FilePath -> Maybe TestDelay
parseValue = (Int -> TestDelay) -> Maybe Int -> Maybe TestDelay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> TestDelay
TestDelay (Maybe Int -> Maybe TestDelay)
-> (FilePath -> Maybe Int) -> FilePath -> Maybe TestDelay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe
  optionName :: Tagged TestDelay FilePath
optionName = FilePath -> Tagged TestDelay FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_DELAY
  optionHelp :: Tagged TestDelay FilePath
optionHelp = FilePath -> Tagged TestDelay FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"delay between test attempts in ms: (500000), INT"



-- | Named deployment environment.
newtype Deployment
  = Deployment { Deployment -> DeploymentTier
theDeployment :: DeploymentTier }
  deriving (Deployment -> Deployment -> Bool
(Deployment -> Deployment -> Bool)
-> (Deployment -> Deployment -> Bool) -> Eq Deployment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deployment -> Deployment -> Bool
$c/= :: Deployment -> Deployment -> Bool
== :: Deployment -> Deployment -> Bool
$c== :: Deployment -> Deployment -> Bool
Eq, Typeable)

-- | Representation of the deployment environment.
data DeploymentTier
  = DEV -- ^ Local environment
  | TEST -- ^ CI server (for testing the library)
  | PROD -- ^ "Production" -- e.g. testing a real site
  deriving (DeploymentTier -> DeploymentTier -> Bool
(DeploymentTier -> DeploymentTier -> Bool)
-> (DeploymentTier -> DeploymentTier -> Bool) -> Eq DeploymentTier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeploymentTier -> DeploymentTier -> Bool
$c/= :: DeploymentTier -> DeploymentTier -> Bool
== :: DeploymentTier -> DeploymentTier -> Bool
$c== :: DeploymentTier -> DeploymentTier -> Bool
Eq, Int -> DeploymentTier -> FilePath -> FilePath
[DeploymentTier] -> FilePath -> FilePath
DeploymentTier -> FilePath
(Int -> DeploymentTier -> FilePath -> FilePath)
-> (DeploymentTier -> FilePath)
-> ([DeploymentTier] -> FilePath -> FilePath)
-> Show DeploymentTier
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [DeploymentTier] -> FilePath -> FilePath
$cshowList :: [DeploymentTier] -> FilePath -> FilePath
show :: DeploymentTier -> FilePath
$cshow :: DeploymentTier -> FilePath
showsPrec :: Int -> DeploymentTier -> FilePath -> FilePath
$cshowsPrec :: Int -> DeploymentTier -> FilePath -> FilePath
Show, Typeable)

instance TO.IsOption Deployment where
  defaultValue :: Deployment
defaultValue = DeploymentTier -> Deployment
Deployment DeploymentTier
DEV
  parseValue :: FilePath -> Maybe Deployment
parseValue FilePath
str = case FilePath
str of
    FilePath
"dev" -> Deployment -> Maybe Deployment
forall a. a -> Maybe a
Just (Deployment -> Maybe Deployment) -> Deployment -> Maybe Deployment
forall a b. (a -> b) -> a -> b
$ DeploymentTier -> Deployment
Deployment DeploymentTier
DEV
    FilePath
"test" -> Deployment -> Maybe Deployment
forall a. a -> Maybe a
Just (Deployment -> Maybe Deployment) -> Deployment -> Maybe Deployment
forall a b. (a -> b) -> a -> b
$ DeploymentTier -> Deployment
Deployment DeploymentTier
TEST
    FilePath
"prod" -> Deployment -> Maybe Deployment
forall a. a -> Maybe a
Just (Deployment -> Maybe Deployment) -> Deployment -> Maybe Deployment
forall a b. (a -> b) -> a -> b
$ DeploymentTier -> Deployment
Deployment DeploymentTier
PROD
    FilePath
_ -> Maybe Deployment
forall a. Maybe a
Nothing
  optionName :: Tagged Deployment FilePath
optionName = FilePath -> Tagged Deployment FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_DEPLOYMENT
  optionHelp :: Tagged Deployment FilePath
optionHelp = FilePath -> Tagged Deployment FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"deployment environment: (dev), test, prod"



-- | Mutable remote end pool
newtype RemoteEndRef = RemoteEndRef
  { RemoteEndRef -> Maybe (TVar RemoteEndPool)
theRemoteEndRef :: Maybe (TVar RemoteEndPool)
  } deriving (Typeable)

instance TO.IsOption RemoteEndRef where
  defaultValue :: RemoteEndRef
defaultValue = Maybe (TVar RemoteEndPool) -> RemoteEndRef
RemoteEndRef Maybe (TVar RemoteEndPool)
forall a. Maybe a
Nothing
  parseValue :: FilePath -> Maybe RemoteEndRef
parseValue FilePath
_ = RemoteEndRef -> Maybe RemoteEndRef
forall a. a -> Maybe a
Just (RemoteEndRef -> Maybe RemoteEndRef)
-> RemoteEndRef -> Maybe RemoteEndRef
forall a b. (a -> b) -> a -> b
$ Maybe (TVar RemoteEndPool) -> RemoteEndRef
RemoteEndRef Maybe (TVar RemoteEndPool)
forall a. Maybe a
Nothing
  optionName :: Tagged RemoteEndRef FilePath
optionName = FilePath -> Tagged RemoteEndRef FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_REMOTE_ENDS_CONFIG
  optionHelp :: Tagged RemoteEndRef FilePath
optionHelp = FilePath -> Tagged RemoteEndRef FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"path to remote end config"



data RemoteEndOpt = RemoteEndOpt
  deriving Typeable

instance TO.IsOption RemoteEndOpt where
  defaultValue :: RemoteEndOpt
defaultValue = RemoteEndOpt
RemoteEndOpt
  parseValue :: FilePath -> Maybe RemoteEndOpt
parseValue FilePath
_ = RemoteEndOpt -> Maybe RemoteEndOpt
forall a. a -> Maybe a
Just RemoteEndOpt
RemoteEndOpt
  optionName :: Tagged RemoteEndOpt FilePath
optionName = FilePath -> Tagged RemoteEndOpt FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
forall t. IsString t => t
_OPT_REMOTE_ENDS
  optionHelp :: Tagged RemoteEndOpt FilePath
optionHelp = FilePath -> Tagged RemoteEndOpt FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"remote end uris"



-- | Set local options if the @Driver@ option is a given value.
ifDriverIs :: DriverName -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree
ifDriverIs :: DriverName -> (TestTree -> TestTree) -> TestTree -> TestTree
ifDriverIs DriverName
driver TestTree -> TestTree
f TestTree
tree = (Driver -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
T.askOption Driver -> TestTree
checkDriver
  where
    checkDriver :: Driver -> TT.TestTree
    checkDriver :: Driver -> TestTree
checkDriver (Driver DriverName
d) = if DriverName
d DriverName -> DriverName -> Bool
forall a. Eq a => a -> a -> Bool
== DriverName
driver
      then TestTree -> TestTree
f TestTree
tree
      else TestTree
tree

-- | Set local options if the @Driver@ option is not a given value.
unlessDriverIs :: DriverName -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree
unlessDriverIs :: DriverName -> (TestTree -> TestTree) -> TestTree -> TestTree
unlessDriverIs DriverName
driver TestTree -> TestTree
f TestTree
tree = (Driver -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
T.askOption Driver -> TestTree
checkDriver
  where
    checkDriver :: Driver -> TT.TestTree
    checkDriver :: Driver -> TestTree
checkDriver (Driver DriverName
d) = if DriverName
d DriverName -> DriverName -> Bool
forall a. Eq a => a -> a -> Bool
/= DriverName
driver
      then TestTree -> TestTree
f TestTree
tree
      else TestTree
tree



-- | Set local options if the @Deployment@ option is a given value.
ifTierIs :: DeploymentTier -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree
ifTierIs :: DeploymentTier -> (TestTree -> TestTree) -> TestTree -> TestTree
ifTierIs DeploymentTier
tier TestTree -> TestTree
f TestTree
tree = (Deployment -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
T.askOption Deployment -> TestTree
checkDeployment
  where
    checkDeployment :: Deployment -> TT.TestTree
    checkDeployment :: Deployment -> TestTree
checkDeployment (Deployment DeploymentTier
t) = if DeploymentTier
t DeploymentTier -> DeploymentTier -> Bool
forall a. Eq a => a -> a -> Bool
== DeploymentTier
tier
      then TestTree -> TestTree
f TestTree
tree
      else TestTree
tree

-- | Set local options if the @Deployment@ option is not a given value.
unlessTierIs :: DeploymentTier -> (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree
unlessTierIs :: DeploymentTier -> (TestTree -> TestTree) -> TestTree -> TestTree
unlessTierIs DeploymentTier
tier TestTree -> TestTree
f TestTree
tree = (Deployment -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
T.askOption Deployment -> TestTree
checkDeployment
  where
    checkDeployment :: Deployment -> TT.TestTree
    checkDeployment :: Deployment -> TestTree
checkDeployment (Deployment DeploymentTier
t) = if DeploymentTier
t DeploymentTier -> DeploymentTier -> Bool
forall a. Eq a => a -> a -> Bool
/= DeploymentTier
tier
      then TestTree -> TestTree
f TestTree
tree
      else TestTree
tree



-- | Set local options if `Headless` is true.
ifHeadless :: (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree
ifHeadless :: (TestTree -> TestTree) -> TestTree -> TestTree
ifHeadless TestTree -> TestTree
f TestTree
tree = (Headless -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
T.askOption Headless -> TestTree
checkHeadless
  where
    checkHeadless :: Headless -> TT.TestTree
    checkHeadless :: Headless -> TestTree
checkHeadless (Headless Bool
p) = (if Bool
p then TestTree -> TestTree
f else TestTree -> TestTree
forall a. a -> a
id) TestTree
tree

-- | Set local options if `Headless` is false.
unlessHeadless :: (TT.TestTree -> TT.TestTree) -> TT.TestTree -> TT.TestTree
unlessHeadless :: (TestTree -> TestTree) -> TestTree -> TestTree
unlessHeadless TestTree -> TestTree
f TestTree
tree = (Headless -> TestTree) -> TestTree
forall v. IsOption v => (v -> TestTree) -> TestTree
T.askOption Headless -> TestTree
checkHeadless
  where
    checkHeadless :: Headless -> TT.TestTree
    checkHeadless :: Headless -> TestTree
checkHeadless (Headless Bool
p) = (if Bool
p then TestTree -> TestTree
forall a. a -> a
id else TestTree -> TestTree
f) TestTree
tree



-- | Run a tree of WebDriverT tests. Thin wrapper around tasty's @defaultMain@ that attempts to determine the deployment tier and interprets remote end config command line options.
defaultWebDriverMain :: TT.TestTree -> IO ()
defaultWebDriverMain :: TestTree -> IO ()
defaultWebDriverMain TestTree
tree = do
  TVar RemoteEndPool
pool <- IO (TVar RemoteEndPool)
getRemoteEndRef

  -- Determine the deployment tier
  DeploymentTier
deploy <- Text
-> (Text -> Maybe DeploymentTier)
-> Text
-> (Text -> Maybe DeploymentTier)
-> DeploymentTier
-> IO DeploymentTier
forall a.
Text -> (Text -> Maybe a) -> Text -> (Text -> Maybe a) -> a -> IO a
getEnvVarDefaultOption
    Text
forall t. IsString t => t
_OPT_DEPLOYMENT (Text -> [(Text, DeploymentTier)] -> Maybe DeploymentTier
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text
"dev", DeploymentTier
DEV), (Text
"test", DeploymentTier
TEST), (Text
"prod", DeploymentTier
PROD)])
    Text
"CI" (\Text
str -> DeploymentTier -> Maybe DeploymentTier
forall a. a -> Maybe a
Just (DeploymentTier -> Maybe DeploymentTier)
-> DeploymentTier -> Maybe DeploymentTier
forall a b. (a -> b) -> a -> b
$ if Text
str Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true" then DeploymentTier
TEST else DeploymentTier
DEV)
    DeploymentTier
DEV
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
">>> Deployment environment is " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ DeploymentTier -> FilePath
forall a. Show a => a -> FilePath
show DeploymentTier
deploy

  -- Determine color output preferences
  Bool
colors <- Text
-> (Text -> Maybe Bool)
-> Text
-> (Text -> Maybe Bool)
-> Bool
-> IO Bool
forall a.
Text -> (Text -> Maybe a) -> Text -> (Text -> Maybe a) -> a -> IO a
getEnvVarDefaultOption
    Text
forall t. IsString t => t
_OPT_COLOR (Text -> [(Text, Bool)] -> Maybe Bool
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text
"true", Bool
True), (Text
"false", Bool
False)])
    Text
"NO_COLOR" (\Text
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
    Bool
True
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
">>> Logging " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (if Bool
colors then FilePath
"with" else FilePath
"without") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" colors"

  if Bool
colors
    then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else FilePath -> FilePath -> IO ()
SE.setEnv FilePath
"TASTY_COLOR" FilePath
"never"

  Handle
logHandle <- Text -> Handle -> IO Handle
getWriteModeHandleOption Text
forall t. IsString t => t
_OPT_LOG_HANDLE Handle
stderr
  Handle
coutHandle <- Text -> Handle -> IO Handle
getWriteModeHandleOption Text
forall t. IsString t => t
_OPT_CONSOLE_OUT Handle
stdout
  Handle
cinHandle <- Text -> Handle -> IO Handle
getReadModeHandleOption Text
forall t. IsString t => t
_OPT_CONSOLE_IN Handle
stdin

  TestTree -> IO ()
T.defaultMain
    (TestTree -> IO ()) -> (TestTree -> TestTree) -> TestTree -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deployment -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
T.localOption (DeploymentTier -> Deployment
Deployment DeploymentTier
deploy)
    (TestTree -> TestTree)
-> (TestTree -> TestTree) -> TestTree -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteEndRef -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
T.localOption (Maybe (TVar RemoteEndPool) -> RemoteEndRef
RemoteEndRef (Maybe (TVar RemoteEndPool) -> RemoteEndRef)
-> Maybe (TVar RemoteEndPool) -> RemoteEndRef
forall a b. (a -> b) -> a -> b
$ TVar RemoteEndPool -> Maybe (TVar RemoteEndPool)
forall a. a -> Maybe a
Just TVar RemoteEndPool
pool)
    (TestTree -> TestTree)
-> (TestTree -> TestTree) -> TestTree -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogHandle -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
T.localOption (Handle -> LogHandle
LogHandle Handle
logHandle)
    (TestTree -> TestTree)
-> (TestTree -> TestTree) -> TestTree -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogColors -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
T.localOption (Bool -> LogColors
LogColors Bool
colors)
    (TestTree -> TestTree)
-> (TestTree -> TestTree) -> TestTree -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsoleOutHandle -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
T.localOption (Handle -> ConsoleOutHandle
ConsoleOutHandle Handle
coutHandle)
    (TestTree -> TestTree)
-> (TestTree -> TestTree) -> TestTree -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsoleInHandle -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
T.localOption (Handle -> ConsoleInHandle
ConsoleInHandle Handle
cinHandle)
    (TestTree -> IO ()) -> TestTree -> IO ()
forall a b. (a -> b) -> a -> b
$ TestTree
tree

  (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
hClose
    [ Handle
logHandle, Handle
coutHandle, Handle
cinHandle ]


getWriteModeHandleOption :: Text -> Handle -> IO Handle
getWriteModeHandleOption :: Text -> Handle -> IO Handle
getWriteModeHandleOption Text
opt Handle
theDefault = do
  [Text]
args <- ([FilePath] -> [Text]) -> IO [FilePath] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack) IO [FilePath]
SE.getArgs
  case Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument (Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opt) [Text]
args of
    Maybe (Maybe Text)
Nothing -> do
      Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: option '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is missing a required path argument"
      IO Handle
forall a. IO a
exitFailure
    Just Maybe Text
Nothing -> Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
theDefault
    Just (Just Text
path) -> case Text
path of
      Text
"stdout" -> Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
      Text
"stderr" -> Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stderr
      Text
_ -> FilePath -> IOMode -> IO Handle
openFile (Text -> FilePath
Text.unpack Text
path) IOMode
WriteMode


getReadModeHandleOption :: Text -> Handle -> IO Handle
getReadModeHandleOption :: Text -> Handle -> IO Handle
getReadModeHandleOption Text
opt Handle
theDefault = do
  [Text]
args <- ([FilePath] -> [Text]) -> IO [FilePath] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack) IO [FilePath]
SE.getArgs
  case Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument (Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opt) [Text]
args of
    Maybe (Maybe Text)
Nothing -> do
      Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: option '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is missing a required path argument"
      IO Handle
forall a. IO a
exitFailure
    Just Maybe Text
Nothing -> Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
theDefault
    Just (Just Text
path) -> case Text
path of
      Text
"stdin" -> Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdin
      Text
_ -> FilePath -> IOMode -> IO Handle
openFile (Text -> FilePath
Text.unpack Text
path) IOMode
ReadMode


-- | Get the value of an option that can be controlled by either a command line flag or an environment variable, with the flag taking precedence.
getEnvVarDefaultOption
  :: Text -- ^ Flag name
  -> (Text -> Maybe a) -- ^ Mapping flag values to option values
  -> Text -- ^ Environment variable name
  -> (Text -> Maybe a) -- ^ Mapping environment variable values to option values
  -> a -- ^ Default option value (if neither flag nor env var is set)
  -> IO a
getEnvVarDefaultOption :: Text -> (Text -> Maybe a) -> Text -> (Text -> Maybe a) -> a -> IO a
getEnvVarDefaultOption Text
flag Text -> Maybe a
flagMap Text
var Text -> Maybe a
varMap a
def = do
  [FilePath]
args <- IO [FilePath]
SE.getArgs
  case Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument (Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
flag) ((FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack [FilePath]
args) of

    -- Flag is present, but with no argument given.
    Maybe (Maybe Text)
Nothing -> do
      Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: option '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
flag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is missing a required argument"
      IO a
forall a. IO a
exitFailure

    -- Flag with argument is present.
    Just (Just Text
value) ->
      case Text -> Maybe a
flagMap Text
value of
        Just a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Maybe a
Nothing -> do
          Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: unrecognized value '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' for option '--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
flag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
          IO a
forall a. IO a
exitFailure

    -- Flag not present; try to use the environment variable.
    Just Maybe Text
Nothing -> do
      Maybe FilePath
value <- FilePath -> IO (Maybe FilePath)
SE.lookupEnv (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
var
      case (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack Maybe FilePath
value of

        -- Environment variable is set.
        Just Text
str ->
          case Text -> Maybe a
varMap Text
str of
            Just a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
            Maybe a
Nothing -> do
              Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: unrecognized value '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
"' for environment variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'."
              IO a
forall a. IO a
exitFailure

        -- Environment variable not set; use default.
        Maybe Text
Nothing -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def



getRemoteEndRef :: IO (TVar RemoteEndPool)
getRemoteEndRef :: IO (TVar RemoteEndPool)
getRemoteEndRef = do
  RemoteEndPool
configPool <- RemoteEndPool -> Maybe RemoteEndPool -> RemoteEndPool
forall a. a -> Maybe a -> a
fromMaybe RemoteEndPool
forall a. Monoid a => a
mempty (Maybe RemoteEndPool -> RemoteEndPool)
-> IO (Maybe RemoteEndPool) -> IO RemoteEndPool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe RemoteEndPool)
getRemoteEndConfigPath
  RemoteEndPool
optionPool <- RemoteEndPool -> Maybe RemoteEndPool -> RemoteEndPool
forall a. a -> Maybe a -> a
fromMaybe RemoteEndPool
forall a. Monoid a => a
mempty (Maybe RemoteEndPool -> RemoteEndPool)
-> IO (Maybe RemoteEndPool) -> IO RemoteEndPool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe RemoteEndPool)
getRemoteEndOptionString
  let pool :: RemoteEndPool
pool = RemoteEndPool -> RemoteEndPool -> RemoteEndPool
forall a. Monoid a => a -> a -> a
mappend RemoteEndPool
configPool RemoteEndPool
optionPool
  if RemoteEndPool
pool RemoteEndPool -> RemoteEndPool -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteEndPool
forall a. Monoid a => a
mempty
    then RemoteEndPool -> IO (TVar RemoteEndPool)
forall a. a -> IO (TVar a)
newTVarIO (RemoteEndPool -> IO (TVar RemoteEndPool))
-> RemoteEndPool -> IO (TVar RemoteEndPool)
forall a b. (a -> b) -> a -> b
$ Map DriverName [RemoteEnd] -> RemoteEndPool
RemoteEndPool (Map DriverName [RemoteEnd] -> RemoteEndPool)
-> Map DriverName [RemoteEnd] -> RemoteEndPool
forall a b. (a -> b) -> a -> b
$ [(DriverName, [RemoteEnd])] -> Map DriverName [RemoteEnd]
forall k a. Ord k => [(k, a)] -> Map k a
MS.fromList
      [ (DriverName
Geckodriver, [Text -> Int -> Text -> RemoteEnd
RemoteEnd Text
"localhost" Int
4444 Text
""])
      , (DriverName
Chromedriver, [Text -> Int -> Text -> RemoteEnd
RemoteEnd Text
"localhost" Int
9515 Text
""])
      ]
    else RemoteEndPool -> IO (TVar RemoteEndPool)
forall a. a -> IO (TVar a)
newTVarIO (RemoteEndPool -> IO (TVar RemoteEndPool))
-> RemoteEndPool -> IO (TVar RemoteEndPool)
forall a b. (a -> b) -> a -> b
$ RemoteEndPool -> RemoteEndPool -> RemoteEndPool
forall a. Monoid a => a -> a -> a
mappend RemoteEndPool
configPool RemoteEndPool
optionPool



getRemoteEndConfigPath :: IO (Maybe RemoteEndPool)
getRemoteEndConfigPath :: IO (Maybe RemoteEndPool)
getRemoteEndConfigPath = do
  [Text]
args <- ([FilePath] -> [Text]) -> IO [FilePath] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack) IO [FilePath]
SE.getArgs
  case Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument Text
"--wd-remote-ends-config" [Text]
args of
    Maybe (Maybe Text)
Nothing -> do
      FilePath -> IO ()
putStrLn FilePath
"option --wd-remote-ends-config missing required path argument"
      IO (Maybe RemoteEndPool)
forall a. IO a
exitFailure
    Just Maybe Text
Nothing -> Maybe RemoteEndPool -> IO (Maybe RemoteEndPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteEndPool
forall a. Maybe a
Nothing
    Just (Just Text
path) -> do
      Text
str <- FilePath -> IO Text
Text.readFile (FilePath -> IO Text) -> FilePath -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
path
      case Text -> Either Text RemoteEndPool
parseRemoteEndConfig Text
str of
        Left Text
err -> do
          Text -> IO ()
Text.putStrLn Text
err
          IO (Maybe RemoteEndPool)
forall a. IO a
exitFailure
        Right RemoteEndPool
x -> Maybe RemoteEndPool -> IO (Maybe RemoteEndPool)
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteEndPool -> Maybe RemoteEndPool
forall a. a -> Maybe a
Just RemoteEndPool
x)



getRemoteEndOptionString :: IO (Maybe RemoteEndPool)
getRemoteEndOptionString :: IO (Maybe RemoteEndPool)
getRemoteEndOptionString = do
  [Text]
args <- ([FilePath] -> [Text]) -> IO [FilePath] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack) IO [FilePath]
SE.getArgs
  case Text -> [Text] -> Maybe (Maybe Text)
parseOptionWithArgument Text
"--wd-remote-ends" [Text]
args of
    Maybe (Maybe Text)
Nothing -> do
      FilePath -> IO ()
putStrLn FilePath
"option --wd-remote-ends missing required argument"
      IO (Maybe RemoteEndPool)
forall a. IO a
exitFailure
    Just Maybe Text
Nothing -> Maybe RemoteEndPool -> IO (Maybe RemoteEndPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RemoteEndPool
forall a. Maybe a
Nothing
    Just (Just Text
str) ->
      case Text -> Either Text RemoteEndPool
parseRemoteEndOption Text
str of
        Left Text
err -> do
          Text -> IO ()
Text.putStrLn Text
err
          IO (Maybe RemoteEndPool)
forall a. IO a
exitFailure
        Right RemoteEndPool
x -> Maybe RemoteEndPool -> IO (Maybe RemoteEndPool)
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteEndPool -> Maybe RemoteEndPool
forall a. a -> Maybe a
Just RemoteEndPool
x)



acquireRemoteEnd :: TVar RemoteEndPool -> Int -> DriverName -> IO RemoteEnd
acquireRemoteEnd :: TVar RemoteEndPool -> Int -> DriverName -> IO RemoteEnd
acquireRemoteEnd TVar RemoteEndPool
var Int
delay DriverName
driver = do
  Maybe (Maybe RemoteEnd)
result <- STM (Maybe (Maybe RemoteEnd)) -> IO (Maybe (Maybe RemoteEnd))
forall a. STM a -> IO a
atomically (STM (Maybe (Maybe RemoteEnd)) -> IO (Maybe (Maybe RemoteEnd)))
-> STM (Maybe (Maybe RemoteEnd)) -> IO (Maybe (Maybe RemoteEnd))
forall a b. (a -> b) -> a -> b
$ TVar RemoteEndPool -> DriverName -> STM (Maybe (Maybe RemoteEnd))
acquireRemoteEndSTM TVar RemoteEndPool
var DriverName
driver
  case Maybe (Maybe RemoteEnd)
result of
    Maybe (Maybe RemoteEnd)
Nothing -> do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: no remotes defined for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ DriverName -> FilePath
forall a. Show a => a -> FilePath
show DriverName
driver
      IO RemoteEnd
forall a. IO a
exitFailure
    Just Maybe RemoteEnd
Nothing -> do
      Int -> IO ()
threadDelay Int
delay
      TVar RemoteEndPool -> Int -> DriverName -> IO RemoteEnd
acquireRemoteEnd TVar RemoteEndPool
var Int
delay DriverName
driver
    Just (Just RemoteEnd
x) -> RemoteEnd -> IO RemoteEnd
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteEnd
x

acquireRemoteEndSTM
  :: TVar RemoteEndPool -> DriverName -> STM (Maybe (Maybe RemoteEnd))
acquireRemoteEndSTM :: TVar RemoteEndPool -> DriverName -> STM (Maybe (Maybe RemoteEnd))
acquireRemoteEndSTM TVar RemoteEndPool
var DriverName
driver = do
  RemoteEndPool
pool <- TVar RemoteEndPool -> STM RemoteEndPool
forall a. TVar a -> STM a
readTVar TVar RemoteEndPool
var
  let (RemoteEndPool
newPool, Maybe (Maybe RemoteEnd)
result) = DriverName
-> RemoteEndPool -> (RemoteEndPool, Maybe (Maybe RemoteEnd))
getRemoteEndForDriver DriverName
driver RemoteEndPool
pool
  TVar RemoteEndPool -> RemoteEndPool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar RemoteEndPool
var RemoteEndPool
newPool
  Maybe (Maybe RemoteEnd) -> STM (Maybe (Maybe RemoteEnd))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe RemoteEnd)
result

releaseRemoteEnd :: TVar RemoteEndPool -> DriverName -> RemoteEnd -> STM ()
releaseRemoteEnd :: TVar RemoteEndPool -> DriverName -> RemoteEnd -> STM ()
releaseRemoteEnd TVar RemoteEndPool
var DriverName
driver RemoteEnd
remote =
  TVar RemoteEndPool -> (RemoteEndPool -> RemoteEndPool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar RemoteEndPool
var ((RemoteEndPool -> RemoteEndPool) -> STM ())
-> (RemoteEndPool -> RemoteEndPool) -> STM ()
forall a b. (a -> b) -> a -> b
$ DriverName -> RemoteEnd -> RemoteEndPool -> RemoteEndPool
addRemoteEndForDriver DriverName
driver RemoteEnd
remote