{- |
Module      : Web.Api.WebDriver.Types
Description : Typed arguments for WebDriver endpoints.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

The WebDriver protocol involves passing several different kinds of JSON objects. We can encode these as /types/ to make our DSL more robust; this module is a grab bag of these types. For each one we need `ToJSON` and `FromJSON` instances, and sometimes also a default value.

Note that while the WebDriver spec defines some JSON objects, in general a given WebDriver server can accept additional properties on any given object. Our types here will be limited to the "spec" object signatures, but our API will need to be user extensible.
-}

{-# LANGUAGE OverloadedStrings, RecordWildCards, BangPatterns, CPP #-}
module Web.Api.WebDriver.Types (
  -- * Stringy Types
    SessionId
  , ElementRef(..)
  , ContextId(..)
  , ContextType(..)
  , Selector
  , AttributeName
  , PropertyName
  , AriaRole
  , AriaLabel
  , Script
  , CookieName
  , CssPropertyName

  , FrameReference(..)

  -- * Capabilities
  , Capabilities(..)
  , BrowserName(..)
  , PlatformName(..)
  , emptyCapabilities
  , defaultFirefoxCapabilities
  , headlessFirefoxCapabilities
  , defaultChromeCapabilities
  , LogLevel(..)
  , FirefoxOptions(..)
  , FirefoxLog(..)
  , defaultFirefoxOptions
  , ChromeOptions(..)
  , defaultChromeOptions

  -- * Proxy
  , ProxyConfig(..)
  , emptyProxyConfig
  , ProxyType(..)
  , HostAndOptionalPort(..)

  -- * Timeout
  , TimeoutConfig(..)
  , emptyTimeoutConfig

  -- * Input and Actions
  , InputSource(..)
  , PointerSubtype(..)
  , InputSourceParameter(..)
  , Action(..)
  , emptyAction
  , ActionType(..)
  , ActionItem(..)
  , emptyActionItem

  -- * Print
  , PrintOptions(..)
  , defaultPrintOptions
  , Orientation(..)
  , Scale(..)
  , Page(..)
  , defaultPage
  , Margin(..)
  , defaultMargin
  , PageRange(..)
  , Base64EncodedPdf(..)
  , decodeBase64EncodedPdf
  , writeBase64EncodedPdf

  -- * Misc
  , LocationStrategy(..)
  , Rect(..)
  , emptyRect
  , PromptHandler(..)
  , Cookie(..)
  , cookie
  , emptyCookie

  -- * Error Responses
  , ResponseErrorCode(..)
  ) where

#if MIN_VERSION_base(4,9,0)
import Prelude hiding (fail)
#endif

import Control.Monad.IO.Class
import qualified Data.ByteString as SB
import qualified Data.ByteString.Base64 as B64
import Data.Maybe
  ( catMaybes )
import Data.Scientific
  ( Scientific, scientific )
import Data.String
  ( IsString(..) )
import Data.HashMap.Strict
  ( HashMap, fromList )
import Data.Aeson.Types
  ( ToJSON(..), FromJSON(..), Value(..), KeyValue
  , Pair, (.:?), (.:), (.=), object, typeMismatch )
import Data.Text
  ( Text, pack, unpack )
import qualified Data.Text as T
import Data.Text.Encoding
  ( encodeUtf8 )
import Test.QuickCheck
  ( Arbitrary(..), arbitraryBoundedEnum, Gen, NonNegative(..) )
import Test.QuickCheck.Gen
  ( listOf, oneof, elements )
import Text.Read
  ( readMaybe )

-- Transitional MonadFail implementation
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail
#endif

-- aeson 2.0.0.0 introduced KeyMap over HashMap
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromText)
#endif

import Web.Api.WebDriver.Uri



unrecognizedValue :: (MonadFail m) => Text -> Text -> m a
unrecognizedValue :: Text -> Text -> m a
unrecognizedValue !Text
name !Text
string = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
  Text
"Unrecognized value for type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
string

malformedValue :: (MonadFail m) => Text -> Text -> m a
malformedValue :: Text -> Text -> m a
malformedValue !Text
name !Text
value = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
  Text
"Malformed value for type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value



object_ :: [Maybe Pair] -> Value
object_ :: [Maybe Pair] -> Value
object_ = [Pair] -> Value
object ([Pair] -> Value)
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Key
_, Value
v) -> Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) ([Pair] -> [Pair])
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes

(.==) :: (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv
.== :: Text -> v -> Maybe kv
(.==) Text
key v
value =
#if MIN_VERSION_aeson(2,0,0)
  kv -> Maybe kv
forall a. a -> Maybe a
Just ((Text -> Key
fromText Text
key) Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
value) --    val = lookup (fromText key) obj
#else
  Just (key .= value)
#endif

(.=?) :: (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? :: Text -> Maybe v -> Maybe kv
(.=?) Text
key =
#if MIN_VERSION_aeson(2,0,0)
  (v -> kv) -> Maybe v -> Maybe kv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Key
fromText Text
key) Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
#else
  fmap (key .=)
#endif



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-session-id>.
type SessionId = Text

-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-web-element-reference>.
newtype ElementRef = ElementRef
  { ElementRef -> Text
theElementRef :: Text
  } deriving ElementRef -> ElementRef -> Bool
(ElementRef -> ElementRef -> Bool)
-> (ElementRef -> ElementRef -> Bool) -> Eq ElementRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementRef -> ElementRef -> Bool
$c/= :: ElementRef -> ElementRef -> Bool
== :: ElementRef -> ElementRef -> Bool
$c== :: ElementRef -> ElementRef -> Bool
Eq

instance Show ElementRef where
  show :: ElementRef -> String
show (ElementRef Text
str) = Text -> String
unpack Text
str

instance IsString ElementRef where
  fromString :: String -> ElementRef
fromString = Text -> ElementRef
ElementRef (Text -> ElementRef) -> (String -> Text) -> String -> ElementRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

-- | Identifier for a /browsing context/; see <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-current-browsing-context>.
newtype ContextId = ContextId
  { ContextId -> Text
theContextId :: Text
  } deriving ContextId -> ContextId -> Bool
(ContextId -> ContextId -> Bool)
-> (ContextId -> ContextId -> Bool) -> Eq ContextId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextId -> ContextId -> Bool
$c/= :: ContextId -> ContextId -> Bool
== :: ContextId -> ContextId -> Bool
$c== :: ContextId -> ContextId -> Bool
Eq

instance Show ContextId where
  show :: ContextId -> String
show (ContextId Text
str) = Text -> String
unpack Text
str

instance IsString ContextId where
  fromString :: String -> ContextId
fromString = Text -> ContextId
ContextId (Text -> ContextId) -> (String -> Text) -> String -> ContextId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance FromJSON ContextId where
  parseJSON :: Value -> Parser ContextId
parseJSON (String Text
x) = ContextId -> Parser ContextId
forall (m :: * -> *) a. Monad m => a -> m a
return (ContextId -> Parser ContextId) -> ContextId -> Parser ContextId
forall a b. (a -> b) -> a -> b
$ Text -> ContextId
ContextId Text
x
  parseJSON Value
invalid = String -> Value -> Parser ContextId
forall a. String -> Value -> Parser a
typeMismatch String
"ContextType" Value
invalid

instance ToJSON ContextId where
  toJSON :: ContextId -> Value
toJSON (ContextId Text
x) = Text -> Value
String Text
x

instance Arbitrary ContextId where
  arbitrary :: Gen ContextId
arbitrary = (Text -> ContextId
ContextId (Text -> ContextId) -> (String -> Text) -> String -> ContextId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (String -> ContextId) -> Gen String -> Gen ContextId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

-- | Type of a /top level browsing context/; see <https://html.spec.whatwg.org/#top-level-browsing-context>.
data ContextType = WindowContext | TabContext
  deriving (ContextType -> ContextType -> Bool
(ContextType -> ContextType -> Bool)
-> (ContextType -> ContextType -> Bool) -> Eq ContextType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextType -> ContextType -> Bool
$c/= :: ContextType -> ContextType -> Bool
== :: ContextType -> ContextType -> Bool
$c== :: ContextType -> ContextType -> Bool
Eq, Int -> ContextType
ContextType -> Int
ContextType -> [ContextType]
ContextType -> ContextType
ContextType -> ContextType -> [ContextType]
ContextType -> ContextType -> ContextType -> [ContextType]
(ContextType -> ContextType)
-> (ContextType -> ContextType)
-> (Int -> ContextType)
-> (ContextType -> Int)
-> (ContextType -> [ContextType])
-> (ContextType -> ContextType -> [ContextType])
-> (ContextType -> ContextType -> [ContextType])
-> (ContextType -> ContextType -> ContextType -> [ContextType])
-> Enum ContextType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ContextType -> ContextType -> ContextType -> [ContextType]
$cenumFromThenTo :: ContextType -> ContextType -> ContextType -> [ContextType]
enumFromTo :: ContextType -> ContextType -> [ContextType]
$cenumFromTo :: ContextType -> ContextType -> [ContextType]
enumFromThen :: ContextType -> ContextType -> [ContextType]
$cenumFromThen :: ContextType -> ContextType -> [ContextType]
enumFrom :: ContextType -> [ContextType]
$cenumFrom :: ContextType -> [ContextType]
fromEnum :: ContextType -> Int
$cfromEnum :: ContextType -> Int
toEnum :: Int -> ContextType
$ctoEnum :: Int -> ContextType
pred :: ContextType -> ContextType
$cpred :: ContextType -> ContextType
succ :: ContextType -> ContextType
$csucc :: ContextType -> ContextType
Enum, ContextType
ContextType -> ContextType -> Bounded ContextType
forall a. a -> a -> Bounded a
maxBound :: ContextType
$cmaxBound :: ContextType
minBound :: ContextType
$cminBound :: ContextType
Bounded)

instance Show ContextType where
  show :: ContextType -> String
show ContextType
t = case ContextType
t of
    ContextType
WindowContext -> String
"window"
    ContextType
TabContext -> String
"tab"

instance FromJSON ContextType where
  parseJSON :: Value -> Parser ContextType
parseJSON (String Text
x) = case Text
x of
    Text
"window" -> ContextType -> Parser ContextType
forall (m :: * -> *) a. Monad m => a -> m a
return ContextType
WindowContext
    Text
"tab" -> ContextType -> Parser ContextType
forall (m :: * -> *) a. Monad m => a -> m a
return ContextType
TabContext
    Text
_ -> Text -> Text -> Parser ContextType
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"ContextType" Text
x
  parseJSON Value
invalid = String -> Value -> Parser ContextType
forall a. String -> Value -> Parser a
typeMismatch String
"ContextType" Value
invalid

instance ToJSON ContextType where
  toJSON :: ContextType -> Value
toJSON ContextType
WindowContext = Text -> Value
String Text
"window"
  toJSON ContextType
TabContext = Text -> Value
String Text
"tab"

instance Arbitrary ContextType where
  arbitrary :: Gen ContextType
arbitrary = Gen ContextType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

-- | For use with a /Locator Strategy/. See <https://w3c.github.io/webdriver/webdriver-spec.html#locator-strategies>.
type Selector = Text

-- | Used with `getElementAttribute`.
type AttributeName = Text

-- | Used with `getElementProperty`.
type PropertyName = Text

-- | Used with `getComputedRole`
type AriaRole = Text

-- | Used with `getComputedLabel`
type AriaLabel = Text

-- | Javascript
type Script = Text

-- | Used with `getNamedCookie`.
type CookieName = Text

-- | Used with `getElementCssValue`.
type CssPropertyName = Text

-- | Possible frame references; see <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-frame>.
data FrameReference
  = TopLevelFrame
  | FrameNumber Int
  | FrameContainingElement ElementRef
  deriving (FrameReference -> FrameReference -> Bool
(FrameReference -> FrameReference -> Bool)
-> (FrameReference -> FrameReference -> Bool) -> Eq FrameReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameReference -> FrameReference -> Bool
$c/= :: FrameReference -> FrameReference -> Bool
== :: FrameReference -> FrameReference -> Bool
$c== :: FrameReference -> FrameReference -> Bool
Eq, Int -> FrameReference -> ShowS
[FrameReference] -> ShowS
FrameReference -> String
(Int -> FrameReference -> ShowS)
-> (FrameReference -> String)
-> ([FrameReference] -> ShowS)
-> Show FrameReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameReference] -> ShowS
$cshowList :: [FrameReference] -> ShowS
show :: FrameReference -> String
$cshow :: FrameReference -> String
showsPrec :: Int -> FrameReference -> ShowS
$cshowsPrec :: Int -> FrameReference -> ShowS
Show)



-- | Semantic HTTP error responses. See <https://w3c.github.io/webdriver/webdriver-spec.html#locator-strategies>.
data ResponseErrorCode
  = ElementClickIntercepted
  | ElementNotSelectable
  | ElementNotInteractable
  | InsecureCertificate
  | InvalidArgument
  | InvalidCookieDomain
  | InvalidCoordinates
  | InvalidElementState
  | InvalidSelector
  | InvalidSessionId
  | JavaScriptError
  | MoveTargetOutOfBounds
  | NoSuchAlert
  | NoSuchCookie
  | NoSuchElement
  | NoSuchFrame
  | NoSuchWindow
  | ScriptTimeout
  | SessionNotCreated
  | StaleElementReference
  | Timeout
  | UnableToSetCookie
  | UnableToCaptureScreen
  | UnexpectedAlertOpen
  | UnknownCommand
  | UnknownError
  | UnknownMethod
  | UnsupportedOperation

  -- | Just in case!
  | UnhandledErrorCode Text
  deriving (ResponseErrorCode -> ResponseErrorCode -> Bool
(ResponseErrorCode -> ResponseErrorCode -> Bool)
-> (ResponseErrorCode -> ResponseErrorCode -> Bool)
-> Eq ResponseErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseErrorCode -> ResponseErrorCode -> Bool
$c/= :: ResponseErrorCode -> ResponseErrorCode -> Bool
== :: ResponseErrorCode -> ResponseErrorCode -> Bool
$c== :: ResponseErrorCode -> ResponseErrorCode -> Bool
Eq, Int -> ResponseErrorCode -> ShowS
[ResponseErrorCode] -> ShowS
ResponseErrorCode -> String
(Int -> ResponseErrorCode -> ShowS)
-> (ResponseErrorCode -> String)
-> ([ResponseErrorCode] -> ShowS)
-> Show ResponseErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseErrorCode] -> ShowS
$cshowList :: [ResponseErrorCode] -> ShowS
show :: ResponseErrorCode -> String
$cshow :: ResponseErrorCode -> String
showsPrec :: Int -> ResponseErrorCode -> ShowS
$cshowsPrec :: Int -> ResponseErrorCode -> ShowS
Show)

instance FromJSON ResponseErrorCode where
  parseJSON :: Value -> Parser ResponseErrorCode
parseJSON (String Text
x) = case Text
x of
    Text
"element click intercepted" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
ElementClickIntercepted
    Text
"element not selectable" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
ElementNotSelectable
    Text
"element not interactable" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
ElementNotInteractable
    Text
"insecure certificate" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InsecureCertificate
    Text
"invalid argument" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InvalidArgument
    Text
"invalid cookie domain" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InvalidCookieDomain
    Text
"invalid coordinates" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InvalidCoordinates
    Text
"invalid element state" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InvalidElementState
    Text
"invalid selector" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InvalidSelector
    Text
"invalid session id" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
InvalidSessionId
    Text
"javascript error" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
JavaScriptError
    Text
"move target out of bounds" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
MoveTargetOutOfBounds
    Text
"no such alert" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
NoSuchAlert
    Text
"no such cookie" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
NoSuchCookie
    Text
"no such element" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
NoSuchElement
    Text
"no such frame" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
NoSuchFrame
    Text
"no such window" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
NoSuchWindow
    Text
"script timeout" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
ScriptTimeout
    Text
"session not created" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
SessionNotCreated
    Text
"stale element reference" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
StaleElementReference
    Text
"timeout" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
Timeout
    Text
"unable to set cookie" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnableToSetCookie
    Text
"unable to capture screen" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnableToCaptureScreen
    Text
"unexpected alert open" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnexpectedAlertOpen
    Text
"unknown command" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnknownCommand
    Text
"unknown error" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnknownError
    Text
"unknown method" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnknownMethod
    Text
"unsupported operation" -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
UnsupportedOperation
    Text
text -> ResponseErrorCode -> Parser ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ResponseErrorCode -> Parser ResponseErrorCode)
-> ResponseErrorCode -> Parser ResponseErrorCode
forall a b. (a -> b) -> a -> b
$ Text -> ResponseErrorCode
UnhandledErrorCode Text
text
  parseJSON Value
invalid = String -> Value -> Parser ResponseErrorCode
forall a. String -> Value -> Parser a
typeMismatch String
"ResponseErrorCode" Value
invalid

instance ToJSON ResponseErrorCode where
  toJSON :: ResponseErrorCode -> Value
toJSON ResponseErrorCode
x = case ResponseErrorCode
x of
    ResponseErrorCode
ElementClickIntercepted -> Text -> Value
String Text
"element click intercepted"
    ResponseErrorCode
ElementNotSelectable -> Text -> Value
String Text
"element not selectable"
    ResponseErrorCode
ElementNotInteractable -> Text -> Value
String Text
"element not interactable"
    ResponseErrorCode
InsecureCertificate -> Text -> Value
String Text
"insecure certificate"
    ResponseErrorCode
InvalidArgument -> Text -> Value
String Text
"invalid argument"
    ResponseErrorCode
InvalidCookieDomain -> Text -> Value
String Text
"invalid cookie domain"
    ResponseErrorCode
InvalidCoordinates -> Text -> Value
String Text
"invalid coordinates"
    ResponseErrorCode
InvalidElementState -> Text -> Value
String Text
"invalid element state"
    ResponseErrorCode
InvalidSelector -> Text -> Value
String Text
"invalid selector"
    ResponseErrorCode
InvalidSessionId -> Text -> Value
String Text
"invalid session id"
    ResponseErrorCode
JavaScriptError -> Text -> Value
String Text
"javascript error"
    ResponseErrorCode
MoveTargetOutOfBounds -> Text -> Value
String Text
"move target out of bounds"
    ResponseErrorCode
NoSuchAlert -> Text -> Value
String Text
"no such alert"
    ResponseErrorCode
NoSuchCookie -> Text -> Value
String Text
"no such cookie"
    ResponseErrorCode
NoSuchElement -> Text -> Value
String Text
"no such element"
    ResponseErrorCode
NoSuchFrame -> Text -> Value
String Text
"no such frame"
    ResponseErrorCode
NoSuchWindow -> Text -> Value
String Text
"no such window"
    ResponseErrorCode
ScriptTimeout -> Text -> Value
String Text
"script timeout"
    ResponseErrorCode
SessionNotCreated -> Text -> Value
String Text
"session not created"
    ResponseErrorCode
StaleElementReference -> Text -> Value
String Text
"stale element reference"
    ResponseErrorCode
Timeout -> Text -> Value
String Text
"timeout"
    ResponseErrorCode
UnableToSetCookie -> Text -> Value
String Text
"unable to set cookie"
    ResponseErrorCode
UnableToCaptureScreen -> Text -> Value
String Text
"unable to capture screen"
    ResponseErrorCode
UnexpectedAlertOpen -> Text -> Value
String Text
"unexpected alert open"
    ResponseErrorCode
UnknownCommand -> Text -> Value
String Text
"unknown command"
    ResponseErrorCode
UnknownError -> Text -> Value
String Text
"unknown error"
    ResponseErrorCode
UnknownMethod -> Text -> Value
String Text
"unknown method"
    ResponseErrorCode
UnsupportedOperation -> Text -> Value
String Text
"unsupported operation"
    UnhandledErrorCode Text
msg -> Text -> Value
String Text
msg

instance Arbitrary ResponseErrorCode where
  arbitrary :: Gen ResponseErrorCode
arbitrary = [Gen ResponseErrorCode] -> Gen ResponseErrorCode
forall a. [Gen a] -> Gen a
oneof ([Gen ResponseErrorCode] -> Gen ResponseErrorCode)
-> [Gen ResponseErrorCode] -> Gen ResponseErrorCode
forall a b. (a -> b) -> a -> b
$ (ResponseErrorCode -> Gen ResponseErrorCode)
-> [ResponseErrorCode] -> [Gen ResponseErrorCode]
forall a b. (a -> b) -> [a] -> [b]
map ResponseErrorCode -> Gen ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ ResponseErrorCode
ElementClickIntercepted
    , ResponseErrorCode
