{-# LANGUAGE TemplateHaskell #-}

module Test.WebDriver.Capabilities.FirefoxOptions where

import Data.Aeson as A
import Data.Aeson.TH
import Lens.Micro.TH
import Test.WebDriver.Capabilities.Aeson
import Test.WebDriver.Profile


data FirefoxLogLevelType =
  FirefoxLogLevelTypeTrace
  | FirefoxLogLevelTypeDebug
  | FirefoxLogLevelTypeConfig
  | FirefoxLogLevelTypeInfo
  | FirefoxLogLevelTypeWarn
  | FirefoxLogLevelTypeError
  | FirefoxLogLevelTypeFatal
  deriving (Int -> FirefoxLogLevelType -> ShowS
[FirefoxLogLevelType] -> ShowS
FirefoxLogLevelType -> String
(Int -> FirefoxLogLevelType -> ShowS)
-> (FirefoxLogLevelType -> String)
-> ([FirefoxLogLevelType] -> ShowS)
-> Show FirefoxLogLevelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirefoxLogLevelType -> ShowS
showsPrec :: Int -> FirefoxLogLevelType -> ShowS
$cshow :: FirefoxLogLevelType -> String
show :: FirefoxLogLevelType -> String
$cshowList :: [FirefoxLogLevelType] -> ShowS
showList :: [FirefoxLogLevelType] -> ShowS
Show, FirefoxLogLevelType -> FirefoxLogLevelType -> Bool
(FirefoxLogLevelType -> FirefoxLogLevelType -> Bool)
-> (FirefoxLogLevelType -> FirefoxLogLevelType -> Bool)
-> Eq FirefoxLogLevelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FirefoxLogLevelType -> FirefoxLogLevelType -> Bool
== :: FirefoxLogLevelType -> FirefoxLogLevelType -> Bool
$c/= :: FirefoxLogLevelType -> FirefoxLogLevelType -> Bool
/= :: FirefoxLogLevelType -> FirefoxLogLevelType -> Bool
Eq)
deriveJSON toCamelC4 ''FirefoxLogLevelType
makeLenses ''FirefoxLogLevelType

data FirefoxLogLevel = FirefoxLogLevel {
  FirefoxLogLevel -> FirefoxLogLevelType
_firefoxLogLevelLevel :: FirefoxLogLevelType
  }
  deriving (Int -> FirefoxLogLevel -> ShowS
[FirefoxLogLevel] -> ShowS
FirefoxLogLevel -> String
(Int -> FirefoxLogLevel -> ShowS)
-> (FirefoxLogLevel -> String)
-> ([FirefoxLogLevel] -> ShowS)
-> Show FirefoxLogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirefoxLogLevel -> ShowS
showsPrec :: Int -> FirefoxLogLevel -> ShowS
$cshow :: FirefoxLogLevel -> String
show :: FirefoxLogLevel -> String
$cshowList :: [FirefoxLogLevel] -> ShowS
showList :: [FirefoxLogLevel] -> ShowS
Show, FirefoxLogLevel -> FirefoxLogLevel -> Bool
(FirefoxLogLevel -> FirefoxLogLevel -> Bool)
-> (FirefoxLogLevel -> FirefoxLogLevel -> Bool)
-> Eq FirefoxLogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FirefoxLogLevel -> FirefoxLogLevel -> Bool
== :: FirefoxLogLevel -> FirefoxLogLevel -> Bool
$c/= :: FirefoxLogLevel -> FirefoxLogLevel -> Bool
/= :: FirefoxLogLevel -> FirefoxLogLevel -> Bool
Eq)
deriveJSON toCamel3 ''FirefoxLogLevel
makeLenses ''FirefoxLogLevel

-- | See https://developer.mozilla.org/en-US/docs/Web/WebDriver/Capabilities/firefoxOptions
data FirefoxOptions = FirefoxOptions {
  -- | Absolute path to the custom Firefox binary to use.
  -- On macOS you may either give the path to the application bundle, i.e. @\/Applications\/Firefox.app@, or the absolute
  -- path to the executable binary inside this bundle, for example
  -- @\/Applications\/Firefox.app\/Contents\/MacOS\/firefox-bin@. geckodriver will attempt to deduce the default location of
  -- Firefox on the current system if left undefined.
  FirefoxOptions -> Maybe String
_firefoxOptionsBinary :: Maybe String
  -- | Command line arguments to pass to the Firefox binary.
  -- These must include the leading dash (-) where required, e.g. ["-headless"].
  -- To have geckodriver pick up an existing profile on the local filesystem, you may pass @["-profile", -- "\/path\/to\/profile"]@.
  -- But if a profile has to be transferred to a target machine it is recommended to use the profile entry.
  , FirefoxOptions -> Maybe [String]
_firefoxOptionsArgs :: Maybe [String]
  -- | Base64-encoded ZIP of a profile directory to use for the Firefox instance. This may be used to e.g. install
  -- extensions or custom certificates, but for setting custom preferences we recommend using the prefs entry instead.
  , FirefoxOptions -> Maybe (Profile Firefox)
_firefoxOptionsProfile :: Maybe (Profile Firefox)
  -- | To increase the logging verbosity of geckodriver and Firefox, you may pass a log object that may look like
  -- {"log": {"level": "trace"}} to include all trace-level logs and above.
  , FirefoxOptions -> Maybe FirefoxLogLevel
_firefoxOptionsLog :: Maybe FirefoxLogLevel
  -- | Map of preference name to preference value, which can be a string, a boolean or an integer.
  , FirefoxOptions -> Maybe Object
_firefoxOptionsPrefs :: Maybe A.Object

  -- TODO: Android options
  }
  deriving (Int -> FirefoxOptions -> ShowS
[FirefoxOptions] -> ShowS
FirefoxOptions -> String
(Int -> FirefoxOptions -> ShowS)
-> (FirefoxOptions -> String)
-> ([FirefoxOptions] -> ShowS)
-> Show FirefoxOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirefoxOptions -> ShowS
showsPrec :: Int -> FirefoxOptions -> ShowS
$cshow :: FirefoxOptions -> String
show :: FirefoxOptions -> String
$cshowList :: [FirefoxOptions] -> ShowS
showList :: [FirefoxOptions] -> ShowS
Show, FirefoxOptions -> FirefoxOptions -> Bool
(FirefoxOptions -> FirefoxOptions -> Bool)
-> (FirefoxOptions -> FirefoxOptions -> Bool) -> Eq FirefoxOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FirefoxOptions -> FirefoxOptions -> Bool
== :: FirefoxOptions -> FirefoxOptions -> Bool
$c/= :: FirefoxOptions -> FirefoxOptions -> Bool
/= :: FirefoxOptions -> FirefoxOptions -> Bool
Eq)
deriveJSON toCamel2 ''FirefoxOptions
makeLenses ''FirefoxOptions

emptyFirefoxOptions :: FirefoxOptions
emptyFirefoxOptions :: FirefoxOptions
emptyFirefoxOptions = FirefoxOptions {
  _firefoxOptionsBinary :: Maybe String
_firefoxOptionsBinary = Maybe String
forall a. Maybe a
Nothing
  , _firefoxOptionsArgs :: Maybe [String]
_firefoxOptionsArgs = Maybe [String]
forall a. Maybe a
Nothing
  , _firefoxOptionsProfile :: Maybe (Profile Firefox)
_firefoxOptionsProfile = Maybe (Profile Firefox)
forall a. Maybe a
Nothing
  , _firefoxOptionsLog :: Maybe FirefoxLogLevel
_firefoxOptionsLog = Maybe FirefoxLogLevel
forall a. Maybe a
Nothing
  , _firefoxOptionsPrefs :: Maybe Object
_firefoxOptionsPrefs = Maybe Object
forall a. Maybe a
Nothing
  }

-- | Empty 'FirefoxOptions'.
defaultFirefoxOptions :: FirefoxOptions
defaultFirefoxOptions :: FirefoxOptions
defaultFirefoxOptions = FirefoxOptions
emptyFirefoxOptions