ElementNotSelectable
    , ResponseErrorCode
ElementNotInteractable
    , ResponseErrorCode
InsecureCertificate
    , ResponseErrorCode
InvalidArgument
    , ResponseErrorCode
InvalidCookieDomain
    , ResponseErrorCode
InvalidCoordinates
    , ResponseErrorCode
InvalidElementState
    , ResponseErrorCode
InvalidSelector
    , ResponseErrorCode
InvalidSessionId
    , ResponseErrorCode
JavaScriptError
    , ResponseErrorCode
MoveTargetOutOfBounds
    , ResponseErrorCode
NoSuchAlert
    , ResponseErrorCode
NoSuchCookie
    , ResponseErrorCode
NoSuchElement
    , ResponseErrorCode
NoSuchFrame
    , ResponseErrorCode
NoSuchWindow
    , ResponseErrorCode
ScriptTimeout
    , ResponseErrorCode
SessionNotCreated
    , ResponseErrorCode
StaleElementReference
    , ResponseErrorCode
Timeout
    , ResponseErrorCode
UnableToSetCookie
    , ResponseErrorCode
UnableToCaptureScreen
    , ResponseErrorCode
UnexpectedAlertOpen
    , ResponseErrorCode
UnknownCommand
    , ResponseErrorCode
UnknownError
    , ResponseErrorCode
UnknownMethod
    , ResponseErrorCode
UnsupportedOperation
    ]



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#capabilities>.
data Capabilities = Capabilities
  { Capabilities -> Maybe BrowserName
_browserName :: Maybe BrowserName -- ^ @browserName@
  , Capabilities -> Maybe Text
_browserVersion :: Maybe Text -- ^ @browserVersion@
  , Capabilities -> Maybe PlatformName
_platformName :: Maybe PlatformName -- ^ @platformName@
  , Capabilities -> Maybe Bool
_acceptInsecureCerts :: Maybe Bool -- ^ @acceptInsecureCerts@
  , Capabilities -> Maybe Text
_pageLoadStrategy :: Maybe Text -- ^ @pageLoadStrategy@
  , Capabilities -> Maybe ProxyConfig
_proxy :: Maybe ProxyConfig -- ^ @proxy@
  , Capabilities -> Maybe Bool
_setWindowRect :: Maybe Bool -- ^ @setWindowRect@
  , Capabilities -> Maybe TimeoutConfig
_timeouts :: Maybe TimeoutConfig -- ^ @timeouts@
  , Capabilities -> Maybe PromptHandler
_unhandledPromptBehavior :: Maybe PromptHandler -- ^ @unhandledPromptBehavior@

  -- | Optional extension, but very common.
  , Capabilities -> Maybe ChromeOptions
_chromeOptions :: Maybe ChromeOptions -- ^ @chromeOptions@

  -- | Optional extension, but very common.
  , Capabilities -> Maybe FirefoxOptions
_firefoxOptions :: Maybe FirefoxOptions -- ^ @moz:firefoxOptions@
  } deriving (Capabilities -> Capabilities -> Bool
(Capabilities -> Capabilities -> Bool)
-> (Capabilities -> Capabilities -> Bool) -> Eq Capabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capabilities -> Capabilities -> Bool
$c/= :: Capabilities -> Capabilities -> Bool
== :: Capabilities -> Capabilities -> Bool
$c== :: Capabilities -> Capabilities -> Bool
Eq, Int -> Capabilities -> ShowS
[Capabilities] -> ShowS
Capabilities -> String
(Int -> Capabilities -> ShowS)
-> (Capabilities -> String)
-> ([Capabilities] -> ShowS)
-> Show Capabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Capabilities] -> ShowS
$cshowList :: [Capabilities] -> ShowS
show :: Capabilities -> String
$cshow :: Capabilities -> String
showsPrec :: Int -> Capabilities -> ShowS
$cshowsPrec :: Int -> Capabilities -> ShowS
Show)

instance FromJSON Capabilities where
  parseJSON :: Value -> Parser Capabilities
parseJSON (Object Object
v) = Maybe BrowserName
-> Maybe Text
-> Maybe PlatformName
-> Maybe Bool
-> Maybe Text
-> Maybe ProxyConfig
-> Maybe Bool
-> Maybe TimeoutConfig
-> Maybe PromptHandler
-> Maybe ChromeOptions
-> Maybe FirefoxOptions
-> Capabilities
Capabilities
    (Maybe BrowserName
 -> Maybe Text
 -> Maybe PlatformName
 -> Maybe Bool
 -> Maybe Text
 -> Maybe ProxyConfig
 -> Maybe Bool
 -> Maybe TimeoutConfig
 -> Maybe PromptHandler
 -> Maybe ChromeOptions
 -> Maybe FirefoxOptions
 -> Capabilities)
-> Parser (Maybe BrowserName)
-> Parser
     (Maybe Text
      -> Maybe PlatformName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe BrowserName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"browserName"
    Parser
  (Maybe Text
   -> Maybe PlatformName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe Text)
-> Parser
     (Maybe PlatformName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"browserVersion"
    Parser
  (Maybe PlatformName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe PlatformName)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe PlatformName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"platformName"
    Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"acceptInsecureCerts"
    Parser
  (Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe Text)
-> Parser
     (Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pageLoadStrategy"
    Parser
  (Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe ProxyConfig)
-> Parser
     (Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe ProxyConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"proxy"
    Parser
  (Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe Bool)
-> Parser
     (Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"setWindowRect"
    Parser
  (Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Parser (Maybe TimeoutConfig)
-> Parser
     (Maybe PromptHandler
      -> Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe TimeoutConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timeouts"
    Parser
  (Maybe PromptHandler
   -> Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
-> Parser (Maybe PromptHandler)
-> Parser
     (Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe PromptHandler)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unhandledPromptBehavior"
    Parser
  (Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
-> Parser (Maybe ChromeOptions)
-> Parser (Maybe FirefoxOptions -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe ChromeOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"goog:chromeOptions"
    Parser (Maybe FirefoxOptions -> Capabilities)
-> Parser (Maybe FirefoxOptions) -> Parser Capabilities
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe FirefoxOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"moz:firefoxOptions"
  parseJSON Value
invalid = String -> Value -> Parser Capabilities
forall a. String -> Value -> Parser a
typeMismatch String
"Capabilities" Value
invalid

instance ToJSON Capabilities where
  toJSON :: Capabilities -> Value
toJSON Capabilities{Maybe Bool
Maybe Text
Maybe PromptHandler
Maybe TimeoutConfig
Maybe ProxyConfig
Maybe FirefoxOptions
Maybe ChromeOptions
Maybe PlatformName
Maybe BrowserName
_firefoxOptions :: Maybe FirefoxOptions
_chromeOptions :: Maybe ChromeOptions
_unhandledPromptBehavior :: Maybe PromptHandler
_timeouts :: Maybe TimeoutConfig
_setWindowRect :: Maybe Bool
_proxy :: Maybe ProxyConfig
_pageLoadStrategy :: Maybe Text
_acceptInsecureCerts :: Maybe Bool
_platformName :: Maybe PlatformName
_browserVersion :: Maybe Text
_browserName :: Maybe BrowserName
_firefoxOptions :: Capabilities -> Maybe FirefoxOptions
_chromeOptions :: Capabilities -> Maybe ChromeOptions
_unhandledPromptBehavior :: Capabilities -> Maybe PromptHandler
_timeouts :: Capabilities -> Maybe TimeoutConfig
_setWindowRect :: Capabilities -> Maybe Bool
_proxy :: Capabilities -> Maybe ProxyConfig
_pageLoadStrategy :: Capabilities -> Maybe Text
_acceptInsecureCerts :: Capabilities -> Maybe Bool
_platformName :: Capabilities -> Maybe PlatformName
_browserVersion :: Capabilities -> Maybe Text
_browserName :: Capabilities -> Maybe BrowserName
..} = [Maybe Pair] -> Value
object_
    [ Text
"browserName" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (BrowserName -> Value
forall a. ToJSON a => a -> Value
toJSON (BrowserName -> Value) -> Maybe BrowserName -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BrowserName
_browserName)
    , Text
"browserVersion" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_browserVersion)
    , Text
"platformName" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (PlatformName -> Value
forall a. ToJSON a => a -> Value
toJSON (PlatformName -> Value) -> Maybe PlatformName -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PlatformName
_platformName)
    , Text
"acceptInsecureCerts" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_acceptInsecureCerts)
    , Text
"pageLoadStrategy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_pageLoadStrategy)
    , Text
"proxy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (ProxyConfig -> Value
forall a. ToJSON a => a -> Value
toJSON (ProxyConfig -> Value) -> Maybe ProxyConfig -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ProxyConfig
_proxy)
    , Text
"setWindowRect" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_setWindowRect)
    , Text
"timeouts" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (TimeoutConfig -> Value
forall a. ToJSON a => a -> Value
toJSON (TimeoutConfig -> Value) -> Maybe TimeoutConfig -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TimeoutConfig
_timeouts)
    , Text
"unhandledPromptBehavior" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (PromptHandler -> Value
forall a. ToJSON a => a -> Value
toJSON (PromptHandler -> Value) -> Maybe PromptHandler -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PromptHandler
_unhandledPromptBehavior)
    , Text
"goog:chromeOptions" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (ChromeOptions -> Value
forall a. ToJSON a => a -> Value
toJSON (ChromeOptions -> Value) -> Maybe ChromeOptions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChromeOptions
_chromeOptions)
    , Text
"moz:firefoxOptions" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (FirefoxOptions -> Value
forall a. ToJSON a => a -> Value
toJSON (FirefoxOptions -> Value) -> Maybe FirefoxOptions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FirefoxOptions
_firefoxOptions)
    ]

instance Arbitrary Capabilities where
  arbitrary :: Gen Capabilities
arbitrary = Maybe BrowserName
-> Maybe Text
-> Maybe PlatformName
-> Maybe Bool
-> Maybe Text
-> Maybe ProxyConfig
-> Maybe Bool
-> Maybe TimeoutConfig
-> Maybe PromptHandler
-> Maybe ChromeOptions
-> Maybe FirefoxOptions
-> Capabilities
Capabilities
    (Maybe BrowserName
 -> Maybe Text
 -> Maybe PlatformName
 -> Maybe Bool
 -> Maybe Text
 -> Maybe ProxyConfig
 -> Maybe Bool
 -> Maybe TimeoutConfig
 -> Maybe PromptHandler
 -> Maybe ChromeOptions
 -> Maybe FirefoxOptions
 -> Capabilities)
-> Gen (Maybe BrowserName)
-> Gen
     (Maybe Text
      -> Maybe PlatformName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe BrowserName)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Text
   -> Maybe PlatformName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe Text)
-> Gen
     (Maybe PlatformName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe PlatformName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe PlatformName)
-> Gen
     (Maybe Bool
      -> Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe PlatformName)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Bool
   -> Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe Bool)
-> Gen
     (Maybe Text
      -> Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Bool)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Text
   -> Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe Text)
-> Gen
     (Maybe ProxyConfig
      -> Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe ProxyConfig
   -> Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe ProxyConfig)
-> Gen
     (Maybe Bool
      -> Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe ProxyConfig)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Bool
   -> Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe Bool)
-> Gen
     (Maybe TimeoutConfig
      -> Maybe PromptHandler
      -> Maybe ChromeOptions
      -> Maybe FirefoxOptions
      -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Bool)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe TimeoutConfig
   -> Maybe PromptHandler
   -> Maybe ChromeOptions
   -> Maybe FirefoxOptions
   -> Capabilities)
-> Gen (Maybe TimeoutConfig)
-> Gen
     (Maybe PromptHandler
      -> Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe TimeoutConfig)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe PromptHandler
   -> Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
-> Gen (Maybe PromptHandler)
-> Gen
     (Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe PromptHandler)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe ChromeOptions -> Maybe FirefoxOptions -> Capabilities)
-> Gen (Maybe ChromeOptions)
-> Gen (Maybe FirefoxOptions -> Capabilities)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe ChromeOptions)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe FirefoxOptions -> Capabilities)
-> Gen (Maybe FirefoxOptions) -> Gen Capabilities
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe FirefoxOptions)
forall a. Arbitrary a => Gen a
arbitrary

-- | `Capabilities` with all members set to `Nothing`.
emptyCapabilities :: Capabilities
emptyCapabilities :: Capabilities
emptyCapabilities = Capabilities :: Maybe BrowserName
-> Maybe Text
-> Maybe PlatformName
-> Maybe Bool
-> Maybe Text
-> Maybe ProxyConfig
-> Maybe Bool
-> Maybe TimeoutConfig
-> Maybe PromptHandler
-> Maybe ChromeOptions
-> Maybe FirefoxOptions
-> Capabilities
Capabilities
  { _browserName :: Maybe BrowserName
_browserName = Maybe BrowserName
forall a. Maybe a
Nothing
  , _browserVersion :: Maybe Text
_browserVersion = Maybe Text
forall a. Maybe a
Nothing
  , _platformName :: Maybe PlatformName
_platformName = Maybe PlatformName
forall a. Maybe a
Nothing
  , _acceptInsecureCerts :: Maybe Bool
_acceptInsecureCerts = Maybe Bool
forall a. Maybe a
Nothing
  , _pageLoadStrategy :: Maybe Text
_pageLoadStrategy = Maybe Text
forall a. Maybe a
Nothing
  , _proxy :: Maybe ProxyConfig
_proxy = Maybe ProxyConfig
forall a. Maybe a
Nothing
  , _setWindowRect :: Maybe Bool
_setWindowRect = Maybe Bool
forall a. Maybe a
Nothing
  , _timeouts :: Maybe TimeoutConfig
_timeouts = Maybe TimeoutConfig
forall a. Maybe a
Nothing
  , _unhandledPromptBehavior :: Maybe PromptHandler
_unhandledPromptBehavior = Maybe PromptHandler
forall a. Maybe a
Nothing
  , _chromeOptions :: Maybe ChromeOptions
_chromeOptions = Maybe ChromeOptions
forall a. Maybe a
Nothing
  , _firefoxOptions :: Maybe FirefoxOptions
_firefoxOptions = Maybe FirefoxOptions
forall a. Maybe a
Nothing
  }

-- | All members set to `Nothing` except `_browserName`, which is @Just Firefox@.
defaultFirefoxCapabilities :: Capabilities
defaultFirefoxCapabilities :: Capabilities
defaultFirefoxCapabilities = Capabilities
emptyCapabilities
  { _browserName :: Maybe BrowserName
_browserName = BrowserName -> Maybe BrowserName
forall a. a -> Maybe a
Just BrowserName
Firefox
  }

-- | Passing the "-headless" parameter to Firefox.
headlessFirefoxCapabilities :: Capabilities
headlessFirefoxCapabilities :: Capabilities
headlessFirefoxCapabilities = Capabilities
defaultFirefoxCapabilities
  { _firefoxOptions :: Maybe FirefoxOptions
_firefoxOptions = FirefoxOptions -> Maybe FirefoxOptions
forall a. a -> Maybe a
Just (FirefoxOptions -> Maybe FirefoxOptions)
-> FirefoxOptions -> Maybe FirefoxOptions
forall a b. (a -> b) -> a -> b
$ FirefoxOptions
defaultFirefoxOptions
    { _firefoxArgs :: Maybe [Text]
_firefoxArgs = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"-headless"]
    }
  }

-- | All members set to `Nothing` except `_browserName`, which is @Just Chrome@.
defaultChromeCapabilities :: Capabilities
defaultChromeCapabilities :: Capabilities
defaultChromeCapabilities = Capabilities
emptyCapabilities
  { _browserName :: Maybe BrowserName
_browserName = BrowserName -> Maybe BrowserName
forall a. a -> Maybe a
Just BrowserName
Chrome
  }



-- | Used in `Capabilities`.
data BrowserName
  = Firefox
  | Chrome
  | Safari
  deriving (BrowserName -> BrowserName -> Bool
(BrowserName -> BrowserName -> Bool)
-> (BrowserName -> BrowserName -> Bool) -> Eq BrowserName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserName -> BrowserName -> Bool
$c/= :: BrowserName -> BrowserName -> Bool
== :: BrowserName -> BrowserName -> Bool
$c== :: BrowserName -> BrowserName -> Bool
Eq, Int -> BrowserName -> ShowS
[BrowserName] -> ShowS
BrowserName -> String
(Int -> BrowserName -> ShowS)
-> (BrowserName -> String)
-> ([BrowserName] -> ShowS)
-> Show BrowserName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserName] -> ShowS
$cshowList :: [BrowserName] -> ShowS
show :: BrowserName -> String
$cshow :: BrowserName -> String
showsPrec :: Int -> BrowserName -> ShowS
$cshowsPrec :: Int -> BrowserName -> ShowS
Show, Int -> BrowserName
BrowserName -> Int
BrowserName -> [BrowserName]
BrowserName -> BrowserName
BrowserName -> BrowserName -> [BrowserName]
BrowserName -> BrowserName -> BrowserName -> [BrowserName]
(BrowserName -> BrowserName)
-> (BrowserName -> BrowserName)
-> (Int -> BrowserName)
-> (BrowserName -> Int)
-> (BrowserName -> [BrowserName])
-> (BrowserName -> BrowserName -> [BrowserName])
-> (BrowserName -> BrowserName -> [BrowserName])
-> (BrowserName -> BrowserName -> BrowserName -> [BrowserName])
-> Enum BrowserName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BrowserName -> BrowserName -> BrowserName -> [BrowserName]
$cenumFromThenTo :: BrowserName -> BrowserName -> BrowserName -> [BrowserName]
enumFromTo :: BrowserName -> BrowserName -> [BrowserName]
$cenumFromTo :: BrowserName -> BrowserName -> [BrowserName]
enumFromThen :: BrowserName -> BrowserName -> [BrowserName]
$cenumFromThen :: BrowserName -> BrowserName -> [BrowserName]
enumFrom :: BrowserName -> [BrowserName]
$cenumFrom :: BrowserName -> [BrowserName]
fromEnum :: BrowserName -> Int
$cfromEnum :: BrowserName -> Int
toEnum :: Int -> BrowserName
$ctoEnum :: Int -> BrowserName
pred :: BrowserName -> BrowserName
$cpred :: BrowserName -> BrowserName
succ :: BrowserName -> BrowserName
$csucc :: BrowserName -> BrowserName
Enum, BrowserName
BrowserName -> BrowserName -> Bounded BrowserName
forall a. a -> a -> Bounded a
maxBound :: BrowserName
$cmaxBound :: BrowserName
minBound :: BrowserName
$cminBound :: BrowserName
Bounded)

instance FromJSON BrowserName where
  parseJSON :: Value -> Parser BrowserName
parseJSON (String Text
x) = case Text
x of
    Text
"firefox" -> BrowserName -> Parser BrowserName
forall (m :: * -> *) a. Monad m => a -> m a
return BrowserName
Firefox
    Text
"chrome" -> BrowserName -> Parser BrowserName
forall (m :: * -> *) a. Monad m => a -> m a
return BrowserName
Chrome
    Text
"safari" -> BrowserName -> Parser BrowserName
forall (m :: * -> *) a. Monad m => a -> m a
return BrowserName
Safari
    Text
_ -> Text -> Text -> Parser BrowserName
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"BrowserName" Text
x
  parseJSON Value
invalid = String -> Value -> Parser BrowserName
forall a. String -> Value -> Parser a
typeMismatch String
"BrowserName" Value
invalid

instance ToJSON BrowserName where
  toJSON :: BrowserName -> Value
toJSON BrowserName
Firefox = Text -> Value
String Text
"firefox"
  toJSON BrowserName
Chrome = Text -> Value
String Text
"chrome"
  toJSON BrowserName
Safari = Text -> Value
String Text
"safari"

instance Arbitrary BrowserName where
  arbitrary :: Gen BrowserName
arbitrary = Gen BrowserName
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | Used in `Capabilities`.
data PlatformName
  = Mac
  deriving (PlatformName -> PlatformName -> Bool
(PlatformName -> PlatformName -> Bool)
-> (PlatformName -> PlatformName -> Bool) -> Eq PlatformName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlatformName -> PlatformName -> Bool
$c/= :: PlatformName -> PlatformName -> Bool
== :: PlatformName -> PlatformName -> Bool
$c== :: PlatformName -> PlatformName -> Bool
Eq, Int -> PlatformName -> ShowS
[PlatformName] -> ShowS
PlatformName -> String
(Int -> PlatformName -> ShowS)
-> (PlatformName -> String)
-> ([PlatformName] -> ShowS)
-> Show PlatformName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlatformName] -> ShowS
$cshowList :: [PlatformName] -> ShowS
show :: PlatformName -> String
$cshow :: PlatformName -> String
showsPrec :: Int -> PlatformName -> ShowS
$cshowsPrec :: Int -> PlatformName -> ShowS
Show, Int -> PlatformName
PlatformName -> Int
PlatformName -> [PlatformName]
PlatformName -> PlatformName
PlatformName -> PlatformName -> [PlatformName]
PlatformName -> PlatformName -> PlatformName -> [PlatformName]
(PlatformName -> PlatformName)
-> (PlatformName -> PlatformName)
-> (Int -> PlatformName)
-> (PlatformName -> Int)
-> (PlatformName -> [PlatformName])
-> (PlatformName -> PlatformName -> [PlatformName])
-> (PlatformName -> PlatformName -> [PlatformName])
-> (PlatformName -> PlatformName -> PlatformName -> [PlatformName])
-> Enum PlatformName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PlatformName -> PlatformName -> PlatformName -> [PlatformName]
$cenumFromThenTo :: PlatformName -> PlatformName -> PlatformName -> [PlatformName]
enumFromTo :: PlatformName -> PlatformName -> [PlatformName]
$cenumFromTo :: PlatformName -> PlatformName -> [PlatformName]
enumFromThen :: PlatformName -> PlatformName -> [PlatformName]
$cenumFromThen :: PlatformName -> PlatformName -> [PlatformName]
enumFrom :: PlatformName -> [PlatformName]
$cenumFrom :: PlatformName -> [PlatformName]
fromEnum :: PlatformName -> Int
$cfromEnum :: PlatformName -> Int
toEnum :: Int -> PlatformName
$ctoEnum :: Int -> PlatformName
pred :: PlatformName -> PlatformName
$cpred :: PlatformName -> PlatformName
succ :: PlatformName -> PlatformName
$csucc :: PlatformName -> PlatformName
Enum, PlatformName
PlatformName -> PlatformName -> Bounded PlatformName
forall a. a -> a -> Bounded a
maxBound :: PlatformName
$cmaxBound :: PlatformName
minBound :: PlatformName
$cminBound :: PlatformName
Bounded)

instance FromJSON PlatformName where
  parseJSON :: Value -> Parser PlatformName
parseJSON (String Text
x) = case Text -> String
unpack Text
x of
    String
"mac" -> PlatformName -> Parser PlatformName
forall (m :: * -> *) a. Monad m => a -> m a
return PlatformName
Mac
    String
_ -> Text -> Text -> Parser PlatformName
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"PlaformName" Text
x
  parseJSON Value
invalid = String -> Value -> Parser PlatformName
forall a. String -> Value -> Parser a
typeMismatch String
"PlatformName" Value
invalid

instance ToJSON PlatformName where
  toJSON :: PlatformName -> Value
toJSON PlatformName
Mac = Text -> Value
String Text
"mac"

instance Arbitrary PlatformName where
  arbitrary :: Gen PlatformName
arbitrary = Gen PlatformName
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://sites.google.com/a/chromium.org/chromedriver/capabilities>.
data ChromeOptions = ChromeOptions
  { ChromeOptions -> Maybe String
_chromeBinary :: Maybe FilePath -- ^ @binary@
  , ChromeOptions -> Maybe [Text]
_chromeArgs :: Maybe [Text] -- ^ @args@
  , ChromeOptions -> Maybe (HashMap Text Value)
_chromePrefs :: Maybe (HashMap Text Value) -- ^ @prefs@
  } deriving (ChromeOptions -> ChromeOptions -> Bool
(ChromeOptions -> ChromeOptions -> Bool)
-> (ChromeOptions -> ChromeOptions -> Bool) -> Eq ChromeOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChromeOptions -> ChromeOptions -> Bool
$c/= :: ChromeOptions -> ChromeOptions -> Bool
== :: ChromeOptions -> ChromeOptions -> Bool
$c== :: ChromeOptions -> ChromeOptions -> Bool
Eq, Int -> ChromeOptions -> ShowS
[ChromeOptions] -> ShowS
ChromeOptions -> String
(Int -> ChromeOptions -> ShowS)
-> (ChromeOptions -> String)
-> ([ChromeOptions] -> ShowS)
-> Show ChromeOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeOptions] -> ShowS
$cshowList :: [ChromeOptions] -> ShowS
show :: ChromeOptions -> String
$cshow :: ChromeOptions -> String
showsPrec :: Int -> ChromeOptions -> ShowS
$cshowsPrec :: Int -> ChromeOptions -> ShowS
Show)

instance FromJSON ChromeOptions where
  parseJSON :: Value -> Parser ChromeOptions
parseJSON (Object Object
v) = Maybe String
-> Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions
ChromeOptions
    (Maybe String
 -> Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"binary"
    Parser
  (Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions)
-> Parser (Maybe [Text])
-> Parser (Maybe (HashMap Text Value) -> ChromeOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"args"
    Parser (Maybe (HashMap Text Value) -> ChromeOptions)
-> Parser (Maybe (HashMap Text Value)) -> Parser ChromeOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (HashMap Text Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prefs"
  parseJSON Value
invalid = String -> Value -> Parser ChromeOptions
forall a. String -> Value -> Parser a
typeMismatch String
"ChromeOptions" Value
invalid

instance ToJSON ChromeOptions where
  toJSON :: ChromeOptions -> Value
toJSON ChromeOptions{Maybe String
Maybe [Text]
Maybe (HashMap Text Value)
_chromePrefs :: Maybe (HashMap Text Value)
_chromeArgs :: Maybe [Text]
_chromeBinary :: Maybe String
_chromePrefs :: ChromeOptions -> Maybe (HashMap Text Value)
_chromeArgs :: ChromeOptions -> Maybe [Text]
_chromeBinary :: ChromeOptions -> Maybe String
..} = [Maybe Pair] -> Value
object_
    [ Text
"binary" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> Maybe String -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_chromeBinary)
    , Text
"args" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? ([Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> Maybe [Text] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
_chromeArgs)
    , Text
"prefs" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text Value -> Value)
-> Maybe (HashMap Text Value) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HashMap Text Value)
_chromePrefs)
    ]

instance Arbitrary ChromeOptions where
  arbitrary :: Gen ChromeOptions
arbitrary = Maybe String
-> Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions
ChromeOptions
    (Maybe String
 -> Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions)
-> Gen (Maybe String)
-> Gen
     (Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions)
-> Gen (Maybe [Text])
-> Gen (Maybe (HashMap Text Value) -> ChromeOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe [String] -> Maybe [Text])
-> Gen (Maybe [String]) -> Gen (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> [Text]) -> Maybe [String] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack)) Gen (Maybe [String])
forall a. Arbitrary a => Gen a
arbitrary)
    Gen (Maybe (HashMap Text Value) -> ChromeOptions)
-> Gen (Maybe (HashMap Text Value)) -> Gen ChromeOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (HashMap Text Value))
arbHashMap

-- | All members set to `Nothing`.
defaultChromeOptions :: ChromeOptions
defaultChromeOptions :: ChromeOptions
defaultChromeOptions = ChromeOptions :: Maybe String
-> Maybe [Text] -> Maybe (HashMap Text Value) -> ChromeOptions
ChromeOptions
  { _chromeBinary :: Maybe String
_chromeBinary = Maybe String
forall a. Maybe a
Nothing
  , _chromeArgs :: Maybe [Text]
_chromeArgs = Maybe [Text]
forall a. Maybe a
Nothing
  , _chromePrefs :: Maybe (HashMap Text Value)
_chromePrefs = Maybe (HashMap Text Value)
forall a. Maybe a
Nothing
  }



-- | See <https://github.com/mozilla/geckodriver#firefox-capabilities>.
data FirefoxOptions = FirefoxOptions
  { FirefoxOptions -> Maybe String
_firefoxBinary :: Maybe FilePath -- ^ @binary@
  , FirefoxOptions -> Maybe [Text]
_firefoxArgs :: Maybe [Text] -- ^ @args@
  , FirefoxOptions -> Maybe FirefoxLog
_firefoxLog :: Maybe FirefoxLog
  , FirefoxOptions -> Maybe (HashMap Text Value)
_firefoxPrefs :: Maybe (HashMap Text Value) -- ^ @prefs@
  } deriving (FirefoxOptions -> FirefoxOptions -> Bool
(FirefoxOptions -> FirefoxOptions -> Bool)
-> (FirefoxOptions -> FirefoxOptions -> Bool) -> Eq FirefoxOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FirefoxOptions -> FirefoxOptions -> Bool
$c/= :: FirefoxOptions -> FirefoxOptions -> Bool
== :: FirefoxOptions -> FirefoxOptions -> Bool
$c== :: FirefoxOptions -> FirefoxOptions -> Bool
Eq, 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
showList :: [FirefoxOptions] -> ShowS
$cshowList :: [FirefoxOptions] -> ShowS
show :: FirefoxOptions -> String
$cshow :: FirefoxOptions -> String
showsPrec :: Int -> FirefoxOptions -> ShowS
$cshowsPrec :: Int -> FirefoxOptions -> ShowS
Show)

instance FromJSON FirefoxOptions where
  parseJSON :: Value -> Parser FirefoxOptions
parseJSON (Object Object
v) = Maybe String
-> Maybe [Text]
-> Maybe FirefoxLog
-> Maybe (HashMap Text Value)
-> FirefoxOptions
FirefoxOptions
    (Maybe String
 -> Maybe [Text]
 -> Maybe FirefoxLog
 -> Maybe (HashMap Text Value)
 -> FirefoxOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe [Text]
      -> Maybe FirefoxLog
      -> Maybe (HashMap Text Value)
      -> FirefoxOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"binary"
    Parser
  (Maybe [Text]
   -> Maybe FirefoxLog
   -> Maybe (HashMap Text Value)
   -> FirefoxOptions)
-> Parser (Maybe [Text])
-> Parser
     (Maybe FirefoxLog -> Maybe (HashMap Text Value) -> FirefoxOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"args"
    Parser
  (Maybe FirefoxLog -> Maybe (HashMap Text Value) -> FirefoxOptions)
-> Parser (Maybe FirefoxLog)
-> Parser (Maybe (HashMap Text Value) -> FirefoxOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe FirefoxLog)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"log"
    Parser (Maybe (HashMap Text Value) -> FirefoxOptions)
-> Parser (Maybe (HashMap Text Value)) -> Parser FirefoxOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (HashMap Text Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prefs"
  parseJSON Value
invalid = String -> Value -> Parser FirefoxOptions
forall a. String -> Value -> Parser a
typeMismatch String
"FirefoxOptions" Value
invalid

instance ToJSON FirefoxOptions where
  toJSON :: FirefoxOptions -> Value
toJSON FirefoxOptions{Maybe String
Maybe [Text]
Maybe (HashMap Text Value)
Maybe FirefoxLog
_firefoxPrefs :: Maybe (HashMap Text Value)
_firefoxLog :: Maybe FirefoxLog
_firefoxArgs :: Maybe [Text]
_firefoxBinary :: Maybe String
_firefoxPrefs :: FirefoxOptions -> Maybe (HashMap Text Value)
_firefoxLog :: FirefoxOptions -> Maybe FirefoxLog
_firefoxBinary :: FirefoxOptions -> Maybe String
_firefoxArgs :: FirefoxOptions -> Maybe [Text]
..} = [Maybe Pair] -> Value
object_
    [ Text
"binary" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> Maybe String -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_firefoxBinary)
    , Text
"args" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? ([Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> Maybe [Text] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
_firefoxArgs)
    , Text
"log" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (FirefoxLog -> Value
forall a. ToJSON a => a -> Value
toJSON (FirefoxLog -> Value) -> Maybe FirefoxLog -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FirefoxLog
_firefoxLog)
    , Text
"prefs" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text Value -> Value)
-> Maybe (HashMap Text Value) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HashMap Text Value)
_firefoxPrefs)
    ]

instance Arbitrary FirefoxOptions where
  arbitrary :: Gen FirefoxOptions
arbitrary = Maybe String
-> Maybe [Text]
-> Maybe FirefoxLog
-> Maybe (HashMap Text Value)
-> FirefoxOptions
FirefoxOptions
    (Maybe String
 -> Maybe [Text]
 -> Maybe FirefoxLog
 -> Maybe (HashMap Text Value)
 -> FirefoxOptions)
-> Gen (Maybe String)
-> Gen
     (Maybe [Text]
      -> Maybe FirefoxLog
      -> Maybe (HashMap Text Value)
      -> FirefoxOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe [Text]
   -> Maybe FirefoxLog
   -> Maybe (HashMap Text Value)
   -> FirefoxOptions)
-> Gen (Maybe [Text])
-> Gen
     (Maybe FirefoxLog -> Maybe (HashMap Text Value) -> FirefoxOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe [String] -> Maybe [Text])
-> Gen (Maybe [String]) -> Gen (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> [Text]) -> Maybe [String] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack)) Gen (Maybe [String])
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe FirefoxLog -> Maybe (HashMap Text Value) -> FirefoxOptions)
-> Gen (Maybe FirefoxLog)
-> Gen (Maybe (HashMap Text Value) -> FirefoxOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe FirefoxLog)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe (HashMap Text Value) -> FirefoxOptions)
-> Gen (Maybe (HashMap Text Value)) -> Gen FirefoxOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (HashMap Text Value))
arbHashMap

arbHashMap :: Gen (Maybe (HashMap Text Value))
arbHashMap :: Gen (Maybe (HashMap Text Value))
arbHashMap = do
  Bool
p <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
  if Bool
p
    then Maybe (HashMap Text Value) -> Gen (Maybe (HashMap Text Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HashMap Text Value)
forall a. Maybe a
Nothing
    else do
      HashMap Text Value
m <- [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Text, Value)] -> HashMap Text Value)
-> Gen [(Text, Value)] -> Gen (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Text, Value) -> Gen [(Text, Value)]
forall a. Gen a -> Gen [a]
listOf (Gen Text -> Gen Value -> Gen (Text, Value)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m (a, b)
mPair Gen Text
arbKey Gen Value
arbPrefVal)
      Maybe (HashMap Text Value) -> Gen (Maybe (HashMap Text Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HashMap Text Value) -> Gen (Maybe (HashMap Text Value)))
-> Maybe (HashMap Text Value) -> Gen (Maybe (HashMap Text Value))
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Maybe (HashMap Text Value)
forall a. a -> Maybe a
Just HashMap Text Value
m

arbKey :: Gen Text
arbKey :: Gen Text
arbKey = String -> Text
pack (String -> Text) -> ShowS -> String -> Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char
'k'Char -> ShowS
forall a. a -> [a] -> [a]
:) (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

arbText :: Gen Text
arbText :: Gen Text
arbText = String -> Text
pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

arbPrefVal :: Gen Value
arbPrefVal :: Gen Value
arbPrefVal = do
  Int
k <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary :: Gen Int
  case Int
kInt -> Int -> Int
forall a. Integral a => a -> a -> a
`mod`Int
3 of
    Int
0 -> Bool -> Value
Bool (Bool -> Value) -> Gen Bool -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    Int
1 -> Text -> Value
String (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText
    Int
_ -> Scientific -> Value
Number (Scientific -> Value) -> Gen Scientific -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
arbScientific

mPair :: (Monad m) => m a -> m b -> m (a,b)
mPair :: m a -> m b -> m (a, b)
mPair m a
ga m b
gb = do
  a
a <- m a
ga
  b
b <- m b
gb
  (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)

-- | All members set to `Nothing`.
defaultFirefoxOptions :: FirefoxOptions
defaultFirefoxOptions :: FirefoxOptions
defaultFirefoxOptions = FirefoxOptions :: Maybe String
-> Maybe [Text]
-> Maybe FirefoxLog
-> Maybe (HashMap Text Value)
-> FirefoxOptions
FirefoxOptions
  { _firefoxBinary :: Maybe String
_firefoxBinary = Maybe String
forall a. Maybe a
Nothing
  , _firefoxArgs :: Maybe [Text]
_firefoxArgs = Maybe [Text]
forall a. Maybe a
Nothing
  , _firefoxLog :: Maybe FirefoxLog
_firefoxLog = Maybe FirefoxLog
forall a. Maybe a
Nothing
  , _firefoxPrefs :: Maybe (HashMap Text Value)
_firefoxPrefs = Maybe (HashMap Text Value)
forall a. Maybe a
Nothing
  }



-- | See <https://github.com/mozilla/geckodriver#log-object>.
newtype FirefoxLog = FirefoxLog
  { FirefoxLog -> Maybe LogLevel
_firefoxLogLevel :: Maybe LogLevel
  } deriving (FirefoxLog -> FirefoxLog -> Bool
(FirefoxLog -> FirefoxLog -> Bool)
-> (FirefoxLog -> FirefoxLog -> Bool) -> Eq FirefoxLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FirefoxLog -> FirefoxLog -> Bool
$c/= :: FirefoxLog -> FirefoxLog -> Bool
== :: FirefoxLog -> FirefoxLog -> Bool
$c== :: FirefoxLog -> FirefoxLog -> Bool
Eq, Int -> FirefoxLog -> ShowS
[FirefoxLog] -> ShowS
FirefoxLog -> String
(Int -> FirefoxLog -> ShowS)
-> (FirefoxLog -> String)
-> ([FirefoxLog] -> ShowS)
-> Show FirefoxLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirefoxLog] -> ShowS
$cshowList :: [FirefoxLog] -> ShowS
show :: FirefoxLog -> String
$cshow :: FirefoxLog -> String
showsPrec :: Int -> FirefoxLog -> ShowS
$cshowsPrec :: Int -> FirefoxLog -> ShowS
Show)

instance FromJSON FirefoxLog where
  parseJSON :: Value -> Parser FirefoxLog
parseJSON (Object Object
v) = Maybe LogLevel -> FirefoxLog
FirefoxLog
    (Maybe LogLevel -> FirefoxLog)
-> Parser (Maybe LogLevel) -> Parser FirefoxLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe LogLevel)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"level"
  parseJSON Value
invalid = String -> Value -> Parser FirefoxLog
forall a. String -> Value -> Parser a
typeMismatch String
"FirefoxLog" Value
invalid

instance ToJSON FirefoxLog where
  toJSON :: FirefoxLog -> Value
toJSON FirefoxLog{Maybe LogLevel
_firefoxLogLevel :: Maybe LogLevel
_firefoxLogLevel :: FirefoxLog -> Maybe LogLevel
..} = [Maybe Pair] -> Value
object_
    [ Text
"level" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (LogLevel -> Value
forall a. ToJSON a => a -> Value
toJSON (LogLevel -> Value) -> Maybe LogLevel -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LogLevel
_firefoxLogLevel)
    ]

instance Arbitrary FirefoxLog where
  arbitrary :: Gen FirefoxLog
arbitrary = Maybe LogLevel -> FirefoxLog
FirefoxLog
    (Maybe LogLevel -> FirefoxLog)
-> Gen (Maybe LogLevel) -> Gen FirefoxLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe LogLevel)
forall a. Arbitrary a => Gen a
arbitrary



-- | See <https://github.com/mozilla/geckodriver#log-object>.
data LogLevel
  = LogTrace
  | LogDebug
  | LogConfig
  | LogInfo
  | LogWarn
  | LogError
  | LogFatal
  deriving (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum, LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
maxBound :: LogLevel
$cmaxBound :: LogLevel
minBound :: LogLevel
$cminBound :: LogLevel
Bounded)

instance FromJSON LogLevel where
  parseJSON :: Value -> Parser LogLevel
parseJSON (String Text
x) = case Text
x of
    Text
"trace" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogTrace
    Text
"debug" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogDebug
    Text
"config" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogConfig
    Text
"info" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogInfo
    Text
"warn" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogWarn
    Text
"error" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogError
    Text
"fatal" -> LogLevel -> Parser LogLevel
forall (m :: * -> *) a. Monad m => a -> m a
return LogLevel
LogFatal
    Text
_ -> Text -> Text -> Parser LogLevel
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"LogLevel" Text
x
  parseJSON Value
invalid = String -> Value -> Parser LogLevel
forall a. String -> Value -> Parser a
typeMismatch String
"LogLevel" Value
invalid

instance ToJSON LogLevel where
  toJSON :: LogLevel -> Value
toJSON LogLevel
x = case LogLevel
x of
    LogLevel
LogTrace -> Text -> Value
String Text
"trace"
    LogLevel
LogDebug -> Text -> Value
String Text
"debug"
    LogLevel
LogConfig -> Text -> Value
String Text
"config"
    LogLevel
LogInfo -> Text -> Value
String Text
"info"
    LogLevel
LogWarn -> Text -> Value
String Text
"warn"
    LogLevel
LogError -> Text -> Value
String Text
"error"
    LogLevel
LogFatal -> Text -> Value
String Text
"fatal"

instance Arbitrary LogLevel where
  arbitrary :: Gen LogLevel
arbitrary = Gen LogLevel
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#proxy>.
data ProxyConfig = ProxyConfig
  { ProxyConfig -> Maybe ProxyType
_proxyType :: Maybe ProxyType -- ^ @proxyType@
  , ProxyConfig -> Maybe Text
_proxyAutoconfigUrl :: Maybe Text -- ^ @proxyAutoconfigUrl@
  , ProxyConfig -> Maybe HostAndOptionalPort
_ftpProxy :: Maybe HostAndOptionalPort -- ^ @ftpProxy@
  , ProxyConfig -> Maybe HostAndOptionalPort
_httpProxy :: Maybe HostAndOptionalPort -- ^ @httpProxy@
  , ProxyConfig -> Maybe [Text]
_noProxy :: Maybe [Text] -- ^ @noProxy@
  , ProxyConfig -> Maybe HostAndOptionalPort
_sslProxy :: Maybe HostAndOptionalPort -- ^ @sslProxy@
  , ProxyConfig -> Maybe HostAndOptionalPort
_socksProxy :: Maybe HostAndOptionalPort -- ^ @socksProxy@
  , ProxyConfig -> Maybe Int
_socksVersion :: Maybe Int -- ^ @socksVersion@
  } deriving (ProxyConfig -> ProxyConfig -> Bool
(ProxyConfig -> ProxyConfig -> Bool)
-> (ProxyConfig -> ProxyConfig -> Bool) -> Eq ProxyConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyConfig -> ProxyConfig -> Bool
$c/= :: ProxyConfig -> ProxyConfig -> Bool
== :: ProxyConfig -> ProxyConfig -> Bool
$c== :: ProxyConfig -> ProxyConfig -> Bool
Eq, Int -> ProxyConfig -> ShowS
[ProxyConfig] -> ShowS
ProxyConfig -> String
(Int -> ProxyConfig -> ShowS)
-> (ProxyConfig -> String)
-> ([ProxyConfig] -> ShowS)
-> Show ProxyConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyConfig] -> ShowS
$cshowList :: [ProxyConfig] -> ShowS
show :: ProxyConfig -> String
$cshow :: ProxyConfig -> String
showsPrec :: Int -> ProxyConfig -> ShowS
$cshowsPrec :: Int -> ProxyConfig -> ShowS
Show)

instance FromJSON ProxyConfig where
  parseJSON :: Value -> Parser ProxyConfig
parseJSON (Object Object
v) = Maybe ProxyType
-> Maybe Text
-> Maybe HostAndOptionalPort
-> Maybe HostAndOptionalPort
-> Maybe [Text]
-> Maybe HostAndOptionalPort
-> Maybe HostAndOptionalPort
-> Maybe Int
-> ProxyConfig
ProxyConfig
    (Maybe ProxyType
 -> Maybe Text
 -> Maybe HostAndOptionalPort
 -> Maybe HostAndOptionalPort
 -> Maybe [Text]
 -> Maybe HostAndOptionalPort
 -> Maybe HostAndOptionalPort
 -> Maybe Int
 -> ProxyConfig)
-> Parser (Maybe ProxyType)
-> Parser
     (Maybe Text
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe ProxyType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"proxyType"
    Parser
  (Maybe Text
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Parser (Maybe Text)
-> Parser
     (Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"proxyAutoconfigUrl"
    Parser
  (Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Parser (Maybe HostAndOptionalPort)
-> Parser
     (Maybe HostAndOptionalPort
      -> Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe HostAndOptionalPort)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ftpProxy"
    Parser
  (Maybe HostAndOptionalPort
   -> Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Parser (Maybe HostAndOptionalPort)
-> Parser
     (Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe HostAndOptionalPort)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"httpProxy"
    Parser
  (Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Parser (Maybe [Text])
-> Parser
     (Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"noProxy"
    Parser
  (Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
-> Parser (Maybe HostAndOptionalPort)
-> Parser (Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe HostAndOptionalPort)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sslProxy"
    Parser (Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
-> Parser (Maybe HostAndOptionalPort)
-> Parser (Maybe Int -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe HostAndOptionalPort)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"socksProxy"
    Parser (Maybe Int -> ProxyConfig)
-> Parser (Maybe Int) -> Parser ProxyConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"socksVersion"
  parseJSON Value
invalid = String -> Value -> Parser ProxyConfig
forall a. String -> Value -> Parser a
typeMismatch String
"ProxyConfig" Value
invalid

instance ToJSON ProxyConfig where
  toJSON :: ProxyConfig -> Value
toJSON ProxyConfig{Maybe Int
Maybe [Text]
Maybe Text
Maybe ProxyType
Maybe HostAndOptionalPort
_socksVersion :: Maybe Int
_socksProxy :: Maybe HostAndOptionalPort
_sslProxy :: Maybe HostAndOptionalPort
_noProxy :: Maybe [Text]
_httpProxy :: Maybe HostAndOptionalPort
_ftpProxy :: Maybe HostAndOptionalPort
_proxyAutoconfigUrl :: Maybe Text
_proxyType :: Maybe ProxyType
_socksVersion :: ProxyConfig -> Maybe Int
_socksProxy :: ProxyConfig -> Maybe HostAndOptionalPort
_sslProxy :: ProxyConfig -> Maybe HostAndOptionalPort
_noProxy :: ProxyConfig -> Maybe [Text]
_httpProxy :: ProxyConfig -> Maybe HostAndOptionalPort
_ftpProxy :: ProxyConfig -> Maybe HostAndOptionalPort
_proxyAutoconfigUrl :: ProxyConfig -> Maybe Text
_proxyType :: ProxyConfig -> Maybe ProxyType
..} = [Maybe Pair] -> Value
object_
    [ Text
"proxyType" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (ProxyType -> Value
forall a. ToJSON a => a -> Value
toJSON (ProxyType -> Value) -> Maybe ProxyType -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ProxyType
_proxyType)
    , Text
"proxyAutoconfigUrl" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_proxyAutoconfigUrl)
    , Text
"ftpProxy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (HostAndOptionalPort -> Value
forall a. ToJSON a => a -> Value
toJSON (HostAndOptionalPort -> Value)
-> Maybe HostAndOptionalPort -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HostAndOptionalPort
_ftpProxy)
    , Text
"httpProxy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (HostAndOptionalPort -> Value
forall a. ToJSON a => a -> Value
toJSON (HostAndOptionalPort -> Value)
-> Maybe HostAndOptionalPort -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HostAndOptionalPort
_httpProxy)
    , Text
"noProxy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? ([Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> Maybe [Text] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
_noProxy)
    , Text
"sslProxy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (HostAndOptionalPort -> Value
forall a. ToJSON a => a -> Value
toJSON (HostAndOptionalPort -> Value)
-> Maybe HostAndOptionalPort -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HostAndOptionalPort
_sslProxy)
    , Text
"socksProxy" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (HostAndOptionalPort -> Value
forall a. ToJSON a => a -> Value
toJSON (HostAndOptionalPort -> Value)
-> Maybe HostAndOptionalPort -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HostAndOptionalPort
_socksProxy)
    , Text
"socksVersion" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_socksVersion)
    ]

instance Arbitrary ProxyConfig where
  arbitrary :: Gen ProxyConfig
arbitrary = Maybe ProxyType
-> Maybe Text
-> Maybe HostAndOptionalPort
-> Maybe HostAndOptionalPort
-> Maybe [Text]
-> Maybe HostAndOptionalPort
-> Maybe HostAndOptionalPort
-> Maybe Int
-> ProxyConfig
ProxyConfig
    (Maybe ProxyType
 -> Maybe Text
 -> Maybe HostAndOptionalPort
 -> Maybe HostAndOptionalPort
 -> Maybe [Text]
 -> Maybe HostAndOptionalPort
 -> Maybe HostAndOptionalPort
 -> Maybe Int
 -> ProxyConfig)
-> Gen (Maybe ProxyType)
-> Gen
     (Maybe Text
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe ProxyType)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Text
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Gen (Maybe Text)
-> Gen
     (Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Gen (Maybe HostAndOptionalPort)
-> Gen
     (Maybe HostAndOptionalPort
      -> Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe HostAndOptionalPort)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe HostAndOptionalPort
   -> Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Gen (Maybe HostAndOptionalPort)
-> Gen
     (Maybe [Text]
      -> Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort
      -> Maybe Int
      -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe HostAndOptionalPort)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe [Text]
   -> Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort
   -> Maybe Int
   -> ProxyConfig)
-> Gen (Maybe [Text])
-> Gen
     (Maybe HostAndOptionalPort
      -> Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe [String] -> Maybe [Text])
-> Gen (Maybe [String]) -> Gen (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> [Text]) -> Maybe [String] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack)) Gen (Maybe [String])
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe HostAndOptionalPort
   -> Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
-> Gen (Maybe HostAndOptionalPort)
-> Gen (Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe HostAndOptionalPort)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe HostAndOptionalPort -> Maybe Int -> ProxyConfig)
-> Gen (Maybe HostAndOptionalPort)
-> Gen (Maybe Int -> ProxyConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe HostAndOptionalPort)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Int -> ProxyConfig)
-> Gen (Maybe Int) -> Gen ProxyConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary

-- | `ProxyConfig` object with all members set to `Nothing`.
emptyProxyConfig :: ProxyConfig
emptyProxyConfig :: ProxyConfig
emptyProxyConfig = ProxyConfig :: Maybe ProxyType
-> Maybe Text
-> Maybe HostAndOptionalPort
-> Maybe HostAndOptionalPort
-> Maybe [Text]
-> Maybe HostAndOptionalPort
-> Maybe HostAndOptionalPort
-> Maybe Int
-> ProxyConfig
ProxyConfig
  { _proxyType :: Maybe ProxyType
_proxyType = Maybe ProxyType
forall a. Maybe a
Nothing
  , _proxyAutoconfigUrl :: Maybe Text
_proxyAutoconfigUrl = Maybe Text
forall a. Maybe a
Nothing
  , _ftpProxy :: Maybe HostAndOptionalPort
_ftpProxy = Maybe HostAndOptionalPort
forall a. Maybe a
Nothing
  , _httpProxy :: Maybe HostAndOptionalPort
_httpProxy = Maybe HostAndOptionalPort
forall a. Maybe a
Nothing
  , _noProxy :: Maybe [Text]
_noProxy = Maybe [Text]
forall a. Maybe a
Nothing
  , _sslProxy :: Maybe HostAndOptionalPort
_sslProxy = Maybe HostAndOptionalPort
forall a. Maybe a
Nothing
  , _socksProxy :: Maybe HostAndOptionalPort
_socksProxy = Maybe HostAndOptionalPort
forall a. Maybe a
Nothing
  , _socksVersion :: Maybe Int
_socksVersion = Maybe Int
forall a. Maybe a
Nothing
  }



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-host-and-optional-port>.
data HostAndOptionalPort = HostAndOptionalPort
  { HostAndOptionalPort -> Host
_urlHost :: Host
  , HostAndOptionalPort -> Maybe Port
_urlPort :: Maybe Port
  } deriving (HostAndOptionalPort -> HostAndOptionalPort -> Bool
(HostAndOptionalPort -> HostAndOptionalPort -> Bool)
-> (HostAndOptionalPort -> HostAndOptionalPort -> Bool)
-> Eq HostAndOptionalPort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAndOptionalPort -> HostAndOptionalPort -> Bool
$c/= :: HostAndOptionalPort -> HostAndOptionalPort -> Bool
== :: HostAndOptionalPort -> HostAndOptionalPort -> Bool
$c== :: HostAndOptionalPort -> HostAndOptionalPort -> Bool
Eq, Int -> HostAndOptionalPort -> ShowS
[HostAndOptionalPort] -> ShowS
HostAndOptionalPort -> String
(Int -> HostAndOptionalPort -> ShowS)
-> (HostAndOptionalPort -> String)
-> ([HostAndOptionalPort] -> ShowS)
-> Show HostAndOptionalPort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostAndOptionalPort] -> ShowS
$cshowList :: [HostAndOptionalPort] -> ShowS
show :: HostAndOptionalPort -> String
$cshow :: HostAndOptionalPort -> String
showsPrec :: Int -> HostAndOptionalPort -> ShowS
$cshowsPrec :: Int -> HostAndOptionalPort -> ShowS
Show)

instance FromJSON HostAndOptionalPort where
  parseJSON :: Value -> Parser HostAndOptionalPort
parseJSON (String Text
string) =
    let (Text
as,Text
bs') = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Text
string
    in if Text -> Bool
T.null Text
as
      then Text -> Text -> Parser HostAndOptionalPort
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"Host" Text
string
      else case Text -> Maybe (Char, Text)
T.uncons Text
bs' of
        Maybe (Char, Text)
Nothing -> case Text -> Maybe Host
mkHost Text
as of
          Maybe Host
Nothing -> Text -> Text -> Parser HostAndOptionalPort
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"Host" Text
string
          Just Host
h -> HostAndOptionalPort -> Parser HostAndOptionalPort
forall (m :: * -> *) a. Monad m => a -> m a
return HostAndOptionalPort :: Host -> Maybe Port -> HostAndOptionalPort
HostAndOptionalPort
            { _urlHost :: Host
_urlHost = Host
h
            , _urlPort :: Maybe Port
_urlPort = Maybe Port
forall a. Maybe a
Nothing
            }
        Just (Char
c,Text
bs) -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'
          then Text -> Text -> Parser HostAndOptionalPort
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"Host" Text
string
          else if Text -> Bool
T.null Text
bs
            then Text -> Text -> Parser HostAndOptionalPort
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"Port" Text
string
            else case Text -> Maybe Host
mkHost Text
as of
              Maybe Host
Nothing -> Text -> Text -> Parser HostAndOptionalPort
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"Host" Text
string
              Just Host
h -> case Text -> Maybe Port
mkPort Text
bs of
                Maybe Port
Nothing -> Text -> Text -> Parser HostAndOptionalPort
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"Port" Text
bs
                Just Port
p -> HostAndOptionalPort -> Parser HostAndOptionalPort
forall (m :: * -> *) a. Monad m => a -> m a
return HostAndOptionalPort :: Host -> Maybe Port -> HostAndOptionalPort
HostAndOptionalPort
                  { _urlHost :: Host
_urlHost = Host
h
                  , _urlPort :: Maybe Port
_urlPort = Port -> Maybe Port
forall a. a -> Maybe a
Just Port
p
                  }
  parseJSON Value
invalid = String -> Value -> Parser HostAndOptionalPort
forall a. String -> Value -> Parser a
typeMismatch String
"HostAndOptionalPort" Value
invalid

instance ToJSON HostAndOptionalPort where
  toJSON :: HostAndOptionalPort -> Value
toJSON HostAndOptionalPort{Maybe Port
Host
_urlPort :: Maybe Port
_urlHost :: Host
_urlPort :: HostAndOptionalPort -> Maybe Port
_urlHost :: HostAndOptionalPort -> Host
..} = case Maybe Port
_urlPort of
    Maybe Port
Nothing -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Host -> String
forall a. Show a => a -> String
show Host
_urlHost
    Just Port
pt -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Host -> String
forall a. Show a => a -> String
show Host
_urlHost, String
":", Port -> String
forall a. Show a => a -> String
show Port
pt]

instance Arbitrary HostAndOptionalPort where
  arbitrary :: Gen HostAndOptionalPort
arbitrary = Host -> Maybe Port -> HostAndOptionalPort
HostAndOptionalPort
    (Host -> Maybe Port -> HostAndOptionalPort)
-> Gen Host -> Gen (Maybe Port -> HostAndOptionalPort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Host
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Port -> HostAndOptionalPort)
-> Gen (Maybe Port) -> Gen HostAndOptionalPort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Port)
forall a. Arbitrary a => Gen a
arbitrary



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-proxytype>.
data ProxyType
  = ProxyPac -- ^ @pac@
  | ProxyDirect -- ^ @direct@
  | ProxyAutodetect -- ^ @autodetect@
  | ProxySystem -- ^ @system@
  | ProxyManual -- ^ @manual@
  deriving (ProxyType -> ProxyType -> Bool
(ProxyType -> ProxyType -> Bool)
-> (ProxyType -> ProxyType -> Bool) -> Eq ProxyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyType -> ProxyType -> Bool
$c/= :: ProxyType -> ProxyType -> Bool
== :: ProxyType -> ProxyType -> Bool
$c== :: ProxyType -> ProxyType -> Bool
Eq, Int -> ProxyType -> ShowS
[ProxyType] -> ShowS
ProxyType -> String
(Int -> ProxyType -> ShowS)
-> (ProxyType -> String)
-> ([ProxyType] -> ShowS)
-> Show ProxyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyType] -> ShowS
$cshowList :: [ProxyType] -> ShowS
show :: ProxyType -> String
$cshow :: ProxyType -> String
showsPrec :: Int -> ProxyType -> ShowS
$cshowsPrec :: Int -> ProxyType -> ShowS
Show, Int -> ProxyType
ProxyType -> Int
ProxyType -> [ProxyType]
ProxyType -> ProxyType
ProxyType -> ProxyType -> [ProxyType]
ProxyType -> ProxyType -> ProxyType -> [ProxyType]
(ProxyType -> ProxyType)
-> (ProxyType -> ProxyType)
-> (Int -> ProxyType)
-> (ProxyType -> Int)
-> (ProxyType -> [ProxyType])
-> (ProxyType -> ProxyType -> [ProxyType])
-> (ProxyType -> ProxyType -> [ProxyType])
-> (ProxyType -> ProxyType -> ProxyType -> [ProxyType])
-> Enum ProxyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ProxyType -> ProxyType -> ProxyType -> [ProxyType]
$cenumFromThenTo :: ProxyType -> ProxyType -> ProxyType -> [ProxyType]
enumFromTo :: ProxyType -> ProxyType -> [ProxyType]
$cenumFromTo :: ProxyType -> ProxyType -> [ProxyType]
enumFromThen :: ProxyType -> ProxyType -> [ProxyType]
$cenumFromThen :: ProxyType -> ProxyType -> [ProxyType]
enumFrom :: ProxyType -> [ProxyType]
$cenumFrom :: ProxyType -> [ProxyType]
fromEnum :: ProxyType -> Int
$cfromEnum :: ProxyType -> Int
toEnum :: Int -> ProxyType
$ctoEnum :: Int -> ProxyType
pred :: ProxyType -> ProxyType
$cpred :: ProxyType -> ProxyType
succ :: ProxyType -> ProxyType
$csucc :: ProxyType -> ProxyType
Enum, ProxyType
ProxyType -> ProxyType -> Bounded ProxyType
forall a. a -> a -> Bounded a
maxBound :: ProxyType
$cmaxBound :: ProxyType
minBound :: ProxyType
$cminBound :: ProxyType
Bounded)

instance FromJSON ProxyType where
  parseJSON :: Value -> Parser ProxyType
parseJSON (String Text
x) = case Text
x of
    Text
"pac" -> ProxyType -> Parser ProxyType
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
ProxyPac
    Text
"direct" -> ProxyType -> Parser ProxyType
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
ProxyDirect
    Text
"autodetect" -> ProxyType -> Parser ProxyType
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
ProxyAutodetect
    Text
"system" -> ProxyType -> Parser ProxyType
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
ProxySystem
    Text
"manual" -> ProxyType -> Parser ProxyType
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
ProxyManual
    Text
_ -> Text -> Text -> Parser ProxyType
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"ProxyType" Text
x
  parseJSON Value
invalid = String -> Value -> Parser ProxyType
forall a. String -> Value -> Parser a
typeMismatch String
"ProxyType" Value
invalid

instance ToJSON ProxyType where
  toJSON :: ProxyType -> Value
toJSON ProxyType
x = case ProxyType
x of
    ProxyType
ProxyPac -> Text -> Value
String Text
"pac"
    ProxyType
ProxyDirect -> Text -> Value
String Text
"direct"
    ProxyType
ProxyAutodetect -> Text -> Value
String Text
"autodetect"
    ProxyType
ProxySystem -> Text -> Value
String Text
"system"
    ProxyType
ProxyManual -> Text -> Value
String Text
"manual"

instance Arbitrary ProxyType where
  arbitrary :: Gen ProxyType
arbitrary = Gen ProxyType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum





-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-timeouts>.
data TimeoutConfig = TimeoutConfig
  { TimeoutConfig -> Maybe Int
_script :: Maybe Int -- ^ @script@
  , TimeoutConfig -> Maybe Int
_pageLoad :: Maybe Int -- ^ @pageLoad@
  , TimeoutConfig -> Maybe Int
_implicit :: Maybe Int -- ^ @implicit@
  } deriving (TimeoutConfig -> TimeoutConfig -> Bool
(TimeoutConfig -> TimeoutConfig -> Bool)
-> (TimeoutConfig -> TimeoutConfig -> Bool) -> Eq TimeoutConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeoutConfig -> TimeoutConfig -> Bool
$c/= :: TimeoutConfig -> TimeoutConfig -> Bool
== :: TimeoutConfig -> TimeoutConfig -> Bool
$c== :: TimeoutConfig -> TimeoutConfig -> Bool
Eq, Int -> TimeoutConfig -> ShowS
[TimeoutConfig] -> ShowS
TimeoutConfig -> String
(Int -> TimeoutConfig -> ShowS)
-> (TimeoutConfig -> String)
-> ([TimeoutConfig] -> ShowS)
-> Show TimeoutConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeoutConfig] -> ShowS
$cshowList :: [TimeoutConfig] -> ShowS
show :: TimeoutConfig -> String
$cshow :: TimeoutConfig -> String
showsPrec :: Int -> TimeoutConfig -> ShowS
$cshowsPrec :: Int -> TimeoutConfig -> ShowS
Show)

instance FromJSON TimeoutConfig where
  parseJSON :: Value -> Parser TimeoutConfig
parseJSON (Object Object
v) = Maybe Int -> Maybe Int -> Maybe Int -> TimeoutConfig
TimeoutConfig
    (Maybe Int -> Maybe Int -> Maybe Int -> TimeoutConfig)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> TimeoutConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"script"
    Parser (Maybe Int -> Maybe Int -> TimeoutConfig)
-> Parser (Maybe Int) -> Parser (Maybe Int -> TimeoutConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pageLoad"
    Parser (Maybe Int -> TimeoutConfig)
-> Parser (Maybe Int) -> Parser TimeoutConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implicit"
  parseJSON Value
invalid = String -> Value -> Parser TimeoutConfig
forall a. String -> Value -> Parser a
typeMismatch String
"TimeoutConfig" Value
invalid

instance ToJSON TimeoutConfig where
  toJSON :: TimeoutConfig -> Value
toJSON TimeoutConfig{Maybe Int
_implicit :: Maybe Int
_pageLoad :: Maybe Int
_script :: Maybe Int
_implicit :: TimeoutConfig -> Maybe Int
_pageLoad :: TimeoutConfig -> Maybe Int
_script :: TimeoutConfig -> Maybe Int
..} = [Maybe Pair] -> Value
object_
    [ Text
"script" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv
.== (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_script)
    , Text
"pageLoad" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv
.== (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_pageLoad)
    , Text
"implicit" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv
.== (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_implicit)
    ]

instance Arbitrary TimeoutConfig where
  arbitrary :: Gen TimeoutConfig
arbitrary = Maybe Int -> Maybe Int -> Maybe Int -> TimeoutConfig
TimeoutConfig
    (Maybe Int -> Maybe Int -> Maybe Int -> TimeoutConfig)
-> Gen (Maybe Int) -> Gen (Maybe Int -> Maybe Int -> TimeoutConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Int -> Maybe Int -> TimeoutConfig)
-> Gen (Maybe Int) -> Gen (Maybe Int -> TimeoutConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Int -> TimeoutConfig)
-> Gen (Maybe Int) -> Gen TimeoutConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary

-- | `TimeoutConfig` object with all members set to `Nothing`.
emptyTimeoutConfig :: TimeoutConfig
emptyTimeoutConfig :: TimeoutConfig
emptyTimeoutConfig = TimeoutConfig :: Maybe Int -> Maybe Int -> Maybe Int -> TimeoutConfig
TimeoutConfig
  { _script :: Maybe Int
_script = Maybe Int
forall a. Maybe a
Nothing
  , _pageLoad :: Maybe Int
_pageLoad = Maybe Int
forall a. Maybe a
Nothing
  , _implicit :: Maybe Int
_implicit = Maybe Int
forall a. Maybe a
Nothing
  }



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-table-of-location-strategies>.
data LocationStrategy
  = CssSelector -- ^ @css selector@
  | LinkTextSelector -- ^ @link text@
  | PartialLinkTextSelector -- ^ @partial link text@
  | TagName -- ^ @tag name@
  | XPathSelector -- ^ @xpath@
  deriving (LocationStrategy -> LocationStrategy -> Bool
(LocationStrategy -> LocationStrategy -> Bool)
-> (LocationStrategy -> LocationStrategy -> Bool)
-> Eq LocationStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocationStrategy -> LocationStrategy -> Bool
$c/= :: LocationStrategy -> LocationStrategy -> Bool
== :: LocationStrategy -> LocationStrategy -> Bool
$c== :: LocationStrategy -> LocationStrategy -> Bool
Eq, Int -> LocationStrategy -> ShowS
[LocationStrategy] -> ShowS
LocationStrategy -> String
(Int -> LocationStrategy -> ShowS)
-> (LocationStrategy -> String)
-> ([LocationStrategy] -> ShowS)
-> Show LocationStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocationStrategy] -> ShowS
$cshowList :: [LocationStrategy] -> ShowS
show :: LocationStrategy -> String
$cshow :: LocationStrategy -> String
showsPrec :: Int -> LocationStrategy -> ShowS
$cshowsPrec :: Int -> LocationStrategy -> ShowS
Show, Int -> LocationStrategy
LocationStrategy -> Int
LocationStrategy -> [LocationStrategy]
LocationStrategy -> LocationStrategy
LocationStrategy -> LocationStrategy -> [LocationStrategy]
LocationStrategy
-> LocationStrategy -> LocationStrategy -> [LocationStrategy]
(LocationStrategy -> LocationStrategy)
-> (LocationStrategy -> LocationStrategy)
-> (Int -> LocationStrategy)
-> (LocationStrategy -> Int)
-> (LocationStrategy -> [LocationStrategy])
-> (LocationStrategy -> LocationStrategy -> [LocationStrategy])
-> (LocationStrategy -> LocationStrategy -> [LocationStrategy])
-> (LocationStrategy
    -> LocationStrategy -> LocationStrategy -> [LocationStrategy])
-> Enum LocationStrategy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LocationStrategy
-> LocationStrategy -> LocationStrategy -> [LocationStrategy]
$cenumFromThenTo :: LocationStrategy
-> LocationStrategy -> LocationStrategy -> [LocationStrategy]
enumFromTo :: LocationStrategy -> LocationStrategy -> [LocationStrategy]
$cenumFromTo :: LocationStrategy -> LocationStrategy -> [LocationStrategy]
enumFromThen :: LocationStrategy -> LocationStrategy -> [LocationStrategy]
$cenumFromThen :: LocationStrategy -> LocationStrategy -> [LocationStrategy]
enumFrom :: LocationStrategy -> [LocationStrategy]
$cenumFrom :: LocationStrategy -> [LocationStrategy]
fromEnum :: LocationStrategy -> Int
$cfromEnum :: LocationStrategy -> Int
toEnum :: Int -> LocationStrategy
$ctoEnum :: Int -> LocationStrategy
pred :: LocationStrategy -> LocationStrategy
$cpred :: LocationStrategy -> LocationStrategy
succ :: LocationStrategy -> LocationStrategy
$csucc :: LocationStrategy -> LocationStrategy
Enum, LocationStrategy
LocationStrategy -> LocationStrategy -> Bounded LocationStrategy
forall a. a -> a -> Bounded a
maxBound :: LocationStrategy
$cmaxBound :: LocationStrategy
minBound :: LocationStrategy
$cminBound :: LocationStrategy
Bounded)

instance FromJSON LocationStrategy where
  parseJSON :: Value -> Parser LocationStrategy
parseJSON (String Text
x) = case Text
x of
    Text
"css selector" -> LocationStrategy -> Parser LocationStrategy
forall (m :: * -> *) a. Monad m => a -> m a
return LocationStrategy
CssSelector
    Text
"link text" -> LocationStrategy -> Parser LocationStrategy
forall (m :: * -> *) a. Monad m => a -> m a
return LocationStrategy
LinkTextSelector
    Text
"partial link text" -> LocationStrategy -> Parser LocationStrategy
forall (m :: * -> *) a. Monad m => a -> m a
return LocationStrategy
PartialLinkTextSelector
    Text
"tag name" -> LocationStrategy -> Parser LocationStrategy
forall (m :: * -> *) a. Monad m => a -> m a
return LocationStrategy
TagName
    Text
"xpath" -> LocationStrategy -> Parser LocationStrategy
forall (m :: * -> *) a. Monad m => a -> m a
return LocationStrategy
XPathSelector
    Text
_ -> Text -> Text -> Parser LocationStrategy
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"LocationStrategy" Text
x
  parseJSON Value
invalid = String -> Value -> Parser LocationStrategy
forall a. String -> Value -> Parser a
typeMismatch String
"LocationStrategy" Value
invalid

instance ToJSON LocationStrategy where
  toJSON :: LocationStrategy -> Value
toJSON LocationStrategy
x = case LocationStrategy
x of
    LocationStrategy
CssSelector -> Text -> Value
String Text
"css selector"
    LocationStrategy
LinkTextSelector -> Text -> Value
String Text
"link text"
    LocationStrategy
PartialLinkTextSelector -> Text -> Value
String Text
"partial link text"
    LocationStrategy
TagName -> Text -> Value
String Text
"tag name"
    LocationStrategy
XPathSelector -> Text -> Value
String Text
"xpath"

instance Arbitrary LocationStrategy where
  arbitrary :: Gen LocationStrategy
arbitrary = Gen LocationStrategy
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-input-sources>.
data InputSource
  = NullInputSource -- ^ @null@
  | KeyInputSource -- ^ @key@
  | PointerInputSource -- ^ @pointer@
  deriving (InputSource -> InputSource -> Bool
(InputSource -> InputSource -> Bool)
-> (InputSource -> InputSource -> Bool) -> Eq InputSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputSource -> InputSource -> Bool
$c/= :: InputSource -> InputSource -> Bool
== :: InputSource -> InputSource -> Bool
$c== :: InputSource -> InputSource -> Bool
Eq, Int -> InputSource -> ShowS
[InputSource] -> ShowS
InputSource -> String
(Int -> InputSource -> ShowS)
-> (InputSource -> String)
-> ([InputSource] -> ShowS)
-> Show InputSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputSource] -> ShowS
$cshowList :: [InputSource] -> ShowS
show :: InputSource -> String
$cshow :: InputSource -> String
showsPrec :: Int -> InputSource -> ShowS
$cshowsPrec :: Int -> InputSource -> ShowS
Show, Int -> InputSource
InputSource -> Int
InputSource -> [InputSource]
InputSource -> InputSource
InputSource -> InputSource -> [InputSource]
InputSource -> InputSource -> InputSource -> [InputSource]
(InputSource -> InputSource)
-> (InputSource -> InputSource)
-> (Int -> InputSource)
-> (InputSource -> Int)
-> (InputSource -> [InputSource])
-> (InputSource -> InputSource -> [InputSource])
-> (InputSource -> InputSource -> [InputSource])
-> (InputSource -> InputSource -> InputSource -> [InputSource])
-> Enum InputSource
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InputSource -> InputSource -> InputSource -> [InputSource]
$cenumFromThenTo :: InputSource -> InputSource -> InputSource -> [InputSource]
enumFromTo :: InputSource -> InputSource -> [InputSource]
$cenumFromTo :: InputSource -> InputSource -> [InputSource]
enumFromThen :: InputSource -> InputSource -> [InputSource]
$cenumFromThen :: InputSource -> InputSource -> [InputSource]
enumFrom :: InputSource -> [InputSource]
$cenumFrom :: InputSource -> [InputSource]
fromEnum :: InputSource -> Int
$cfromEnum :: InputSource -> Int
toEnum :: Int -> InputSource
$ctoEnum :: Int -> InputSource
pred :: InputSource -> InputSource
$cpred :: InputSource -> InputSource
succ :: InputSource -> InputSource
$csucc :: InputSource -> InputSource
Enum, InputSource
InputSource -> InputSource -> Bounded InputSource
forall a. a -> a -> Bounded a
maxBound :: InputSource
$cmaxBound :: InputSource
minBound :: InputSource
$cminBound :: InputSource
Bounded)

instance FromJSON InputSource where
  parseJSON :: Value -> Parser InputSource
parseJSON (String Text
x) = case Text
x of
    Text
"null" -> InputSource -> Parser InputSource
forall (m :: * -> *) a. Monad m => a -> m a
return InputSource
NullInputSource
    Text
"key" -> InputSource -> Parser InputSource
forall (m :: * -> *) a. Monad m => a -> m a
return InputSource
KeyInputSource
    Text
"pointer" -> InputSource -> Parser InputSource
forall (m :: * -> *) a. Monad m => a -> m a
return InputSource
PointerInputSource
    Text
_ -> Text -> Text -> Parser InputSource
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"InputSource" Text
x
  parseJSON Value
invalid = String -> Value -> Parser InputSource
forall a. String -> Value -> Parser a
typeMismatch String
"InputSource" Value
invalid

instance ToJSON InputSource where
  toJSON :: InputSource -> Value
toJSON InputSource
x = case InputSource
x of
    InputSource
NullInputSource -> Text -> Value
String Text
"null"
    InputSource
KeyInputSource -> Text -> Value
String Text
"key"
    InputSource
PointerInputSource -> Text -> Value
String Text
"pointer"

instance Arbitrary InputSource where
  arbitrary :: Gen InputSource
arbitrary = Gen InputSource
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-pointer-input-state>.
data PointerSubtype
  = PointerMouse -- ^ @mouse@
  | PointerPen -- ^ @pen@
  | PointerTouch -- ^ @touch@
  deriving (PointerSubtype -> PointerSubtype -> Bool
(PointerSubtype -> PointerSubtype -> Bool)
-> (PointerSubtype -> PointerSubtype -> Bool) -> Eq PointerSubtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointerSubtype -> PointerSubtype -> Bool
$c/= :: PointerSubtype -> PointerSubtype -> Bool
== :: PointerSubtype -> PointerSubtype -> Bool
$c== :: PointerSubtype -> PointerSubtype -> Bool
Eq, Int -> PointerSubtype -> ShowS
[PointerSubtype] -> ShowS
PointerSubtype -> String
(Int -> PointerSubtype -> ShowS)
-> (PointerSubtype -> String)
-> ([PointerSubtype] -> ShowS)
-> Show PointerSubtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointerSubtype] -> ShowS
$cshowList :: [PointerSubtype] -> ShowS
show :: PointerSubtype -> String
$cshow :: PointerSubtype -> String
showsPrec :: Int -> PointerSubtype -> ShowS
$cshowsPrec :: Int -> PointerSubtype -> ShowS
Show, Int -> PointerSubtype
PointerSubtype -> Int
PointerSubtype -> [PointerSubtype]
PointerSubtype -> PointerSubtype
PointerSubtype -> PointerSubtype -> [PointerSubtype]
PointerSubtype
-> PointerSubtype -> PointerSubtype -> [PointerSubtype]
(PointerSubtype -> PointerSubtype)
-> (PointerSubtype -> PointerSubtype)
-> (Int -> PointerSubtype)
-> (PointerSubtype -> Int)
-> (PointerSubtype -> [PointerSubtype])
-> (PointerSubtype -> PointerSubtype -> [PointerSubtype])
-> (PointerSubtype -> PointerSubtype -> [PointerSubtype])
-> (PointerSubtype
    -> PointerSubtype -> PointerSubtype -> [PointerSubtype])
-> Enum PointerSubtype
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PointerSubtype
-> PointerSubtype -> PointerSubtype -> [PointerSubtype]
$cenumFromThenTo :: PointerSubtype
-> PointerSubtype -> PointerSubtype -> [PointerSubtype]
enumFromTo :: PointerSubtype -> PointerSubtype -> [PointerSubtype]
$cenumFromTo :: PointerSubtype -> PointerSubtype -> [PointerSubtype]
enumFromThen :: PointerSubtype -> PointerSubtype -> [PointerSubtype]
$cenumFromThen :: PointerSubtype -> PointerSubtype -> [PointerSubtype]
enumFrom :: PointerSubtype -> [PointerSubtype]
$cenumFrom :: PointerSubtype -> [PointerSubtype]
fromEnum :: PointerSubtype -> Int
$cfromEnum :: PointerSubtype -> Int
toEnum :: Int -> PointerSubtype
$ctoEnum :: Int -> PointerSubtype
pred :: PointerSubtype -> PointerSubtype
$cpred :: PointerSubtype -> PointerSubtype
succ :: PointerSubtype -> PointerSubtype
$csucc :: PointerSubtype -> PointerSubtype
Enum, PointerSubtype
PointerSubtype -> PointerSubtype -> Bounded PointerSubtype
forall a. a -> a -> Bounded a
maxBound :: PointerSubtype
$cmaxBound :: PointerSubtype
minBound :: PointerSubtype
$cminBound :: PointerSubtype
Bounded)

instance FromJSON PointerSubtype where
  parseJSON :: Value -> Parser PointerSubtype
parseJSON (String Text
x) = case Text
x of
    Text
"mouse" -> PointerSubtype -> Parser PointerSubtype
forall (m :: * -> *) a. Monad m => a -> m a
return PointerSubtype
PointerMouse
    Text
"pen" -> PointerSubtype -> Parser PointerSubtype
forall (m :: * -> *) a. Monad m => a -> m a
return PointerSubtype
PointerPen
    Text
"touch" -> PointerSubtype -> Parser PointerSubtype
forall (m :: * -> *) a. Monad m => a -> m a
return PointerSubtype
PointerTouch
    Text
_ -> Text -> Text -> Parser PointerSubtype
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"PointerSubtype" Text
x
  parseJSON Value
invalid = String -> Value -> Parser PointerSubtype
forall a. String -> Value -> Parser a
typeMismatch String
"PointerSubtype" Value
invalid

instance ToJSON PointerSubtype where
  toJSON :: PointerSubtype -> Value
toJSON PointerSubtype
x = case PointerSubtype
x of 
    PointerSubtype
PointerMouse -> Text -> Value
String Text
"mouse"
    PointerSubtype
PointerPen -> Text -> Value
String Text
"pen"
    PointerSubtype
PointerTouch -> Text -> Value
String Text
"touch"

instance Arbitrary PointerSubtype where
  arbitrary :: Gen PointerSubtype
arbitrary = Gen PointerSubtype
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#processing-actions-requests>.
data Action = Action
  { Action -> Maybe InputSource
_inputSourceType :: Maybe InputSource -- ^ @type@
  , Action -> Maybe Text
_inputSourceId :: Maybe Text -- ^ @id@
  , Action -> Maybe InputSourceParameter
_inputSourceParameters :: Maybe InputSourceParameter -- ^ @parameters@
  , Action -> [ActionItem]
_actionItems :: [ActionItem] -- ^ @actions@
  } deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

instance FromJSON Action where
  parseJSON :: Value -> Parser Action
parseJSON (Object Object
v) = Maybe InputSource
-> Maybe Text
-> Maybe InputSourceParameter
-> [ActionItem]
-> Action
Action
    (Maybe InputSource
 -> Maybe Text
 -> Maybe InputSourceParameter
 -> [ActionItem]
 -> Action)
-> Parser (Maybe InputSource)
-> Parser
     (Maybe Text
      -> Maybe InputSourceParameter -> [ActionItem] -> Action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe InputSource)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
    Parser
  (Maybe Text
   -> Maybe InputSourceParameter -> [ActionItem] -> Action)
-> Parser (Maybe Text)
-> Parser (Maybe InputSourceParameter -> [ActionItem] -> Action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    Parser (Maybe InputSourceParameter -> [ActionItem] -> Action)
-> Parser (Maybe InputSourceParameter)
-> Parser ([ActionItem] -> Action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InputSourceParameter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parameters"
    Parser ([ActionItem] -> Action)
-> Parser [ActionItem] -> Parser Action
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [ActionItem]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"actions"
  parseJSON Value
invalid = String -> Value -> Parser Action
forall a. String -> Value -> Parser a
typeMismatch String
"Action" Value
invalid

instance ToJSON Action where
  toJSON :: Action -> Value
toJSON Action{[ActionItem]
Maybe Text
Maybe InputSourceParameter
Maybe InputSource
_actionItems :: [ActionItem]
_inputSourceParameters :: Maybe InputSourceParameter
_inputSourceId :: Maybe Text
_inputSourceType :: Maybe InputSource
_actionItems :: Action -> [ActionItem]
_inputSourceParameters :: Action -> Maybe InputSourceParameter
_inputSourceId :: Action -> Maybe Text
_inputSourceType :: Action -> Maybe InputSource
..} = [Maybe Pair] -> Value
object_
    [ Text
"type" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (InputSource -> Value
forall a. ToJSON a => a -> Value
toJSON (InputSource -> Value) -> Maybe InputSource -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InputSource
_inputSourceType)
    , Text
"id" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_inputSourceId)
    , Text
"parameters" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (InputSourceParameter -> Value
forall a. ToJSON a => a -> Value
toJSON (InputSourceParameter -> Value)
-> Maybe InputSourceParameter -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InputSourceParameter
_inputSourceParameters)
    , Text
"actions" Text -> [Value] -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv
.== (ActionItem -> Value
forall a. ToJSON a => a -> Value
toJSON (ActionItem -> Value) -> [ActionItem] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ActionItem]
_actionItems)
    ]

instance Arbitrary Action where
  arbitrary :: Gen Action
arbitrary = Maybe InputSource
-> Maybe Text
-> Maybe InputSourceParameter
-> [ActionItem]
-> Action
Action
    (Maybe InputSource
 -> Maybe Text
 -> Maybe InputSourceParameter
 -> [ActionItem]
 -> Action)
-> Gen (Maybe InputSource)
-> Gen
     (Maybe Text
      -> Maybe InputSourceParameter -> [ActionItem] -> Action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe InputSource)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Text
   -> Maybe InputSourceParameter -> [ActionItem] -> Action)
-> Gen (Maybe Text)
-> Gen (Maybe InputSourceParameter -> [ActionItem] -> Action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen (Maybe InputSourceParameter -> [ActionItem] -> Action)
-> Gen (Maybe InputSourceParameter) -> Gen ([ActionItem] -> Action)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe InputSourceParameter)
forall a. Arbitrary a => Gen a
arbitrary
    Gen ([ActionItem] -> Action) -> Gen [ActionItem] -> Gen Action
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [ActionItem]
forall a. Arbitrary a => Gen a
arbitrary

-- | All members set to `Nothing` except `_actionItems`, which is the empty list.
emptyAction :: Action
emptyAction :: Action
emptyAction = Action :: Maybe InputSource
-> Maybe Text
-> Maybe InputSourceParameter
-> [ActionItem]
-> Action
Action
  { _inputSourceType :: Maybe InputSource
_inputSourceType = Maybe InputSource
forall a. Maybe a
Nothing
  , _inputSourceId :: Maybe Text
_inputSourceId = Maybe Text
forall a. Maybe a
Nothing
  , _inputSourceParameters :: Maybe InputSourceParameter
_inputSourceParameters = Maybe InputSourceParameter
forall a. Maybe a
Nothing
  , _actionItems :: [ActionItem]
_actionItems = []
  }



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#terminology-0>.
data ActionType
  = PauseAction -- ^ @pause@
  | KeyUpAction -- ^ @keyUp@
  | KeyDownAction -- ^ @keyDown@
  | PointerDownAction -- ^ @pointerDown@
  | PointerUpAction -- ^ @pointerUp@
  | PointerMoveAction -- ^ @pointerMove@
  | PointerCancelAction -- ^ @pointerCancel@
  deriving (ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c== :: ActionType -> ActionType -> Bool
Eq, Int -> ActionType -> ShowS
[ActionType] -> ShowS
ActionType -> String
(Int -> ActionType -> ShowS)
-> (ActionType -> String)
-> ([ActionType] -> ShowS)
-> Show ActionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionType] -> ShowS
$cshowList :: [ActionType] -> ShowS
show :: ActionType -> String
$cshow :: ActionType -> String
showsPrec :: Int -> ActionType -> ShowS
$cshowsPrec :: Int -> ActionType -> ShowS
Show, Int -> ActionType
ActionType -> Int
ActionType -> [ActionType]
ActionType -> ActionType
ActionType -> ActionType -> [ActionType]
ActionType -> ActionType -> ActionType -> [ActionType]
(ActionType -> ActionType)
-> (ActionType -> ActionType)
-> (Int -> ActionType)
-> (ActionType -> Int)
-> (ActionType -> [ActionType])
-> (ActionType -> ActionType -> [ActionType])
-> (ActionType -> ActionType -> [ActionType])
-> (ActionType -> ActionType -> ActionType -> [ActionType])
-> Enum ActionType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ActionType -> ActionType -> ActionType -> [ActionType]
$cenumFromThenTo :: ActionType -> ActionType -> ActionType -> [ActionType]
enumFromTo :: ActionType -> ActionType -> [ActionType]
$cenumFromTo :: ActionType -> ActionType -> [ActionType]
enumFromThen :: ActionType -> ActionType -> [ActionType]
$cenumFromThen :: ActionType -> ActionType -> [ActionType]
enumFrom :: ActionType -> [ActionType]
$cenumFrom :: ActionType -> [ActionType]
fromEnum :: ActionType -> Int
$cfromEnum :: ActionType -> Int
toEnum :: Int -> ActionType
$ctoEnum :: Int -> ActionType
pred :: ActionType -> ActionType
$cpred :: ActionType -> ActionType
succ :: ActionType -> ActionType
$csucc :: ActionType -> ActionType
Enum, ActionType
ActionType -> ActionType -> Bounded ActionType
forall a. a -> a -> Bounded a
maxBound :: ActionType
$cmaxBound :: ActionType
minBound :: ActionType
$cminBound :: ActionType
Bounded)

instance FromJSON ActionType where
  parseJSON :: Value -> Parser ActionType
parseJSON (String Text
x) = case Text
x of
    Text
"pause" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
PauseAction
    Text
"keyUp" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
KeyUpAction
    Text
"keyDown" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
KeyDownAction
    Text
"pointerDown" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
PointerDownAction
    Text
"pointerUp" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
PointerUpAction
    Text
"pointerMove" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
PointerMoveAction
    Text
"pointerCancel" -> ActionType -> Parser ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
PointerCancelAction
    Text
_ -> Text -> Text -> Parser ActionType
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"ActionType" Text
x
  parseJSON Value
invalid = String -> Value -> Parser ActionType
forall a. String -> Value -> Parser a
typeMismatch String
"ActionType" Value
invalid

instance ToJSON ActionType where
  toJSON :: ActionType -> Value
toJSON ActionType
x = case ActionType
x of
    ActionType
PauseAction -> Text -> Value
String Text
"pause"
    ActionType
KeyUpAction -> Text -> Value
String Text
"keyUp"
    ActionType
KeyDownAction -> Text -> Value
String Text
"keyDown"
    ActionType
PointerDownAction -> Text -> Value
String Text
"pointerDown"
    ActionType
PointerUpAction -> Text -> Value
String Text
"pointerUp"
    ActionType
PointerMoveAction -> Text -> Value
String Text
"pointerMove"
    ActionType
PointerCancelAction -> Text -> Value
String Text
"pointerCancel"

instance Arbitrary ActionType where
  arbitrary :: Gen ActionType
arbitrary = Gen ActionType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-pointer-input-state>.
newtype InputSourceParameter = InputSourceParameter
  { InputSourceParameter -> Maybe PointerSubtype
_pointerSubtype :: Maybe PointerSubtype -- ^ @subtype@
  } deriving (InputSourceParameter -> InputSourceParameter -> Bool
(InputSourceParameter -> InputSourceParameter -> Bool)
-> (InputSourceParameter -> InputSourceParameter -> Bool)
-> Eq InputSourceParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputSourceParameter -> InputSourceParameter -> Bool
$c/= :: InputSourceParameter -> InputSourceParameter -> Bool
== :: InputSourceParameter -> InputSourceParameter -> Bool
$c== :: InputSourceParameter -> InputSourceParameter -> Bool
Eq, Int -> InputSourceParameter -> ShowS
[InputSourceParameter] -> ShowS
InputSourceParameter -> String
(Int -> InputSourceParameter -> ShowS)
-> (InputSourceParameter -> String)
-> ([InputSourceParameter] -> ShowS)
-> Show InputSourceParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputSourceParameter] -> ShowS
$cshowList :: [InputSourceParameter] -> ShowS
show :: InputSourceParameter -> String
$cshow :: InputSourceParameter -> String
showsPrec :: Int -> InputSourceParameter -> ShowS
$cshowsPrec :: Int -> InputSourceParameter -> ShowS
Show)

instance FromJSON InputSourceParameter where
  parseJSON :: Value -> Parser InputSourceParameter
parseJSON (Object Object
v) = Maybe PointerSubtype -> InputSourceParameter
InputSourceParameter
    (Maybe PointerSubtype -> InputSourceParameter)
-> Parser (Maybe PointerSubtype) -> Parser InputSourceParameter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe PointerSubtype)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subtype"
  parseJSON Value
invalid = String -> Value -> Parser InputSourceParameter
forall a. String -> Value -> Parser a
typeMismatch String
"InputSourceParameter" Value
invalid

instance ToJSON InputSourceParameter where
  toJSON :: InputSourceParameter -> Value
toJSON InputSourceParameter{Maybe PointerSubtype
_pointerSubtype :: Maybe PointerSubtype
_pointerSubtype :: InputSourceParameter -> Maybe PointerSubtype
..} = [Maybe Pair] -> Value
object_
    [ Text
"subtype" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (PointerSubtype -> Value
forall a. ToJSON a => a -> Value
toJSON (PointerSubtype -> Value) -> Maybe PointerSubtype -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PointerSubtype
_pointerSubtype)
    ]

instance Arbitrary InputSourceParameter where
  arbitrary :: Gen InputSourceParameter
arbitrary = Maybe PointerSubtype -> InputSourceParameter
InputSourceParameter
    (Maybe PointerSubtype -> InputSourceParameter)
-> Gen (Maybe PointerSubtype) -> Gen InputSourceParameter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe PointerSubtype)
forall a. Arbitrary a => Gen a
arbitrary



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-process-an-input-source-action-sequence>.
data ActionItem = ActionItem
  { ActionItem -> Maybe ActionType
_actionType :: Maybe ActionType -- ^ @type@
  , ActionItem -> Maybe Int
_actionDuration :: Maybe Int -- ^ @duration@
  , ActionItem -> Maybe Text
_actionOrigin :: Maybe Text -- ^ @origin@
  , ActionItem -> Maybe Text
_actionValue :: Maybe Text -- ^ @value@
  , ActionItem -> Maybe Int
_actionButton :: Maybe Int -- ^ @button@
  , ActionItem -> Maybe Int
_actionX :: Maybe Int -- ^ @x@
  , ActionItem -> Maybe Int
_actionY :: Maybe Int -- ^ @y@
  } deriving (ActionItem -> ActionItem -> Bool
(ActionItem -> ActionItem -> Bool)
-> (ActionItem -> ActionItem -> Bool) -> Eq ActionItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionItem -> ActionItem -> Bool
$c/= :: ActionItem -> ActionItem -> Bool
== :: ActionItem -> ActionItem -> Bool
$c== :: ActionItem -> ActionItem -> Bool
Eq, Int -> ActionItem -> ShowS
[ActionItem] -> ShowS
ActionItem -> String
(Int -> ActionItem -> ShowS)
-> (ActionItem -> String)
-> ([ActionItem] -> ShowS)
-> Show ActionItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionItem] -> ShowS
$cshowList :: [ActionItem] -> ShowS
show :: ActionItem -> String
$cshow :: ActionItem -> String
showsPrec :: Int -> ActionItem -> ShowS
$cshowsPrec :: Int -> ActionItem -> ShowS
Show)

instance FromJSON ActionItem where
  parseJSON :: Value -> Parser ActionItem
parseJSON (Object Object
v) = Maybe ActionType
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> ActionItem
ActionItem
    (Maybe ActionType
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> ActionItem)
-> Parser (Maybe ActionType)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> ActionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe ActionType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
    Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> ActionItem)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"duration"
    Parser
  (Maybe Text
   -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"origin"
    Parser
  (Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
-> Parser (Maybe Text)
-> Parser (Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
    Parser (Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"button"
    Parser (Maybe Int -> Maybe Int -> ActionItem)
-> Parser (Maybe Int) -> Parser (Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"x"
    Parser (Maybe Int -> ActionItem)
-> Parser (Maybe Int) -> Parser ActionItem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"y"
  parseJSON Value
invalid = String -> Value -> Parser ActionItem
forall a. String -> Value -> Parser a
typeMismatch String
"ActionItem" Value
invalid

instance ToJSON ActionItem where
  toJSON :: ActionItem -> Value
toJSON ActionItem{Maybe Int
Maybe Text
Maybe ActionType
_actionY :: Maybe Int
_actionX :: Maybe Int
_actionButton :: Maybe Int
_actionValue :: Maybe Text
_actionOrigin :: Maybe Text
_actionDuration :: Maybe Int
_actionType :: Maybe ActionType
_actionY :: ActionItem -> Maybe Int
_actionX :: ActionItem -> Maybe Int
_actionButton :: ActionItem -> Maybe Int
_actionValue :: ActionItem -> Maybe Text
_actionOrigin :: ActionItem -> Maybe Text
_actionDuration :: ActionItem -> Maybe Int
_actionType :: ActionItem -> Maybe ActionType
..} = [Maybe Pair] -> Value
object_
    [ Text
"type" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (ActionType -> Value
forall a. ToJSON a => a -> Value
toJSON (ActionType -> Value) -> Maybe ActionType -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActionType
_actionType)
    , Text
"duration" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_actionDuration)
    , Text
"origin" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_actionOrigin)
    , Text
"value" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_actionValue)
    , Text
"button" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_actionButton)
    , Text
"x" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_actionX)
    , Text
"y" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_actionY)
    ]

instance Arbitrary ActionItem where
  arbitrary :: Gen ActionItem
arbitrary = Maybe ActionType
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> ActionItem
ActionItem
    (Maybe ActionType
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> ActionItem)
-> Gen (Maybe ActionType)
-> Gen
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> ActionItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe ActionType)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> ActionItem)
-> Gen (Maybe Int)
-> Gen
     (Maybe Text
      -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Text
   -> Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
-> Gen (Maybe Text)
-> Gen
     (Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe Text -> Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
-> Gen (Maybe Text)
-> Gen (Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen (Maybe Int -> Maybe Int -> Maybe Int -> ActionItem)
-> Gen (Maybe Int) -> Gen (Maybe Int -> Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Int -> Maybe Int -> ActionItem)
-> Gen (Maybe Int) -> Gen (Maybe Int -> ActionItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Int -> ActionItem) -> Gen (Maybe Int) -> Gen ActionItem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary

-- | All members set to `Nothing`.
emptyActionItem :: ActionItem
emptyActionItem :: ActionItem
emptyActionItem = ActionItem :: Maybe ActionType
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> ActionItem
ActionItem
  { _actionType :: Maybe ActionType
_actionType = Maybe ActionType
forall a. Maybe a
Nothing
  , _actionDuration :: Maybe Int
_actionDuration = Maybe Int
forall a. Maybe a
Nothing
  , _actionOrigin :: Maybe Text
_actionOrigin = Maybe Text
forall a. Maybe a
Nothing
  , _actionValue :: Maybe Text
_actionValue = Maybe Text
forall a. Maybe a
Nothing
  , _actionButton :: Maybe Int
_actionButton = Maybe Int
forall a. Maybe a
Nothing
  , _actionX :: Maybe Int
_actionX = Maybe Int
forall a. Maybe a
Nothing
  , _actionY :: Maybe Int
_actionY = Maybe Int
forall a. Maybe a
Nothing
  }



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-element-rect>.
data Rect = Rect
  { Rect -> Scientific
_rectX :: Scientific -- ^ @x@
  , Rect -> Scientific
_rectY :: Scientific -- ^ @y@
  , Rect -> Scientific
_rectWidth :: Scientific -- ^ @width@
  , Rect -> Scientific
_rectHeight :: Scientific -- ^ @height@
  } deriving (Rect -> Rect -> Bool
(Rect -> Rect -> Bool) -> (Rect -> Rect -> Bool) -> Eq Rect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c== :: Rect -> Rect -> Bool
Eq, Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect] -> ShowS
$cshowList :: [Rect] -> ShowS
show :: Rect -> String
$cshow :: Rect -> String
showsPrec :: Int -> Rect -> ShowS
$cshowsPrec :: Int -> Rect -> ShowS
Show)

instance ToJSON Rect where
  toJSON :: Rect -> Value
toJSON Rect{Scientific
_rectHeight :: Scientific
_rectWidth :: Scientific
_rectY :: Scientific
_rectX :: Scientific
_rectHeight :: Rect -> Scientific
_rectWidth :: Rect -> Scientific
_rectY :: Rect -> Scientific
_rectX :: Rect -> Scientific
..} = [Pair] -> Value
object
    [ Key
"x" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
_rectX
    , Key
"y" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
_rectY
    , Key
"width" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
_rectWidth
    , Key
"height" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
_rectHeight
    ]

instance FromJSON Rect where
  parseJSON :: Value -> Parser Rect
parseJSON (Object Object
v) = Scientific -> Scientific -> Scientific -> Scientific -> Rect
Rect
    (Scientific -> Scientific -> Scientific -> Scientific -> Rect)
-> Parser Scientific
-> Parser (Scientific -> Scientific -> Scientific -> Rect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
    Parser (Scientific -> Scientific -> Scientific -> Rect)
-> Parser Scientific -> Parser (Scientific -> Scientific -> Rect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
    Parser (Scientific -> Scientific -> Rect)
-> Parser Scientific -> Parser (Scientific -> Rect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
    Parser (Scientific -> Rect) -> Parser Scientific -> Parser Rect
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
  parseJSON Value
invalid = String -> Value -> Parser Rect
forall a. String -> Value -> Parser a
typeMismatch String
"Rect" Value
invalid

arbScientific :: Gen Scientific
arbScientific :: Gen Scientific
arbScientific = Integer -> Int -> Scientific
scientific (Integer -> Int -> Scientific)
-> Gen Integer -> Gen (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen (Int -> Scientific) -> Gen Int -> Gen Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
  

instance Arbitrary Rect where
  arbitrary :: Gen Rect
arbitrary = Scientific -> Scientific -> Scientific -> Scientific -> Rect
Rect
    (Scientific -> Scientific -> Scientific -> Scientific -> Rect)
-> Gen Scientific
-> Gen (Scientific -> Scientific -> Scientific -> Rect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
arbScientific
    Gen (Scientific -> Scientific -> Scientific -> Rect)
-> Gen Scientific -> Gen (Scientific -> Scientific -> Rect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scientific
arbScientific
    Gen (Scientific -> Scientific -> Rect)
-> Gen Scientific -> Gen (Scientific -> Rect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scientific
arbScientific
    Gen (Scientific -> Rect) -> Gen Scientific -> Gen Rect
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scientific
arbScientific

-- | All members set to `0`.
emptyRect :: Rect
emptyRect :: Rect
emptyRect = Rect :: Scientific -> Scientific -> Scientific -> Scientific -> Rect
Rect
  { _rectX :: Scientific
_rectX = Scientific
0
  , _rectY :: Scientific
_rectY = Scientific
0
  , _rectWidth :: Scientific
_rectWidth = Scientific
0
  , _rectHeight :: Scientific
_rectHeight = Scientific
0
  }



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-known-prompt-handling-approaches-table>.
data PromptHandler
  = DismissPrompts -- ^ @dismiss@
  | AcceptPrompts -- ^ @accept@
  | DismissPromptsAndNotify -- ^ @dismiss and notify@
  | AcceptPromptsAndNotify -- ^ @accept and notify@
  | IgnorePrompts -- ^ @ignore@
  deriving (PromptHandler -> PromptHandler -> Bool
(PromptHandler -> PromptHandler -> Bool)
-> (PromptHandler -> PromptHandler -> Bool) -> Eq PromptHandler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PromptHandler -> PromptHandler -> Bool
$c/= :: PromptHandler -> PromptHandler -> Bool
== :: PromptHandler -> PromptHandler -> Bool
$c== :: PromptHandler -> PromptHandler -> Bool
Eq, Int -> PromptHandler -> ShowS
[PromptHandler] -> ShowS
PromptHandler -> String
(Int -> PromptHandler -> ShowS)
-> (PromptHandler -> String)
-> ([PromptHandler] -> ShowS)
-> Show PromptHandler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PromptHandler] -> ShowS
$cshowList :: [PromptHandler] -> ShowS
show :: PromptHandler -> String
$cshow :: PromptHandler -> String
showsPrec :: Int -> PromptHandler -> ShowS
$cshowsPrec :: Int -> PromptHandler -> ShowS
Show, Int -> PromptHandler
PromptHandler -> Int
PromptHandler -> [PromptHandler]
PromptHandler -> PromptHandler
PromptHandler -> PromptHandler -> [PromptHandler]
PromptHandler -> PromptHandler -> PromptHandler -> [PromptHandler]
(PromptHandler -> PromptHandler)
-> (PromptHandler -> PromptHandler)
-> (Int -> PromptHandler)
-> (PromptHandler -> Int)
-> (PromptHandler -> [PromptHandler])
-> (PromptHandler -> PromptHandler -> [PromptHandler])
-> (PromptHandler -> PromptHandler -> [PromptHandler])
-> (PromptHandler
    -> PromptHandler -> PromptHandler -> [PromptHandler])
-> Enum PromptHandler
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PromptHandler -> PromptHandler -> PromptHandler -> [PromptHandler]
$cenumFromThenTo :: PromptHandler -> PromptHandler -> PromptHandler -> [PromptHandler]
enumFromTo :: PromptHandler -> PromptHandler -> [PromptHandler]
$cenumFromTo :: PromptHandler -> PromptHandler -> [PromptHandler]
enumFromThen :: PromptHandler -> PromptHandler -> [PromptHandler]
$cenumFromThen :: PromptHandler -> PromptHandler -> [PromptHandler]
enumFrom :: PromptHandler -> [PromptHandler]
$cenumFrom :: PromptHandler -> [PromptHandler]
fromEnum :: PromptHandler -> Int
$cfromEnum :: PromptHandler -> Int
toEnum :: Int -> PromptHandler
$ctoEnum :: Int -> PromptHandler
pred :: PromptHandler -> PromptHandler
$cpred :: PromptHandler -> PromptHandler
succ :: PromptHandler -> PromptHandler
$csucc :: PromptHandler -> PromptHandler
Enum, PromptHandler
PromptHandler -> PromptHandler -> Bounded PromptHandler
forall a. a -> a -> Bounded a
maxBound :: PromptHandler
$cmaxBound :: PromptHandler
minBound :: PromptHandler
$cminBound :: PromptHandler
Bounded)

instance FromJSON PromptHandler where
  parseJSON :: Value -> Parser PromptHandler
parseJSON (String Text
x) = case Text
x of
    Text
"dismiss" -> PromptHandler -> Parser PromptHandler
forall (m :: * -> *) a. Monad m => a -> m a
return PromptHandler
DismissPrompts
    Text
"accept" -> PromptHandler -> Parser PromptHandler
forall (m :: * -> *) a. Monad m => a -> m a
return PromptHandler
AcceptPrompts
    Text
"dismiss and notify" -> PromptHandler -> Parser PromptHandler
forall (m :: * -> *) a. Monad m => a -> m a
return PromptHandler
DismissPromptsAndNotify
    Text
"accept and notify" -> PromptHandler -> Parser PromptHandler
forall (m :: * -> *) a. Monad m => a -> m a
return PromptHandler
AcceptPromptsAndNotify
    Text
"ignore" -> PromptHandler -> Parser PromptHandler
forall (m :: * -> *) a. Monad m => a -> m a
return PromptHandler
IgnorePrompts
    Text
_ -> Text -> Text -> Parser PromptHandler
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"PromptHandler" Text
x
  parseJSON Value
invalid = String -> Value -> Parser PromptHandler
forall a. String -> Value -> Parser a
typeMismatch String
"PromptHandler" Value
invalid

instance ToJSON PromptHandler where
  toJSON :: PromptHandler -> Value
toJSON PromptHandler
x = case PromptHandler
x of
    PromptHandler
DismissPrompts -> Text -> Value
String Text
"dismiss"
    PromptHandler
AcceptPrompts -> Text -> Value
String Text
"accept"
    PromptHandler
DismissPromptsAndNotify -> Text -> Value
String Text
"dismiss and notify"
    PromptHandler
AcceptPromptsAndNotify -> Text -> Value
String Text
"accept and notify"
    PromptHandler
IgnorePrompts -> Text -> Value
String Text
"ignore"

instance Arbitrary PromptHandler where
  arbitrary :: Gen PromptHandler
arbitrary = Gen PromptHandler
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-table-for-cookie-conversion>.
data Cookie = Cookie
  { Cookie -> Maybe Text
_cookieName :: Maybe Text -- ^ @name@
  , Cookie -> Maybe Text
_cookieValue :: Maybe Text -- ^ @value@
  , Cookie -> Maybe Text
_cookiePath :: Maybe Text -- ^ @path@
  , Cookie -> Maybe Text
_cookieDomain :: Maybe Text -- ^ @domain@
  , Cookie -> Maybe Bool
_cookieSecure :: Maybe Bool -- ^ @secure@
  , Cookie -> Maybe Bool
_cookieHttpOnly :: Maybe Bool -- ^ @httpOnly@
  , Cookie -> Maybe Text
_cookieExpiryTime :: Maybe Text -- ^ @expiryTime@
  } deriving (Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c== :: Cookie -> Cookie -> Bool
Eq, Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cookie] -> ShowS
$cshowList :: [Cookie] -> ShowS
show :: Cookie -> String
$cshow :: Cookie -> String
showsPrec :: Int -> Cookie -> ShowS
$cshowsPrec :: Int -> Cookie -> ShowS
Show)

instance ToJSON Cookie where
  toJSON :: Cookie -> Value
toJSON Cookie{Maybe Bool
Maybe Text
_cookieExpiryTime :: Maybe Text
_cookieHttpOnly :: Maybe Bool
_cookieSecure :: Maybe Bool
_cookieDomain :: Maybe Text
_cookiePath :: Maybe Text
_cookieValue :: Maybe Text
_cookieName :: Maybe Text
_cookieExpiryTime :: Cookie -> Maybe Text
_cookieHttpOnly :: Cookie -> Maybe Bool
_cookieSecure :: Cookie -> Maybe Bool
_cookieDomain :: Cookie -> Maybe Text
_cookiePath :: Cookie -> Maybe Text
_cookieValue :: Cookie -> Maybe Text
_cookieName :: Cookie -> Maybe Text
..} = [Maybe Pair] -> Value
object_
    [ Text
"name" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_cookieName)
    , Text
"value" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_cookieValue)
    , Text
"path" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_cookiePath)
    , Text
"domain" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_cookieDomain)
    , Text
"secure" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_cookieSecure)
    , Text
"httpOnly" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_cookieHttpOnly)
    , Text
"expiryTime" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_cookieExpiryTime)
    ]

instance FromJSON Cookie where
  parseJSON :: Value -> Parser Cookie
parseJSON (Object Object
v) = Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Cookie
Cookie
    (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Cookie)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Cookie)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Cookie)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
    Parser
  (Maybe Text
   -> Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path"
    Parser
  (Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"domain"
    Parser (Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"secure"
    Parser (Maybe Bool -> Maybe Text -> Cookie)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"httpOnly"
    Parser (Maybe Text -> Cookie)
-> Parser (Maybe Text) -> Parser Cookie
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expiryTime"
  parseJSON Value
invalid = String -> Value -> Parser Cookie
forall a. String -> Value -> Parser a
typeMismatch String
"Cookie" Value
invalid

instance Arbitrary Cookie where
  arbitrary :: Gen Cookie
arbitrary = Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Cookie
Cookie
    (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Cookie)
-> Gen (Maybe Text)
-> Gen
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Cookie)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Cookie)
-> Gen (Maybe Text)
-> Gen
     (Maybe Text
      -> Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe Text
   -> Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
-> Gen (Maybe Text)
-> Gen
     (Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen
  (Maybe Text -> Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
-> Gen (Maybe Text)
-> Gen (Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)
    Gen (Maybe Bool -> Maybe Bool -> Maybe Text -> Cookie)
-> Gen (Maybe Bool) -> Gen (Maybe Bool -> Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Bool)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Bool -> Maybe Text -> Cookie)
-> Gen (Maybe Bool) -> Gen (Maybe Text -> Cookie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Bool)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Text -> Cookie) -> Gen (Maybe Text) -> Gen Cookie
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe String -> Maybe Text)
-> Gen (Maybe String) -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary)

-- | All members set to `Nothing`.
emptyCookie :: Cookie
emptyCookie :: Cookie
emptyCookie = Cookie :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Cookie
Cookie
  { _cookieName :: Maybe Text
_cookieName = Maybe Text
forall a. Maybe a
Nothing
  , _cookieValue :: Maybe Text
_cookieValue = Maybe Text
forall a. Maybe a
Nothing
  , _cookiePath :: Maybe Text
_cookiePath = Maybe Text
forall a. Maybe a
Nothing
  , _cookieDomain :: Maybe Text
_cookieDomain = Maybe Text
forall a. Maybe a
Nothing
  , _cookieSecure :: Maybe Bool
_cookieSecure = Maybe Bool
forall a. Maybe a
Nothing
  , _cookieHttpOnly :: Maybe Bool
_cookieHttpOnly = Maybe Bool
forall a. Maybe a
Nothing
  , _cookieExpiryTime :: Maybe Text
_cookieExpiryTime = Maybe Text
forall a. Maybe a
Nothing
  }

-- | All members other than @name@ and @value@ set to `Nothing`.
cookie
  :: Text -- ^ @name@
  -> Text -- ^ @value@
  -> Cookie
cookie :: Text -> Text -> Cookie
cookie Text
name Text
value = Cookie
emptyCookie
  { _cookieName :: Maybe Text
_cookieName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
  , _cookieValue :: Maybe Text
_cookieValue = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
value
  }



-- | See <https://w3c.github.io/webdriver/#print-page>
data PrintOptions = PrintOptions
  { PrintOptions -> Maybe Orientation
_orientation :: Maybe Orientation -- ^ @orientation@
  , PrintOptions -> Maybe Scale
_scale :: Maybe Scale -- ^ @scale@
  , PrintOptions -> Maybe Bool
_background :: Maybe Bool -- ^ @background@
  , PrintOptions -> Maybe Page
_page :: Maybe Page -- ^ @page@
  , PrintOptions -> Maybe Margin
_margin :: Maybe Margin -- ^ @margin@
  , PrintOptions -> Maybe Bool
_shrinkToFit :: Maybe Bool -- ^ @shrinkToFit@
  , PrintOptions -> Maybe [PageRange]
_pageRanges :: Maybe [PageRange] -- ^ @pageRanges@
  } deriving (PrintOptions -> PrintOptions -> Bool
(PrintOptions -> PrintOptions -> Bool)
-> (PrintOptions -> PrintOptions -> Bool) -> Eq PrintOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrintOptions -> PrintOptions -> Bool
$c/= :: PrintOptions -> PrintOptions -> Bool
== :: PrintOptions -> PrintOptions -> Bool
$c== :: PrintOptions -> PrintOptions -> Bool
Eq, Int -> PrintOptions -> ShowS
[PrintOptions] -> ShowS
PrintOptions -> String
(Int -> PrintOptions -> ShowS)
-> (PrintOptions -> String)
-> ([PrintOptions] -> ShowS)
-> Show PrintOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrintOptions] -> ShowS
$cshowList :: [PrintOptions] -> ShowS
show :: PrintOptions -> String
$cshow :: PrintOptions -> String
showsPrec :: Int -> PrintOptions -> ShowS
$cshowsPrec :: Int -> PrintOptions -> ShowS
Show)

defaultPrintOptions :: PrintOptions
defaultPrintOptions :: PrintOptions
defaultPrintOptions = PrintOptions :: Maybe Orientation
-> Maybe Scale
-> Maybe Bool
-> Maybe Page
-> Maybe Margin
-> Maybe Bool
-> Maybe [PageRange]
-> PrintOptions
PrintOptions
  { _orientation :: Maybe Orientation
_orientation = Maybe Orientation
forall a. Maybe a
Nothing
  , _scale :: Maybe Scale
_scale = Maybe Scale
forall a. Maybe a
Nothing
  , _background :: Maybe Bool
_background = Maybe Bool
forall a. Maybe a
Nothing
  , _page :: Maybe Page
_page = Maybe Page
forall a. Maybe a
Nothing
  , _margin :: Maybe Margin
_margin = Maybe Margin
forall a. Maybe a
Nothing
  , _shrinkToFit :: Maybe Bool
_shrinkToFit = Maybe Bool
forall a. Maybe a
Nothing
  , _pageRanges :: Maybe [PageRange]
_pageRanges = Maybe [PageRange]
forall a. Maybe a
Nothing
  }

instance ToJSON PrintOptions where
  toJSON :: PrintOptions -> Value
toJSON PrintOptions{Maybe Bool
Maybe [PageRange]
Maybe Margin
Maybe Page
Maybe Scale
Maybe Orientation
_pageRanges :: Maybe [PageRange]
_shrinkToFit :: Maybe Bool
_margin :: Maybe Margin
_page :: Maybe Page
_background :: Maybe Bool
_scale :: Maybe Scale
_orientation :: Maybe Orientation
_pageRanges :: PrintOptions -> Maybe [PageRange]
_shrinkToFit :: PrintOptions -> Maybe Bool
_margin :: PrintOptions -> Maybe Margin
_page :: PrintOptions -> Maybe Page
_background :: PrintOptions -> Maybe Bool
_scale :: PrintOptions -> Maybe Scale
_orientation :: PrintOptions -> Maybe Orientation
..} = [Maybe Pair] -> Value
object_
    [ Text
"orientation" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Orientation -> Value
forall a. ToJSON a => a -> Value
toJSON (Orientation -> Value) -> Maybe Orientation -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Orientation
_orientation)
    , Text
"scale" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scale -> Value
forall a. ToJSON a => a -> Value
toJSON (Scale -> Value) -> Maybe Scale -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scale
_scale)
    , Text
"background" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_background)
    , Text
"page" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Page -> Value
forall a. ToJSON a => a -> Value
toJSON (Page -> Value) -> Maybe Page -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Page
_page)
    , Text
"margin" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Margin -> Value
forall a. ToJSON a => a -> Value
toJSON (Margin -> Value) -> Maybe Margin -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Margin
_margin)
    , Text
"shrinkToFit" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_shrinkToFit)
    , Text
"pageRanges" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? ([PageRange] -> Value
forall a. ToJSON a => a -> Value
toJSON ([PageRange] -> Value) -> Maybe [PageRange] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [PageRange]
_pageRanges)
    ]

instance FromJSON PrintOptions where
  parseJSON :: Value -> Parser PrintOptions
parseJSON (Object Object
v) = Maybe Orientation
-> Maybe Scale
-> Maybe Bool
-> Maybe Page
-> Maybe Margin
-> Maybe Bool
-> Maybe [PageRange]
-> PrintOptions
PrintOptions
    (Maybe Orientation
 -> Maybe Scale
 -> Maybe Bool
 -> Maybe Page
 -> Maybe Margin
 -> Maybe Bool
 -> Maybe [PageRange]
 -> PrintOptions)
-> Parser (Maybe Orientation)
-> Parser
     (Maybe Scale
      -> Maybe Bool
      -> Maybe Page
      -> Maybe Margin
      -> Maybe Bool
      -> Maybe [PageRange]
      -> PrintOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Orientation)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"orientation"
    Parser
  (Maybe Scale
   -> Maybe Bool
   -> Maybe Page
   -> Maybe Margin
   -> Maybe Bool
   -> Maybe [PageRange]
   -> PrintOptions)
-> Parser (Maybe Scale)
-> Parser
     (Maybe Bool
      -> Maybe Page
      -> Maybe Margin
      -> Maybe Bool
      -> Maybe [PageRange]
      -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scale)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scale"
    Parser
  (Maybe Bool
   -> Maybe Page
   -> Maybe Margin
   -> Maybe Bool
   -> Maybe [PageRange]
   -> PrintOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Page
      -> Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"background"
    Parser
  (Maybe Page
   -> Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
-> Parser (Maybe Page)
-> Parser
     (Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Page)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page"
    Parser
  (Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
-> Parser (Maybe Margin)
-> Parser (Maybe Bool -> Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Margin)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"margin"
    Parser (Maybe Bool -> Maybe [PageRange] -> PrintOptions)
-> Parser (Maybe Bool)
-> Parser (Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"shrinkToFit"
    Parser (Maybe [PageRange] -> PrintOptions)
-> Parser (Maybe [PageRange]) -> Parser PrintOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [PageRange])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pageRanges"
  parseJSON Value
invalid = String -> Value -> Parser PrintOptions
forall a. String -> Value -> Parser a
typeMismatch String
"PrintOptions" Value
invalid

instance Arbitrary PrintOptions where
  arbitrary :: Gen PrintOptions
arbitrary = Maybe Orientation
-> Maybe Scale
-> Maybe Bool
-> Maybe Page
-> Maybe Margin
-> Maybe Bool
-> Maybe [PageRange]
-> PrintOptions
PrintOptions
    (Maybe Orientation
 -> Maybe Scale
 -> Maybe Bool
 -> Maybe Page
 -> Maybe Margin
 -> Maybe Bool
 -> Maybe [PageRange]
 -> PrintOptions)
-> Gen (Maybe Orientation)
-> Gen
     (Maybe Scale
      -> Maybe Bool
      -> Maybe Page
      -> Maybe Margin
      -> Maybe Bool
      -> Maybe [PageRange]
      -> PrintOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe Orientation)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Scale
   -> Maybe Bool
   -> Maybe Page
   -> Maybe Margin
   -> Maybe Bool
   -> Maybe [PageRange]
   -> PrintOptions)
-> Gen (Maybe Scale)
-> Gen
     (Maybe Bool
      -> Maybe Page
      -> Maybe Margin
      -> Maybe Bool
      -> Maybe [PageRange]
      -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Scale)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Bool
   -> Maybe Page
   -> Maybe Margin
   -> Maybe Bool
   -> Maybe [PageRange]
   -> PrintOptions)
-> Gen (Maybe Bool)
-> Gen
     (Maybe Page
      -> Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Bool)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Page
   -> Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
-> Gen (Maybe Page)
-> Gen
     (Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Page)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe Margin -> Maybe Bool -> Maybe [PageRange] -> PrintOptions)
-> Gen (Maybe Margin)
-> Gen (Maybe Bool -> Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Margin)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe Bool -> Maybe [PageRange] -> PrintOptions)
-> Gen (Maybe Bool) -> Gen (Maybe [PageRange] -> PrintOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Bool)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe [PageRange] -> PrintOptions)
-> Gen (Maybe [PageRange]) -> Gen PrintOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe [PageRange])
forall a. Arbitrary a => Gen a
arbitrary



data Orientation
  = Landscape
  | Portrait
  deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, Int -> Orientation
Orientation -> Int
Orientation -> [Orientation]
Orientation -> Orientation
Orientation -> Orientation -> [Orientation]
Orientation -> Orientation -> Orientation -> [Orientation]
(Orientation -> Orientation)
-> (Orientation -> Orientation)
-> (Int -> Orientation)
-> (Orientation -> Int)
-> (Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> Orientation -> [Orientation])
-> Enum Orientation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
$cenumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
enumFromTo :: Orientation -> Orientation -> [Orientation]
$cenumFromTo :: Orientation -> Orientation -> [Orientation]
enumFromThen :: Orientation -> Orientation -> [Orientation]
$cenumFromThen :: Orientation -> Orientation -> [Orientation]
enumFrom :: Orientation -> [Orientation]
$cenumFrom :: Orientation -> [Orientation]
fromEnum :: Orientation -> Int
$cfromEnum :: Orientation -> Int
toEnum :: Int -> Orientation
$ctoEnum :: Int -> Orientation
pred :: Orientation -> Orientation
$cpred :: Orientation -> Orientation
succ :: Orientation -> Orientation
$csucc :: Orientation -> Orientation
Enum, Orientation
Orientation -> Orientation -> Bounded Orientation
forall a. a -> a -> Bounded a
maxBound :: Orientation
$cmaxBound :: Orientation
minBound :: Orientation
$cminBound :: Orientation
Bounded)

instance FromJSON Orientation where
  parseJSON :: Value -> Parser Orientation
parseJSON (String Text
x) = case Text
x of
    Text
"landscape" -> Orientation -> Parser Orientation
forall (m :: * -> *) a. Monad m => a -> m a
return Orientation
Landscape
    Text
"portrait" -> Orientation -> Parser Orientation
forall (m :: * -> *) a. Monad m => a -> m a
return Orientation
Portrait
    Text
_ -> Text -> Text -> Parser Orientation
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
unrecognizedValue Text
"Orientation" Text
x
  parseJSON Value
invalid = String -> Value -> Parser Orientation
forall a. String -> Value -> Parser a
typeMismatch String
"Orientation" Value
invalid

instance ToJSON Orientation where
  toJSON :: Orientation -> Value
toJSON Orientation
x = case Orientation
x of
    Orientation
Landscape -> Text -> Value
String Text
"landscape"
    Orientation
Portrait -> Text -> Value
String Text
"portrait"

instance Arbitrary Orientation where
  arbitrary :: Gen Orientation
arbitrary = Gen Orientation
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum



newtype Scale
  = Scale Scientific
  deriving (Scale -> Scale -> Bool
(Scale -> Scale -> Bool) -> (Scale -> Scale -> Bool) -> Eq Scale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c== :: Scale -> Scale -> Bool
Eq, Int -> Scale -> ShowS
[Scale] -> ShowS
Scale -> String
(Int -> Scale -> ShowS)
-> (Scale -> String) -> ([Scale] -> ShowS) -> Show Scale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scale] -> ShowS
$cshowList :: [Scale] -> ShowS
show :: Scale -> String
$cshow :: Scale -> String
showsPrec :: Int -> Scale -> ShowS
$cshowsPrec :: Int -> Scale -> ShowS
Show)

instance ToJSON Scale where
  toJSON :: Scale -> Value
toJSON (Scale Scientific
x) = Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
x

instance FromJSON Scale where
  parseJSON :: Value -> Parser Scale
parseJSON = (Scientific -> Scale) -> Parser Scientific -> Parser Scale
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scientific -> Scale
Scale (Parser Scientific -> Parser Scale)
-> (Value -> Parser Scientific) -> Value -> Parser Scale
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON

instance Arbitrary Scale where -- TODO: fix this
  arbitrary :: Gen Scale
arbitrary = Scientific -> Scale
Scale
    (Scientific -> Scale) -> Gen Scientific -> Gen Scale
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements
      [ Scientific
0.1, Scientific
0.2, Scientific
0.3, Scientific
0.4, Scientific
0.5, Scientific
0.6, Scientific
0.7, Scientific
0.8, Scientific
0.9, Scientific
1.0
      , Scientific
1.1, Scientific
1.2, Scientific
1.3, Scientific
1.4, Scientific
1.5, Scientific
1.6, Scientific
1.7, Scientific
1.8, Scientific
1.9, Scientific
2.0
      ]



data Page = Page
  { Page -> Maybe Scientific
_pageWidth :: Maybe Scientific -- ^ @pageWidth@
  , Page -> Maybe Scientific
_pageHeight :: Maybe Scientific -- ^ @pageHeight@
  } deriving (Page -> Page -> Bool
(Page -> Page -> Bool) -> (Page -> Page -> Bool) -> Eq Page
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Page -> Page -> Bool
$c/= :: Page -> Page -> Bool
== :: Page -> Page -> Bool
$c== :: Page -> Page -> Bool
Eq, Int -> Page -> ShowS
[Page] -> ShowS
Page -> String
(Int -> Page -> ShowS)
-> (Page -> String) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Page] -> ShowS
$cshowList :: [Page] -> ShowS
show :: Page -> String
$cshow :: Page -> String
showsPrec :: Int -> Page -> ShowS
$cshowsPrec :: Int -> Page -> ShowS
Show)

defaultPage :: Page
defaultPage :: Page
defaultPage = Page :: Maybe Scientific -> Maybe Scientific -> Page
Page
  { _pageWidth :: Maybe Scientific
_pageWidth = Maybe Scientific
forall a. Maybe a
Nothing
  , _pageHeight :: Maybe Scientific
_pageHeight = Maybe Scientific
forall a. Maybe a
Nothing
  }

instance ToJSON Page where
  toJSON :: Page -> Value
toJSON Page{Maybe Scientific
_pageHeight :: Maybe Scientific
_pageWidth :: Maybe Scientific
_pageHeight :: Page -> Maybe Scientific
_pageWidth :: Page -> Maybe Scientific
..} = [Maybe Pair] -> Value
object_
    [ Text
"pageWidth" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
_pageWidth)
    , Text
"pageHeight" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
_pageHeight)
    ]

instance FromJSON Page where
  parseJSON :: Value -> Parser Page
parseJSON (Object Object
v) = Maybe Scientific -> Maybe Scientific -> Page
Page
    (Maybe Scientific -> Maybe Scientific -> Page)
-> Parser (Maybe Scientific) -> Parser (Maybe Scientific -> Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pageWidth"
    Parser (Maybe Scientific -> Page)
-> Parser (Maybe Scientific) -> Parser Page
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pageHeight"
  parseJSON Value
invalid = String -> Value -> Parser Page
forall a. String -> Value -> Parser a
typeMismatch String
"Page" Value
invalid

instance Arbitrary Page where
  arbitrary :: Gen Page
arbitrary =
    let
      margins :: [Scientific]
margins = (Scientific -> Scientific) -> [Scientific] -> [Scientific]
forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Scientific
forall a. Num a => a -> a
negate
        [ Scientific
0.0, Scientific
0.1, Scientific
0.2, Scientific
0.3, Scientific
0.4, Scientific
0.5, Scientific
0.6, Scientific
0.7, Scientific
0.8, Scientific
0.9
        , Scientific
1.0, Scientific
1.1, Scientific
1.2, Scientific
1.3, Scientific
1.4, Scientific
1.5, Scientific
1.6, Scientific
1.7, Scientific
1.8, Scientific
1.9
        ]
    in Maybe Scientific -> Maybe Scientific -> Page
Page
      (Maybe Scientific -> Maybe Scientific -> Page)
-> Gen (Maybe Scientific) -> Gen (Maybe Scientific -> Page)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Maybe Scientific)] -> Gen (Maybe Scientific)
forall a. [Gen a] -> Gen a
oneof [ Maybe Scientific -> Gen (Maybe Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scientific
forall a. Maybe a
Nothing, Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> Gen Scientific -> Gen (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements ((Scientific -> Scientific) -> [Scientific] -> [Scientific]
forall a b. (a -> b) -> [a] -> [b]
map (Scientific
27.94 Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+) [Scientific]
margins) ]
      Gen (Maybe Scientific -> Page)
-> Gen (Maybe Scientific) -> Gen Page
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe Scientific)] -> Gen (Maybe Scientific)
forall a. [Gen a] -> Gen a
oneof [ Maybe Scientific -> Gen (Maybe Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scientific
forall a. Maybe a
Nothing, Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> Gen Scientific -> Gen (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements ((Scientific -> Scientific) -> [Scientific] -> [Scientific]
forall a b. (a -> b) -> [a] -> [b]
map (Scientific
21.59 Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+) [Scientific]
margins) ]



data Margin = Margin
  { Margin -> Maybe Scientific
_marginTop :: Maybe Scientific -- ^ @marginTop@
  , Margin -> Maybe Scientific
_marginBottom :: Maybe Scientific -- ^ @marginBottom@
  , Margin -> Maybe Scientific
_marginLeft :: Maybe Scientific -- ^ @marginLeft@
  , Margin -> Maybe Scientific
_marginRight :: Maybe Scientific -- ^ @marginRight@
  } deriving (Margin -> Margin -> Bool
(Margin -> Margin -> Bool)
-> (Margin -> Margin -> Bool) -> Eq Margin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Margin -> Margin -> Bool
$c/= :: Margin -> Margin -> Bool
== :: Margin -> Margin -> Bool
$c== :: Margin -> Margin -> Bool
Eq, Int -> Margin -> ShowS
[Margin] -> ShowS
Margin -> String
(Int -> Margin -> ShowS)
-> (Margin -> String) -> ([Margin] -> ShowS) -> Show Margin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Margin] -> ShowS
$cshowList :: [Margin] -> ShowS
show :: Margin -> String
$cshow :: Margin -> String
showsPrec :: Int -> Margin -> ShowS
$cshowsPrec :: Int -> Margin -> ShowS
Show)

defaultMargin :: Margin
defaultMargin :: Margin
defaultMargin = Margin :: Maybe Scientific
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Scientific
-> Margin
Margin
  { _marginTop :: Maybe Scientific
_marginTop = Maybe Scientific
forall a. Maybe a
Nothing
  , _marginBottom :: Maybe Scientific
_marginBottom = Maybe Scientific
forall a. Maybe a
Nothing
  , _marginLeft :: Maybe Scientific
_marginLeft = Maybe Scientific
forall a. Maybe a
Nothing
  , _marginRight :: Maybe Scientific
_marginRight = Maybe Scientific
forall a. Maybe a
Nothing
  }

instance ToJSON Margin where
  toJSON :: Margin -> Value
toJSON Margin{Maybe Scientific
_marginRight :: Maybe Scientific
_marginLeft :: Maybe Scientific
_marginBottom :: Maybe Scientific
_marginTop :: Maybe Scientific
_marginRight :: Margin -> Maybe Scientific
_marginLeft :: Margin -> Maybe Scientific
_marginBottom :: Margin -> Maybe Scientific
_marginTop :: Margin -> Maybe Scientific
..} = [Maybe Pair] -> Value
object_
    [ Text
"marginTop" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
_marginTop)
    , Text
"marginBottom" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
_marginBottom)
    , Text
"marginLeft" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
_marginLeft)
    , Text
"marginRight" Text -> Maybe Value -> Maybe Pair
forall v kv. (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv
.=? (Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
_marginRight)
    ]

instance FromJSON Margin where
  parseJSON :: Value -> Parser Margin
parseJSON (Object Object
v) = Maybe Scientific
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Scientific
-> Margin
Margin
    (Maybe Scientific
 -> Maybe Scientific
 -> Maybe Scientific
 -> Maybe Scientific
 -> Margin)
-> Parser (Maybe Scientific)
-> Parser
     (Maybe Scientific
      -> Maybe Scientific -> Maybe Scientific -> Margin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"marginTop"
    Parser
  (Maybe Scientific
   -> Maybe Scientific -> Maybe Scientific -> Margin)
-> Parser (Maybe Scientific)
-> Parser (Maybe Scientific -> Maybe Scientific -> Margin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"marginBottom"
    Parser (Maybe Scientific -> Maybe Scientific -> Margin)
-> Parser (Maybe Scientific) -> Parser (Maybe Scientific -> Margin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"marginLeft"
    Parser (Maybe Scientific -> Margin)
-> Parser (Maybe Scientific) -> Parser Margin
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"marginRight"
  parseJSON Value
invalid = String -> Value -> Parser Margin
forall a. String -> Value -> Parser a
typeMismatch String
"Margin" Value
invalid

instance Arbitrary Margin where
  arbitrary :: Gen Margin
arbitrary =
    let
      margins :: [Scientific]
margins =
        [ Scientific
0.0, Scientific
0.1, Scientific
0.2, Scientific
0.3, Scientific
0.4, Scientific
0.5, Scientific
0.6, Scientific
0.7, Scientific
0.8, Scientific
0.9
        , Scientific
1.0, Scientific
1.1, Scientific
1.2, Scientific
1.3, Scientific
1.4, Scientific
1.5, Scientific
1.6, Scientific
1.7, Scientific
1.8, Scientific
1.9
        ]
    in Maybe Scientific
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Scientific
-> Margin
Margin
      (Maybe Scientific
 -> Maybe Scientific
 -> Maybe Scientific
 -> Maybe Scientific
 -> Margin)
-> Gen (Maybe Scientific)
-> Gen
     (Maybe Scientific
      -> Maybe Scientific -> Maybe Scientific -> Margin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Maybe Scientific)] -> Gen (Maybe Scientific)
forall a. [Gen a] -> Gen a
oneof [ Maybe Scientific -> Gen (Maybe Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scientific
forall a. Maybe a
Nothing, Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> Gen Scientific -> Gen (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements [Scientific]
margins ]
      Gen
  (Maybe Scientific
   -> Maybe Scientific -> Maybe Scientific -> Margin)
-> Gen (Maybe Scientific)
-> Gen (Maybe Scientific -> Maybe Scientific -> Margin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe Scientific)] -> Gen (Maybe Scientific)
forall a. [Gen a] -> Gen a
oneof [ Maybe Scientific -> Gen (Maybe Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scientific
forall a. Maybe a
Nothing, Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> Gen Scientific -> Gen (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements [Scientific]
margins ]
      Gen (Maybe Scientific -> Maybe Scientific -> Margin)
-> Gen (Maybe Scientific) -> Gen (Maybe Scientific -> Margin)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe Scientific)] -> Gen (Maybe Scientific)
forall a. [Gen a] -> Gen a
oneof [ Maybe Scientific -> Gen (Maybe Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scientific
forall a. Maybe a
Nothing, Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> Gen Scientific -> Gen (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements [Scientific]
margins ]
      Gen (Maybe Scientific -> Margin)
-> Gen (Maybe Scientific) -> Gen Margin
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe Scientific)] -> Gen (Maybe Scientific)
forall a. [Gen a] -> Gen a
oneof [ Maybe Scientific -> Gen (Maybe Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scientific
forall a. Maybe a
Nothing, Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> Gen Scientific -> Gen (Maybe Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Scientific] -> Gen Scientific
forall a. [a] -> Gen a
elements [Scientific]
margins ]



data PageRange
  = OnePage Int
  | PageRange Int Int
  deriving (PageRange -> PageRange -> Bool
(PageRange -> PageRange -> Bool)
-> (PageRange -> PageRange -> Bool) -> Eq PageRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageRange -> PageRange -> Bool
$c/= :: PageRange -> PageRange -> Bool
== :: PageRange -> PageRange -> Bool
$c== :: PageRange -> PageRange -> Bool
Eq, Int -> PageRange -> ShowS
[PageRange] -> ShowS
PageRange -> String
(Int -> PageRange -> ShowS)
-> (PageRange -> String)
-> ([PageRange] -> ShowS)
-> Show PageRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageRange] -> ShowS
$cshowList :: [PageRange] -> ShowS
show :: PageRange -> String
$cshow :: PageRange -> String
showsPrec :: Int -> PageRange -> ShowS
$cshowsPrec :: Int -> PageRange -> ShowS
Show)

instance ToJSON PageRange where
  toJSON :: PageRange -> Value
toJSON PageRange
x = case PageRange
x of
    OnePage Int
k -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
k
    PageRange Int
a Int
b -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
a, Text
"-", String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
b ]

instance FromJSON PageRange where
  parseJSON :: Value -> Parser PageRange
parseJSON (String Text
str) =
    let (Text
as, Text
bs') = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
str
    in case Text -> Maybe (Char, Text)
T.uncons Text
bs' of
      Maybe (Char, Text)
Nothing -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
as of
        Just Int
k -> PageRange -> Parser PageRange
forall (m :: * -> *) a. Monad m => a -> m a
return (PageRange -> Parser PageRange) -> PageRange -> Parser PageRange
forall a b. (a -> b) -> a -> b
$ Int -> PageRange
OnePage Int
k
        Maybe Int
Nothing -> Text -> Text -> Parser PageRange
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"page range" Text
str
      Just (Char
_,Text
bs) -> if (Text -> Bool
T.null Text
as) Bool -> Bool -> Bool
|| (Text -> Bool
T.null Text
bs)
        then Text -> Text -> Parser PageRange
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"page range" Text
str
        else case (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
as, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
bs) of
          (Just Int
a, Just Int
b) -> PageRange -> Parser PageRange
forall (m :: * -> *) a. Monad m => a -> m a
return (PageRange -> Parser PageRange) -> PageRange -> Parser PageRange
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PageRange
PageRange Int
a Int
b
          (Maybe Int, Maybe Int)
_ -> Text -> Text -> Parser PageRange
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
malformedValue Text
"page range" Text
str
  parseJSON Value
invalid = String -> Value -> Parser PageRange
forall a. String -> Value -> Parser a
typeMismatch String
"PageRange" Value
invalid

instance Arbitrary PageRange where
  arbitrary :: Gen PageRange
arbitrary = do
    NonNegative Int
a <- (NonNegative Int -> NonNegative Int)
-> Gen (NonNegative Int) -> Gen (NonNegative Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> NonNegative Int -> NonNegative Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100)) Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
    [Gen PageRange] -> Gen PageRange
forall a. [Gen a] -> Gen a
oneof
      [ PageRange -> Gen PageRange
forall (m :: * -> *) a. Monad m => a -> m a
return (PageRange -> Gen PageRange) -> PageRange -> Gen PageRange
forall a b. (a -> b) -> a -> b
$ Int -> PageRange
OnePage Int
a
      , do
          NonNegative Int
b <- (NonNegative Int -> NonNegative Int)
-> Gen (NonNegative Int) -> Gen (NonNegative Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> NonNegative Int -> NonNegative Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100)) Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
          PageRange -> Gen PageRange
forall (m :: * -> *) a. Monad m => a -> m a
return (PageRange -> Gen PageRange) -> PageRange -> Gen PageRange
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PageRange
PageRange (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a Int
b) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
b)
      ]



newtype Base64EncodedPdf
  = Base64EncodedPdf SB.ByteString
  deriving (Base64EncodedPdf -> Base64EncodedPdf -> Bool
(Base64EncodedPdf -> Base64EncodedPdf -> Bool)
-> (Base64EncodedPdf -> Base64EncodedPdf -> Bool)
-> Eq Base64EncodedPdf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64EncodedPdf -> Base64EncodedPdf -> Bool
$c/= :: Base64EncodedPdf -> Base64EncodedPdf -> Bool
== :: Base64EncodedPdf -> Base64EncodedPdf -> Bool
$c== :: Base64EncodedPdf -> Base64EncodedPdf -> Bool
Eq, Int -> Base64EncodedPdf -> ShowS
[Base64EncodedPdf] -> ShowS
Base64EncodedPdf -> String
(Int -> Base64EncodedPdf -> ShowS)
-> (Base64EncodedPdf -> String)
-> ([Base64EncodedPdf] -> ShowS)
-> Show Base64EncodedPdf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base64EncodedPdf] -> ShowS
$cshowList :: [Base64EncodedPdf] -> ShowS
show :: Base64EncodedPdf -> String
$cshow :: Base64EncodedPdf -> String
showsPrec :: Int -> Base64EncodedPdf -> ShowS
$cshowsPrec :: Int -> Base64EncodedPdf -> ShowS
Show)

instance FromJSON Base64EncodedPdf where
  parseJSON :: Value -> Parser Base64EncodedPdf
parseJSON (String Text
s) =
    Base64EncodedPdf -> Parser Base64EncodedPdf
forall (m :: * -> *) a. Monad m => a -> m a
return (Base64EncodedPdf -> Parser Base64EncodedPdf)
-> Base64EncodedPdf -> Parser Base64EncodedPdf
forall a b. (a -> b) -> a -> b
$ ByteString -> Base64EncodedPdf
Base64EncodedPdf (ByteString -> Base64EncodedPdf) -> ByteString -> Base64EncodedPdf
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
s
  parseJSON Value
invalid = String -> Value -> Parser Base64EncodedPdf
forall a. String -> Value -> Parser a
typeMismatch String
"Base64EncodedPdf" Value
invalid

decodeBase64EncodedPdf
  :: Base64EncodedPdf -> SB.ByteString
decodeBase64EncodedPdf :: Base64EncodedPdf -> ByteString
decodeBase64EncodedPdf (Base64EncodedPdf ByteString
bytes)
  = ByteString -> ByteString
B64.decodeLenient ByteString
bytes

writeBase64EncodedPdf
  :: ( MonadIO m )
  => FilePath -> Base64EncodedPdf -> m ()
writeBase64EncodedPdf :: String -> Base64EncodedPdf -> m ()
writeBase64EncodedPdf String
path Base64EncodedPdf
pdf =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
SB.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Base64EncodedPdf -> ByteString
decodeBase64EncodedPdf Base64EncodedPdf
pdf