{-# OPTIONS_HADDOCK hide #-}

-- |
-- Description : All Webdriver W3C endpoints
--
--
-- Here is a longer description of this module, containing some
-- commentary with @some markup@.
module WebDriverPreCore.SpecDefinition
  ( -- * The W3Spec Type
    W3Spec (..),

    -- * The API

    -- ** Root Methods
    newSession,
    newSession',
    status,

    -- ** Session Methods
    deleteSession,
    getTimeouts,
    setTimeouts,
    navigateTo,
    getCurrentUrl,
    back,
    forward,
    refresh,
    getTitle,
    getWindowHandle,
    newWindow,
    closeWindow,
    switchToWindow,
    switchToFrame,
    getPageSource,
    executeScript,
    executeScriptAsync,
    addCookie,
    getAllCookies,
    getNamedCookie,
    deleteCookie,
    deleteAllCookies,
    performActions,
    releaseActions,
    dismissAlert,
    acceptAlert,
    getAlertText,
    sendAlertText,
    takeScreenshot,
    printPage,

    -- ** Window Methods
    getWindowHandles,
    getWindowRect,
    setWindowRect,
    maximizeWindow,
    minimizeWindow,
    fullscreenWindow,

    -- ** Frame Methods
    switchToParentFrame,

    -- ** Element(s) Methods
    getActiveElement,
    findElement,
    findElements,
    
    -- ** Element Instance Methods
    findElementFromElement,
    findElementsFromElement,
    isElementSelected,
    getElementAttribute,
    getElementProperty,
    getElementCssValue,
    getElementShadowRoot,
    getElementText,
    getElementTagName,
    getElementRect,
    isElementEnabled,
    getElementComputedRole,
    getElementComputedLabel,
    elementClick,
    elementClear,
    elementSendKeys,
    takeElementScreenshot,

    -- ** Shadow DOM Methods
    findElementFromShadowRoot,
    findElementsFromShadowRoot,

    -- * auxiliary Types
    Cookie (..),
    DriverStatus (..),
    ElementId (..),
    FrameReference (..),
    HandleType (..),
    HttpResponse (..),
    SameSite (..),
    Selector (..),
    SessionId (..),
    Timeouts (..),
    WindowHandle (..),
    WindowHandleSpec (..),
    WindowRect (..),
    UrlPath (..),

    -- ** Action Types
    Action (..),
    Actions (..),
    KeyAction (..),
    Pointer (..),
    PointerAction (..),
    PointerOrigin (..),
    WheelAction (..),
  )
where

import Data.Aeson as A
  ( FromJSON (..),
    Key,
    KeyValue ((.=)),
    Result (..),
    ToJSON (toJSON),
    Value (..),
    fromJSON,
    object,
    withObject,
    withText,
    (.:),
  )
import Data.Aeson.KeyMap qualified as AKM
import Data.Aeson.Types (Parser)
import Data.Foldable (toList)
import Data.Function ((&))
import Data.Maybe (catMaybes)
import Data.Set (Set)
import Data.Text (Text, pack, unpack)
import Data.Text qualified as T
import Data.Word (Word16)
import GHC.Generics (Generic)
import WebDriverPreCore.Internal.Utils (jsonToText, opt, txt)
import WebDriverPreCore.Capabilities as Capabilities
import WebDriverPreCore.HttpResponse (HttpResponse (..))
import Prelude hiding (id, lookup)

-- | Url as returned by 'W3Spec'
-- The 'UrlPath' type is a newtype wrapper around a list of 'Text' segments representing a path.
--
-- e.g. the path: @\/session\/session-no-1-2-3\/window@ would be represented as: @MkUrlPath ["session", "session-no-1-2-3", "window"]@
newtype UrlPath = MkUrlPath {UrlPath -> [Text]
segments :: [Text]}
  deriving newtype (Int -> UrlPath -> ShowS
[UrlPath] -> ShowS
UrlPath -> String
(Int -> UrlPath -> ShowS)
-> (UrlPath -> String) -> ([UrlPath] -> ShowS) -> Show UrlPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlPath -> ShowS
showsPrec :: Int -> UrlPath -> ShowS
$cshow :: UrlPath -> String
show :: UrlPath -> String
$cshowList :: [UrlPath] -> ShowS
showList :: [UrlPath] -> ShowS
Show, UrlPath -> UrlPath -> Bool
(UrlPath -> UrlPath -> Bool)
-> (UrlPath -> UrlPath -> Bool) -> Eq UrlPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlPath -> UrlPath -> Bool
== :: UrlPath -> UrlPath -> Bool
$c/= :: UrlPath -> UrlPath -> Bool
/= :: UrlPath -> UrlPath -> Bool
Eq, Eq UrlPath
Eq UrlPath =>
(UrlPath -> UrlPath -> Ordering)
-> (UrlPath -> UrlPath -> Bool)
-> (UrlPath -> UrlPath -> Bool)
-> (UrlPath -> UrlPath -> Bool)
-> (UrlPath -> UrlPath -> Bool)
-> (UrlPath -> UrlPath -> UrlPath)
-> (UrlPath -> UrlPath -> UrlPath)
-> Ord UrlPath
UrlPath -> UrlPath -> Bool
UrlPath -> UrlPath -> Ordering
UrlPath -> UrlPath -> UrlPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UrlPath -> UrlPath -> Ordering
compare :: UrlPath -> UrlPath -> Ordering
$c< :: UrlPath -> UrlPath -> Bool
< :: UrlPath -> UrlPath -> Bool
$c<= :: UrlPath -> UrlPath -> Bool
<= :: UrlPath -> UrlPath -> Bool
$c> :: UrlPath -> UrlPath -> Bool
> :: UrlPath -> UrlPath -> Bool
$c>= :: UrlPath -> UrlPath -> Bool
>= :: UrlPath -> UrlPath -> Bool
$cmax :: UrlPath -> UrlPath -> UrlPath
max :: UrlPath -> UrlPath -> UrlPath
$cmin :: UrlPath -> UrlPath -> UrlPath
min :: UrlPath -> UrlPath -> UrlPath
Ord, NonEmpty UrlPath -> UrlPath
UrlPath -> UrlPath -> UrlPath
(UrlPath -> UrlPath -> UrlPath)
-> (NonEmpty UrlPath -> UrlPath)
-> (forall b. Integral b => b -> UrlPath -> UrlPath)
-> Semigroup UrlPath
forall b. Integral b => b -> UrlPath -> UrlPath
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: UrlPath -> UrlPath -> UrlPath
<> :: UrlPath -> UrlPath -> UrlPath
$csconcat :: NonEmpty UrlPath -> UrlPath
sconcat :: NonEmpty UrlPath -> UrlPath
$cstimes :: forall b. Integral b => b -> UrlPath -> UrlPath
stimes :: forall b. Integral b => b -> UrlPath -> UrlPath
Semigroup)

{-|
  The 'W3Spec' type is a specification for a WebDriver command.
  Every endpoint function in this module returns a 'W3Spec' object.
-}
data W3Spec a
  = Get
      { forall a. W3Spec a -> Text
description :: Text,
        forall a. W3Spec a -> UrlPath
path :: UrlPath,
        forall a. W3Spec a -> HttpResponse -> Result a
parser :: HttpResponse -> Result a
      }
  | Post
      { description :: Text,
        path :: UrlPath,
        forall a. W3Spec a -> Value
body :: Value,
        parser :: HttpResponse -> Result a
      }
  | PostEmpty
      { description :: Text,
        path :: UrlPath,
        parser :: HttpResponse -> Result a
      }
  | Delete
      { description :: Text,
        path :: UrlPath,
        parser :: HttpResponse -> Result a
      }

instance (Show a) => Show (W3Spec a) where
  show :: W3Spec a -> String
  show :: W3Spec a -> String
show = W3SpecShowable -> String
forall a. Show a => a -> String
Prelude.show (W3SpecShowable -> String)
-> (W3Spec a -> W3SpecShowable) -> W3Spec a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W3Spec a -> W3SpecShowable
forall a. W3Spec a -> W3SpecShowable
mkShowable

data W3SpecShowable = Request
  { W3SpecShowable -> Text
description :: Text,
    W3SpecShowable -> Text
method :: Text,
    W3SpecShowable -> UrlPath
path :: UrlPath,
    W3SpecShowable -> Maybe Text
body :: Maybe Text
  }
  deriving (Int -> W3SpecShowable -> ShowS
[W3SpecShowable] -> ShowS
W3SpecShowable -> String
(Int -> W3SpecShowable -> ShowS)
-> (W3SpecShowable -> String)
-> ([W3SpecShowable] -> ShowS)
-> Show W3SpecShowable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> W3SpecShowable -> ShowS
showsPrec :: Int -> W3SpecShowable -> ShowS
$cshow :: W3SpecShowable -> String
show :: W3SpecShowable -> String
$cshowList :: [W3SpecShowable] -> ShowS
showList :: [W3SpecShowable] -> ShowS
Show)

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dfn-get-window-handle)
newtype WindowHandle = Handle {WindowHandle -> Text
handle :: Text}
  deriving (Int -> WindowHandle -> ShowS
[WindowHandle] -> ShowS
WindowHandle -> String
(Int -> WindowHandle -> ShowS)
-> (WindowHandle -> String)
-> ([WindowHandle] -> ShowS)
-> Show WindowHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowHandle -> ShowS
showsPrec :: Int -> WindowHandle -> ShowS
$cshow :: WindowHandle -> String
show :: WindowHandle -> String
$cshowList :: [WindowHandle] -> ShowS
showList :: [WindowHandle] -> ShowS
Show, WindowHandle -> WindowHandle -> Bool
(WindowHandle -> WindowHandle -> Bool)
-> (WindowHandle -> WindowHandle -> Bool) -> Eq WindowHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowHandle -> WindowHandle -> Bool
== :: WindowHandle -> WindowHandle -> Bool
$c/= :: WindowHandle -> WindowHandle -> Bool
/= :: WindowHandle -> WindowHandle -> Bool
Eq)

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#new-window)
data WindowHandleSpec = HandleSpec
  { WindowHandleSpec -> WindowHandle
handle :: WindowHandle,
    WindowHandleSpec -> HandleType
handletype :: HandleType
  }
  deriving (Int -> WindowHandleSpec -> ShowS
[WindowHandleSpec] -> ShowS
WindowHandleSpec -> String
(Int -> WindowHandleSpec -> ShowS)
-> (WindowHandleSpec -> String)
-> ([WindowHandleSpec] -> ShowS)
-> Show WindowHandleSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowHandleSpec -> ShowS
showsPrec :: Int -> WindowHandleSpec -> ShowS
$cshow :: WindowHandleSpec -> String
show :: WindowHandleSpec -> String
$cshowList :: [WindowHandleSpec] -> ShowS
showList :: [WindowHandleSpec] -> ShowS
Show, WindowHandleSpec -> WindowHandleSpec -> Bool
(WindowHandleSpec -> WindowHandleSpec -> Bool)
-> (WindowHandleSpec -> WindowHandleSpec -> Bool)
-> Eq WindowHandleSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowHandleSpec -> WindowHandleSpec -> Bool
== :: WindowHandleSpec -> WindowHandleSpec -> Bool
$c/= :: WindowHandleSpec -> WindowHandleSpec -> Bool
/= :: WindowHandleSpec -> WindowHandleSpec -> Bool
Eq)

instance ToJSON WindowHandleSpec where
  toJSON :: WindowHandleSpec -> Value
  toJSON :: WindowHandleSpec -> Value
toJSON HandleSpec {WindowHandle
handle :: WindowHandleSpec -> WindowHandle
handle :: WindowHandle
handle, HandleType
handletype :: WindowHandleSpec -> HandleType
handletype :: HandleType
handletype} =
    [Pair] -> Value
object
      [ Key
"handle" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= WindowHandle
handle.handle,
        Key
"type" Key -> HandleType -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HandleType
handletype
      ]

instance FromJSON WindowHandleSpec where
  parseJSON :: Value -> Parser WindowHandleSpec
  parseJSON :: Value -> Parser WindowHandleSpec
parseJSON = String
-> (Object -> Parser WindowHandleSpec)
-> Value
-> Parser WindowHandleSpec
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WindowHandleSpec" ((Object -> Parser WindowHandleSpec)
 -> Value -> Parser WindowHandleSpec)
-> (Object -> Parser WindowHandleSpec)
-> Value
-> Parser WindowHandleSpec
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    handle <- Text -> WindowHandle
Handle (Text -> WindowHandle) -> Parser Text -> Parser WindowHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"handle"
    handletype <- v .: "type"
    pure $ HandleSpec {..}

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

instance ToJSON HandleType where
  toJSON :: HandleType -> Value
  toJSON :: HandleType -> Value
toJSON = Text -> Value
String (Text -> Value) -> (HandleType -> Text) -> HandleType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (HandleType -> Text) -> HandleType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (HandleType -> String) -> HandleType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleType -> String
forall a. Show a => a -> String
show

instance FromJSON HandleType where
  parseJSON :: Value -> Parser HandleType
  parseJSON :: Value -> Parser HandleType
parseJSON = String -> (Text -> Parser HandleType) -> Value -> Parser HandleType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"HandleType" ((Text -> Parser HandleType) -> Value -> Parser HandleType)
-> (Text -> Parser HandleType) -> Value -> Parser HandleType
forall a b. (a -> b) -> a -> b
$ \case
    Text
"window" -> HandleType -> Parser HandleType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HandleType
Window
    Text
"tab" -> HandleType -> Parser HandleType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HandleType
Tab
    Text
v -> String -> Parser HandleType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser HandleType) -> String -> Parser HandleType
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Unknown HandleType " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dfn-find-element)
newtype ElementId = Element {ElementId -> Text
id :: Text}
  deriving (Int -> ElementId -> ShowS
[ElementId] -> ShowS
ElementId -> String
(Int -> ElementId -> ShowS)
-> (ElementId -> String)
-> ([ElementId] -> ShowS)
-> Show ElementId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ElementId -> ShowS
showsPrec :: Int -> ElementId -> ShowS
$cshow :: ElementId -> String
show :: ElementId -> String
$cshowList :: [ElementId] -> ShowS
showList :: [ElementId] -> ShowS
Show, ElementId -> ElementId -> Bool
(ElementId -> ElementId -> Bool)
-> (ElementId -> ElementId -> Bool) -> Eq ElementId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElementId -> ElementId -> Bool
== :: ElementId -> ElementId -> Bool
$c/= :: ElementId -> ElementId -> Bool
/= :: ElementId -> ElementId -> Bool
Eq, (forall x. ElementId -> Rep ElementId x)
-> (forall x. Rep ElementId x -> ElementId) -> Generic ElementId
forall x. Rep ElementId x -> ElementId
forall x. ElementId -> Rep ElementId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ElementId -> Rep ElementId x
from :: forall x. ElementId -> Rep ElementId x
$cto :: forall x. Rep ElementId x -> ElementId
to :: forall x. Rep ElementId x -> ElementId
Generic)

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dfn-new-sessions)
newtype SessionId = Session {SessionId -> Text
id :: Text}
  deriving (Int -> SessionId -> ShowS
[SessionId] -> ShowS
SessionId -> String
(Int -> SessionId -> ShowS)
-> (SessionId -> String)
-> ([SessionId] -> ShowS)
-> Show SessionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionId -> ShowS
showsPrec :: Int -> SessionId -> ShowS
$cshow :: SessionId -> String
show :: SessionId -> String
$cshowList :: [SessionId] -> ShowS
showList :: [SessionId] -> ShowS
Show)

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dfn-status)
data DriverStatus
  = Ready
  | Running
  | ServiceError {DriverStatus -> Int
statusCode :: Int, DriverStatus -> Text
statusMessage :: Text}
  | Unknown {statusCode :: Int, statusMessage :: Text}
  deriving (Int -> DriverStatus -> ShowS
[DriverStatus] -> ShowS
DriverStatus -> String
(Int -> DriverStatus -> ShowS)
-> (DriverStatus -> String)
-> ([DriverStatus] -> ShowS)
-> Show DriverStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DriverStatus -> ShowS
showsPrec :: Int -> DriverStatus -> ShowS
$cshow :: DriverStatus -> String
show :: DriverStatus -> String
$cshowList :: [DriverStatus] -> ShowS
showList :: [DriverStatus] -> ShowS
Show, DriverStatus -> DriverStatus -> Bool
(DriverStatus -> DriverStatus -> Bool)
-> (DriverStatus -> DriverStatus -> Bool) -> Eq DriverStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DriverStatus -> DriverStatus -> Bool
== :: DriverStatus -> DriverStatus -> Bool
$c/= :: DriverStatus -> DriverStatus -> Bool
/= :: DriverStatus -> DriverStatus -> Bool
Eq)

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#cookies)
data SameSite
  = Lax
  | Strict
  | None
  deriving (Int -> SameSite -> ShowS
[SameSite] -> ShowS
SameSite -> String
(Int -> SameSite -> ShowS)
-> (SameSite -> String) -> ([SameSite] -> ShowS) -> Show SameSite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SameSite -> ShowS
showsPrec :: Int -> SameSite -> ShowS
$cshow :: SameSite -> String
show :: SameSite -> String
$cshowList :: [SameSite] -> ShowS
showList :: [SameSite] -> ShowS
Show, SameSite -> SameSite -> Bool
(SameSite -> SameSite -> Bool)
-> (SameSite -> SameSite -> Bool) -> Eq SameSite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SameSite -> SameSite -> Bool
== :: SameSite -> SameSite -> Bool
$c/= :: SameSite -> SameSite -> Bool
/= :: SameSite -> SameSite -> Bool
Eq, Eq SameSite
Eq SameSite =>
(SameSite -> SameSite -> Ordering)
-> (SameSite -> SameSite -> Bool)
-> (SameSite -> SameSite -> Bool)
-> (SameSite -> SameSite -> Bool)
-> (SameSite -> SameSite -> Bool)
-> (SameSite -> SameSite -> SameSite)
-> (SameSite -> SameSite -> SameSite)
-> Ord SameSite
SameSite -> SameSite -> Bool
SameSite -> SameSite -> Ordering
SameSite -> SameSite -> SameSite
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SameSite -> SameSite -> Ordering
compare :: SameSite -> SameSite -> Ordering
$c< :: SameSite -> SameSite -> Bool
< :: SameSite -> SameSite -> Bool
$c<= :: SameSite -> SameSite -> Bool
<= :: SameSite -> SameSite -> Bool
$c> :: SameSite -> SameSite -> Bool
> :: SameSite -> SameSite -> Bool
$c>= :: SameSite -> SameSite -> Bool
>= :: SameSite -> SameSite -> Bool
$cmax :: SameSite -> SameSite -> SameSite
max :: SameSite -> SameSite -> SameSite
$cmin :: SameSite -> SameSite -> SameSite
min :: SameSite -> SameSite -> SameSite
Ord)

instance ToJSON SameSite where
  toJSON :: SameSite -> Value
  toJSON :: SameSite -> Value
toJSON = Text -> Value
String (Text -> Value) -> (SameSite -> Text) -> SameSite -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SameSite -> Text
forall a. Show a => a -> Text
txt

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dfn-switch-to-frame)
data FrameReference
  = TopLevelFrame
  | FrameNumber Word16
  | FrameElementId ElementId
  deriving (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
$cshowsPrec :: Int -> FrameReference -> ShowS
showsPrec :: Int -> FrameReference -> ShowS
$cshow :: FrameReference -> String
show :: FrameReference -> String
$cshowList :: [FrameReference] -> ShowS
showList :: [FrameReference] -> ShowS
Show, FrameReference -> FrameReference -> Bool
(FrameReference -> FrameReference -> Bool)
-> (FrameReference -> FrameReference -> Bool) -> Eq FrameReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameReference -> FrameReference -> Bool
== :: FrameReference -> FrameReference -> Bool
$c/= :: FrameReference -> FrameReference -> Bool
/= :: FrameReference -> FrameReference -> Bool
Eq)

frameJson :: FrameReference -> Value
frameJson :: FrameReference -> Value
frameJson FrameReference
fr =
  [Pair] -> Value
object
    [Key
"id" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value -> Value
forall a. ToJSON a => a -> Value
toJSON (FrameReference -> Value
frameVariant FrameReference
fr)]
  where
    frameVariant :: FrameReference -> Value
frameVariant =
      \case
        FrameReference
TopLevelFrame -> Value
Null
        FrameNumber Word16
n -> Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Word16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n
        FrameElementId ElementId
elm -> [Pair] -> Value
object [Key
elementFieldName Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ElementId
elm.id]

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#cookies)
data Cookie = MkCookie
  { Cookie -> Text
name :: Text,
    Cookie -> Text
value :: Text,
    -- optional
    Cookie -> Maybe Text
path :: Maybe Text,
    Cookie -> Maybe Text
domain :: Maybe Text,
    Cookie -> Maybe Bool
secure :: Maybe Bool,
    Cookie -> Maybe Bool
httpOnly :: Maybe Bool,
    Cookie -> Maybe SameSite
sameSite :: Maybe SameSite,
    -- When the cookie expires, specified in seconds since Unix Epoch.
    Cookie -> Maybe Int
expiry :: Maybe Int
  }
  deriving (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
$cshowsPrec :: Int -> Cookie -> ShowS
showsPrec :: Int -> Cookie -> ShowS
$cshow :: Cookie -> String
show :: Cookie -> String
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq)

instance ToJSON Cookie where
  toJSON :: Cookie -> Value
  toJSON :: Cookie -> Value
toJSON MkCookie {Text
name :: Cookie -> Text
name :: Text
name, Text
value :: Cookie -> Text
value :: Text
value, Maybe Text
path :: Cookie -> Maybe Text
path :: Maybe Text
path, Maybe Text
domain :: Cookie -> Maybe Text
domain :: Maybe Text
domain, Maybe Bool
secure :: Cookie -> Maybe Bool
secure :: Maybe Bool
secure, Maybe Bool
httpOnly :: Cookie -> Maybe Bool
httpOnly :: Maybe Bool
httpOnly, Maybe SameSite
sameSite :: Cookie -> Maybe SameSite
sameSite :: Maybe SameSite
sameSite, Maybe Int
expiry :: Cookie -> Maybe Int
expiry :: Maybe Int
expiry} =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name,
        Key
"value" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
value
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
          [ Key -> Maybe Text -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"path" Maybe Text
path,
            Key -> Maybe Text -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"domain" Maybe Text
domain,
            Key -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"secure" Maybe Bool
secure,
            Key -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"httpOnly" Maybe Bool
httpOnly,
            Key -> Maybe SameSite -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"sameSite" Maybe SameSite
sameSite,
            Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"expiry" Maybe Int
expiry
          ]

cookieJSON :: Cookie -> Value
cookieJSON :: Cookie -> Value
cookieJSON Cookie
c = [Pair] -> Value
object [Key
"cookie" Key -> Cookie -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Cookie
c]

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#locator-strategies)
data Selector
  = CSS Text
  | XPath Text
  | LinkText Text
  | PartialLinkText Text
  | TagName Text
  deriving (Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Selector -> ShowS
showsPrec :: Int -> Selector -> ShowS
$cshow :: Selector -> String
show :: Selector -> String
$cshowList :: [Selector] -> ShowS
showList :: [Selector] -> ShowS
Show, Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
/= :: Selector -> Selector -> Bool
Eq)

-- ######################################################################
-- ########################### WebDriver API ############################
-- ######################################################################

-- https://www.w3.org/TR/2025/WD-webdriver2-20250210/
-- 61 endpoints
-- Method 	URI Template 	Command

-- ** Root Methods

-- |
--  Return a spec to create a new session given 'FullCapabilities' object.
--
-- 'newSession'' can be used if 'FullCapabilities' doesn't meet your requirements.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#new-session)
--
--  @POST 	\/session 	New Session@
newSession :: FullCapabilities -> W3Spec SessionId
newSession :: FullCapabilities -> W3Spec SessionId
newSession = FullCapabilities -> W3Spec SessionId
forall a. ToJSON a => a -> W3Spec SessionId
newSession'

-- |
--
--  Return a spec to create a new session given an object of any type that implements `ToJSON`.
--
-- The 'FullCapabilities' type and associated types should work for the vast majority use cases, but if the required capabilities are not covered by the types provided, 'newSession''.
-- can be used with a custom type instead. 'newSession'' works with any type that implements 'ToJSON', (including an Aeson 'Value').
-- 
-- Obviously, any type used must produce a JSON object compatible with [capabilities as defined W3C spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#capabilities).
--
--  [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#new-session)
--
--  @POST 	\/session 	New Session@
newSession' :: (ToJSON a) => a -> W3Spec SessionId
newSession' :: forall a. ToJSON a => a -> W3Spec SessionId
newSession' a
capabilities = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result SessionId)
-> W3Spec SessionId
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"New Session" ([Text] -> UrlPath
MkUrlPath [Text
session]) (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
capabilities) HttpResponse -> Result SessionId
parseSessionRef

-- |
--
-- Return a spec to get the status of the driver.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#status)
--
-- @GET 	\/status 	Status@
status :: W3Spec DriverStatus
status :: W3Spec DriverStatus
status = Text
-> UrlPath
-> (HttpResponse -> Result DriverStatus)
-> W3Spec DriverStatus
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Status" ([Text] -> UrlPath
MkUrlPath [Text
"status"]) HttpResponse -> Result DriverStatus
parseDriverStatus

-- ############################ Session Methods ##########################################

-- |
--
-- Return a spec to delete a session given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#delete-session)
--
-- @DELETE 	\/session\/{session id} 	Delete Session@
deleteSession :: SessionId -> W3Spec ()
deleteSession :: SessionId -> W3Spec ()
deleteSession SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Delete Text
"Delete Session" (Text -> UrlPath
sessionUri SessionId
sessionRef.id) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to get the timeouts of a session given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-timeouts)
--
-- @GET 	\/session\/{session id}\/timeouts 	Get Timeouts@
getTimeouts :: SessionId -> W3Spec Timeouts
getTimeouts :: SessionId -> W3Spec Timeouts
getTimeouts SessionId
sessionRef = Text
-> UrlPath -> (HttpResponse -> Result Timeouts) -> W3Spec Timeouts
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Timeouts" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"timeouts") HttpResponse -> Result Timeouts
parseTimeouts

-- |
--
-- Return a spec to set the timeouts of a session given a 'SessionId' and 'Timeouts'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#set-timeouts)
--
-- @POST 	\/session\/{session id}\/timeouts 	Set Timeouts@
setTimeouts :: SessionId -> Timeouts -> W3Spec ()
setTimeouts :: SessionId -> Timeouts -> W3Spec ()
setTimeouts SessionId
sessionRef Timeouts
timeouts =
  Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Set Timeouts" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"timeouts") (Timeouts -> Value
forall a. ToJSON a => a -> Value
toJSON Timeouts
timeouts) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to navigate to a URL given a 'SessionId' and a 'Text' URL.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#navigate-to)
--
-- @POST 	\/session\/{session id}\/url 	Navigate To@
navigateTo :: SessionId -> Text -> W3Spec ()
navigateTo :: SessionId -> Text -> W3Spec ()
navigateTo SessionId
sessionRef Text
url = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Navigate To" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"url") ([Pair] -> Value
object [Key
"url" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
url]) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to get the current URL of a session given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-current-url)
--
-- @GET 	\/session\/{session id}\/url 	Get Current URL@
getCurrentUrl :: SessionId -> W3Spec Text
getCurrentUrl :: SessionId -> W3Spec Text
getCurrentUrl SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Current URL" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"url") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to navigate back in the browser history given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#back)
--
-- @POST 	\/session\/{session id}\/back 	Back@
back :: SessionId -> W3Spec ()
back :: SessionId -> W3Spec ()
back SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Back" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"back") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to navigate forward in the browser history given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#forward)
--
-- @POST 	\/session\/{session id}\/forward 	Forward@
forward :: SessionId -> W3Spec ()
forward :: SessionId -> W3Spec ()
forward SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Forward" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"forward") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to refresh the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#refresh)
--
-- @POST 	\/session\/{session id}\/refresh 	Refresh@
refresh :: SessionId -> W3Spec ()
refresh :: SessionId -> W3Spec ()
refresh SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Refresh" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"refresh") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to get the title of the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-title)
--
-- @GET 	\/session\/{session id}\/title 	Get Title@
getTitle :: SessionId -> W3Spec Text
getTitle :: SessionId -> W3Spec Text
getTitle SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Title" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"title") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to get the current window handle given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-window-handle)
--
-- @GET 	\/session\/{session id}\/window 	Get Window Handle@
getWindowHandle :: SessionId -> W3Spec WindowHandle
getWindowHandle :: SessionId -> W3Spec WindowHandle
getWindowHandle SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result WindowHandle)
-> W3Spec WindowHandle
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Window Handle" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"window") ((Text -> WindowHandle) -> Result Text -> Result WindowHandle
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> WindowHandle
Handle (Result Text -> Result WindowHandle)
-> (HttpResponse -> Result Text)
-> HttpResponse
-> Result WindowHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpResponse -> Result Text
parseBodyTxt)

-- |
--
-- Return a spec to create a new window given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#new-window)
--
-- @POST 	\/session\/{session id}\/window\/new 	New Window@
newWindow :: SessionId -> W3Spec WindowHandleSpec
newWindow :: SessionId -> W3Spec WindowHandleSpec
newWindow SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result WindowHandleSpec)
-> W3Spec WindowHandleSpec
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"New Window" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionRef Text
"window" Text
"new") HttpResponse -> Result WindowHandleSpec
windowHandleParser

-- |
--
-- Return a spec to close the current window given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#close-window)
--
-- @DELETE 	\/session\/{session id}\/window 	Close Window@
closeWindow :: SessionId -> W3Spec ()
closeWindow :: SessionId -> W3Spec ()
closeWindow SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Delete Text
"Close Window" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"window") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to switch to a different window given a 'SessionId' and 'WindowHandle'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#switch-to-window)
--
-- @POST 	\/session\/{session id}\/window 	Switch To Window@
switchToWindow :: SessionId -> WindowHandle -> W3Spec ()
switchToWindow :: SessionId -> WindowHandle -> W3Spec ()
switchToWindow SessionId
sessionRef Handle {Text
handle :: WindowHandle -> Text
handle :: Text
handle} = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Switch To Window" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"window") ([Pair] -> Value
object [Key
"handle" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
handle]) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to switch to a different frame given a 'SessionId' and 'FrameReference'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#switch-to-frame)
--
-- @POST 	\/session\/{session id}\/frame 	Switch To Frame@
switchToFrame :: SessionId -> FrameReference -> W3Spec ()
switchToFrame :: SessionId -> FrameReference -> W3Spec ()
switchToFrame SessionId
sessionRef FrameReference
frameRef = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Switch To Frame" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"frame") (FrameReference -> Value
frameJson FrameReference
frameRef) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to get the source of the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-page-source)
--
-- @GET 	\/session\/{session id}\/source 	Get Page Source@
getPageSource :: SessionId -> W3Spec Text
getPageSource :: SessionId -> W3Spec Text
getPageSource SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Page Source" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"source") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to execute a script in the context of the current page given a 'SessionId', 'Text' script, and a list of 'Value' arguments.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#execute-script)
--
-- @POST 	\/session\/{session id}\/execute\/sync 	Execute Script@
executeScript :: SessionId -> Text -> [Value] -> W3Spec Value
executeScript :: SessionId -> Text -> [Value] -> W3Spec Value
executeScript SessionId
sessionId Text
script [Value]
args = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result Value)
-> W3Spec Value
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Execute Script" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"execute" Text
"sync") (Text -> [Value] -> Value
mkScript Text
script [Value]
args) HttpResponse -> Result Value
bodyValue

-- |
--
-- Return a spec to execute an asynchronous script in the context of the current page given a 'SessionId', 'Text' script, and a list of 'Value' arguments.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#execute-async-script)
--
-- @POST 	\/session\/{session id}\/execute\/async 	Execute Async Script@
executeScriptAsync :: SessionId -> Text -> [Value] -> W3Spec Value
executeScriptAsync :: SessionId -> Text -> [Value] -> W3Spec Value
executeScriptAsync SessionId
sessionId Text
script [Value]
args = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result Value)
-> W3Spec Value
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Execute Async Script" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"execute" Text
"async") (Text -> [Value] -> Value
mkScript Text
script [Value]
args) HttpResponse -> Result Value
bodyValue

-- |
--
-- Return a spec to get all cookies of the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-all-cookies)
--
-- @GET 	\/session\/{session id}\/cookie 	Get All Cookies@
getAllCookies :: SessionId -> W3Spec [Cookie]
getAllCookies :: SessionId -> W3Spec [Cookie]
getAllCookies SessionId
sessionId = Text
-> UrlPath -> (HttpResponse -> Result [Cookie]) -> W3Spec [Cookie]
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get All Cookies" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"cookie") HttpResponse -> Result [Cookie]
parseCookies

-- |
--
-- Return a spec to get a named cookie of the current page given a 'SessionId' and cookie name.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-named-cookie)
--
-- @GET 	\/session\/{session id}\/cookie\/{name} 	Get Named Cookie@
getNamedCookie :: SessionId -> Text -> W3Spec Cookie
getNamedCookie :: SessionId -> Text -> W3Spec Cookie
getNamedCookie SessionId
sessionId Text
cookieName = Text -> UrlPath -> (HttpResponse -> Result Cookie) -> W3Spec Cookie
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Named Cookie" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"cookie" Text
cookieName) HttpResponse -> Result Cookie
parseCookie

-- |
--
-- Return a spec to add a cookie to the current page given a 'SessionId' and 'Cookie'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#add-cookie)
--
-- @POST 	\/session\/{session id}\/cookie 	Add Cookie@
addCookie :: SessionId -> Cookie -> W3Spec ()
addCookie :: SessionId -> Cookie -> W3Spec ()
addCookie SessionId
sessionId Cookie
cookie = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Add Cookie" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"cookie") (Cookie -> Value
cookieJSON Cookie
cookie) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to delete a named cookie from the current page given a 'SessionId' and cookie name.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#delete-cookie)
--
-- @DELETE 	\/session\/{session id}\/cookie\/{name} 	Delete Cookie@
deleteCookie :: SessionId -> Text -> W3Spec ()
deleteCookie :: SessionId -> Text -> W3Spec ()
deleteCookie SessionId
sessionId Text
cookieName = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Delete Text
"Delete Cookie" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"cookie" Text
cookieName) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to delete all cookies from the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#delete-all-cookies)
--
-- @DELETE 	\/session\/{session id}\/cookie 	Delete All Cookies@
deleteAllCookies :: SessionId -> W3Spec ()
deleteAllCookies :: SessionId -> W3Spec ()
deleteAllCookies SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Delete Text
"Delete All Cookies" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"cookie") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to perform actions on the current page given a 'SessionId' and 'Actions'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#perform-actions)
--
-- @POST 	\/session\/{session id}\/actions 	Perform Actions@
performActions :: SessionId -> Actions -> W3Spec ()
performActions :: SessionId -> Actions -> W3Spec ()
performActions SessionId
sessionId Actions
actions = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Perform Actions" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"actions") (Actions -> Value
actionsToJson Actions
actions) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to release actions on the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#release-actions)
--
-- @DELETE 	\/session\/{session id}\/actions 	Release Actions@
releaseActions :: SessionId -> W3Spec ()
releaseActions :: SessionId -> W3Spec ()
releaseActions SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Delete Text
"Release Actions" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"actions") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to dismiss an alert on the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dismiss-alert)
--
-- @POST 	\/session\/{session id}\/alert\/dismiss 	Dismiss Alert@
dismissAlert :: SessionId -> W3Spec ()
dismissAlert :: SessionId -> W3Spec ()
dismissAlert SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Dismiss Alert" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"alert" Text
"dismiss") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to accept an alert on the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#accept-alert)
--
-- @POST 	\/session\/{session id}\/alert\/accept 	Accept Alert@
acceptAlert :: SessionId -> W3Spec ()
acceptAlert :: SessionId -> W3Spec ()
acceptAlert SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Accept Alert" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"alert" Text
"accept") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to get the text of an alert on the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-alert-text)
--
-- @GET 	\/session\/{session id}\/alert\/text 	Get Alert Text@
getAlertText :: SessionId -> W3Spec Text
getAlertText :: SessionId -> W3Spec Text
getAlertText SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Alert Text" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"alert" Text
"text") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to send text to an alert on the current page given a 'SessionId' and 'Text'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#send-alert-text)
--
-- @POST 	\/session\/{session id}\/alert\/text 	Send Alert Text@
sendAlertText :: SessionId -> Text -> W3Spec ()
sendAlertText :: SessionId -> Text -> W3Spec ()
sendAlertText SessionId
sessionId Text
text = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Send Alert Text" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"alert" Text
"text") ([Pair] -> Value
object [Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
text]) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to take a screenshot of the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#take-screenshot)
--
-- @GET 	\/session\/{session id}\/screenshot 	Take Screenshot@
takeScreenshot :: SessionId -> W3Spec Text
takeScreenshot :: SessionId -> W3Spec Text
takeScreenshot SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Take Screenshot" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"screenshot") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to print the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#print-page)
--
-- @POST 	\/session\/{session id}\/print 	Print Page@
printPage :: SessionId -> W3Spec Text
printPage :: SessionId -> W3Spec Text
printPage SessionId
sessionId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Print Page" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionId Text
"print") HttpResponse -> Result Text
parseBodyTxt

-- ############################ Window Methods ##########################################

-- |
--
-- Return a spec to get all window handles of the current session given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-window-handles)
--
-- @GET 	\/session\/{session id}\/window\/handles 	Get Window Handles@
getWindowHandles :: SessionId -> W3Spec [WindowHandle]
getWindowHandles :: SessionId -> W3Spec [WindowHandle]
getWindowHandles SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result [WindowHandle])
-> W3Spec [WindowHandle]
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Window Handles" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionRef Text
"window" Text
"handles") HttpResponse -> Result [WindowHandle]
windowHandlesParser

-- |
--
-- Return a spec to get the window rect of the current window given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-window-rect)
--
-- @GET 	\/session\/{session id}\/window\/rect 	Get Window Rect@
getWindowRect :: SessionId -> W3Spec WindowRect
getWindowRect :: SessionId -> W3Spec WindowRect
getWindowRect SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result WindowRect)
-> W3Spec WindowRect
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Window Rect" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionRef Text
"window" Text
"rect") HttpResponse -> Result WindowRect
parseWindowRect

-- |
--
-- Return a spec to set the window rect of the current window given a 'SessionId' and 'WindowRect'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#set-window-rect)
--
-- @POST 	\/session\/{session id}\/window\/rect 	Set Window Rect@
setWindowRect :: SessionId -> WindowRect -> W3Spec WindowRect
setWindowRect :: SessionId -> WindowRect -> W3Spec WindowRect
setWindowRect SessionId
sessionRef WindowRect
rect = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result WindowRect)
-> W3Spec WindowRect
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Set Window Rect" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionRef Text
"window" Text
"rect") (WindowRect -> Value
forall a. ToJSON a => a -> Value
toJSON WindowRect
rect) HttpResponse -> Result WindowRect
parseWindowRect

-- |
--
-- Return a spec to maximize the current window given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#maximize-window)
--
-- @POST 	\/session\/{session id}\/window\/maximize 	Maximize Window@
maximizeWindow :: SessionId -> W3Spec WindowRect
maximizeWindow :: SessionId -> W3Spec WindowRect
maximizeWindow SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result WindowRect)
-> W3Spec WindowRect
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Maximize Window" (SessionId -> Text -> UrlPath
windowUri1 SessionId
sessionRef Text
"maximize") HttpResponse -> Result WindowRect
parseWindowRect

-- |
--
-- Return a spec to minimize the current window given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#minimize-window)
--
-- @POST 	\/session\/{session id}\/window\/minimize 	Minimize Window@
minimizeWindow :: SessionId -> W3Spec WindowRect
minimizeWindow :: SessionId -> W3Spec WindowRect
minimizeWindow SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result WindowRect)
-> W3Spec WindowRect
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Minimize Window" (SessionId -> Text -> UrlPath
windowUri1 SessionId
sessionRef Text
"minimize") HttpResponse -> Result WindowRect
parseWindowRect

-- |
--
-- Return a spec to fullscreen the current window given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#fullscreen-window)
--
-- @POST 	\/session\/{session id}\/window\/fullscreen 	Fullscreen Window@
fullscreenWindow :: SessionId -> W3Spec WindowRect
fullscreenWindow :: SessionId -> W3Spec WindowRect
fullscreenWindow SessionId
sessionRef = Text
-> UrlPath
-> (HttpResponse -> Result WindowRect)
-> W3Spec WindowRect
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Fullscreen Window" (SessionId -> Text -> UrlPath
windowUri1 SessionId
sessionRef Text
"fullscreen") HttpResponse -> Result WindowRect
parseWindowRect

-- ############################ Frame Methods ##########################################

-- |
--
-- Return a spec to switch to the parent frame given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#switch-to-parent-frame)
--
-- @POST 	\/session\/{session id}\/frame\/parent 	Switch To Parent Frame@
switchToParentFrame :: SessionId -> W3Spec ()
switchToParentFrame :: SessionId -> W3Spec ()
switchToParentFrame SessionId
sessionRef = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Switch To Parent Frame" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionRef Text
"frame" Text
"parent") HttpResponse -> Result ()
voidParser

-- ############################ Element(s) Methods ##########################################

-- |
--
-- Return a spec to get the active element of the current page given a 'SessionId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-active-element)
--
-- @GET 	\/session\/{session id}\/element\/active 	Get Active Element@
getActiveElement :: SessionId -> W3Spec ElementId
getActiveElement :: SessionId -> W3Spec ElementId
getActiveElement SessionId
sessionId = Text
-> UrlPath
-> (HttpResponse -> Result ElementId)
-> W3Spec ElementId
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Active Element" (SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sessionId Text
"element" Text
"active") HttpResponse -> Result ElementId
parseElementRef

-- |
--
-- Return a spec to find an element on the current page given a 'SessionId' and 'Selector'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#find-element)
--
-- @POST 	\/session\/{session id}\/element 	Find Element@
findElement :: SessionId -> Selector -> W3Spec ElementId
findElement :: SessionId -> Selector -> W3Spec ElementId
findElement SessionId
sessionRef = SessionId -> Value -> W3Spec ElementId
findElement' SessionId
sessionRef (Value -> W3Spec ElementId)
-> (Selector -> Value) -> Selector -> W3Spec ElementId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Value
selectorJson

-- |
--
-- Return a spec to find elements on the current page given a 'SessionId' and 'Selector'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#find-elements)
--
-- @POST 	\/session\/{session id}\/elements 	Find Elements@
findElements :: SessionId -> Selector -> W3Spec [ElementId]
findElements :: SessionId -> Selector -> W3Spec [ElementId]
findElements SessionId
sessionRef Selector
selector = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result [ElementId])
-> W3Spec [ElementId]
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Find Elements" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"elements") (Selector -> Value
selectorJson Selector
selector) HttpResponse -> Result [ElementId]
parseElementsRef

-- ############################ Element Instance Methods ##########################################

-- |
--
-- Return a spec to get the shadow root of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-shadow-root)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/shadow 	Get Element Shadow Root@
getElementShadowRoot :: SessionId -> ElementId -> W3Spec ElementId
getElementShadowRoot :: SessionId -> ElementId -> W3Spec ElementId
getElementShadowRoot SessionId
sessionId ElementId
elementId = Text
-> UrlPath
-> (HttpResponse -> Result ElementId)
-> W3Spec ElementId
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element Shadow Root" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"shadow") HttpResponse -> Result ElementId
parseShadowElementRef

-- |
--
-- Return a spec to find an element from another element given a 'SessionId', 'ElementId', and 'Selector'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#find-element-from-element)
--
-- @POST 	\/session\/{session id}\/element\/{element id}\/element 	Find Element From Element@
findElementFromElement :: SessionId -> ElementId -> Selector -> W3Spec ElementId
findElementFromElement :: SessionId -> ElementId -> Selector -> W3Spec ElementId
findElementFromElement SessionId
sessionId ElementId
elementId Selector
selector = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result ElementId)
-> W3Spec ElementId
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Find Element From Element" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"element") (Selector -> Value
selectorJson Selector
selector) HttpResponse -> Result ElementId
parseElementRef

-- |
--
-- Return a spec to find elements from another element given a 'SessionId', 'ElementId', and 'Selector'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#find-elements-from-element)
--
-- @POST 	\/session\/{session id}\/element\/{element id}\/elements 	Find Elements From Element@
findElementsFromElement :: SessionId -> ElementId -> Selector -> W3Spec [ElementId]
findElementsFromElement :: SessionId -> ElementId -> Selector -> W3Spec [ElementId]
findElementsFromElement SessionId
sessionId ElementId
elementId Selector
selector = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result [ElementId])
-> W3Spec [ElementId]
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Find Elements From Element" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"elements") (Selector -> Value
selectorJson Selector
selector) HttpResponse -> Result [ElementId]
parseElementsRef

-- |
--
-- Return a spec to check if an element is selected given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#is-element-selected)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/selected 	Is Element Selected@
isElementSelected :: SessionId -> ElementId -> W3Spec Bool
isElementSelected :: SessionId -> ElementId -> W3Spec Bool
isElementSelected SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Bool) -> W3Spec Bool
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Is Element Selected" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"selected") HttpResponse -> Result Bool
parseBodyBool

-- |
--
-- Return a spec to get an attribute of an element given a 'SessionId', 'ElementId', and attribute name.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-attribute)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/attribute\/{name} 	Get Element Attribute@
getElementAttribute :: SessionId -> ElementId -> Text -> W3Spec Text
getElementAttribute :: SessionId -> ElementId -> Text -> W3Spec Text
getElementAttribute SessionId
sessionId ElementId
elementId Text
attributeName = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element Attribute" (SessionId -> ElementId -> Text -> Text -> UrlPath
elementUri2 SessionId
sessionId ElementId
elementId Text
"attribute" Text
attributeName) HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to get a property of an element given a 'SessionId', 'ElementId', and property name.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-property)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/property\/{name} 	Get Element Property@
getElementProperty :: SessionId -> ElementId -> Text -> W3Spec Value
getElementProperty :: SessionId -> ElementId -> Text -> W3Spec Value
getElementProperty SessionId
sessionId ElementId
elementId Text
propertyName = Text -> UrlPath -> (HttpResponse -> Result Value) -> W3Spec Value
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element Property" (SessionId -> ElementId -> Text -> Text -> UrlPath
elementUri2 SessionId
sessionId ElementId
elementId Text
"property" Text
propertyName) HttpResponse -> Result Value
bodyValue

-- |
--
-- Return a spec to get the CSS value of an element given a 'SessionId', 'ElementId', and CSS property name.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-css-value)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/css\/{property name} 	Get Element CSS Value@
getElementCssValue :: SessionId -> ElementId -> Text -> W3Spec Text
getElementCssValue :: SessionId -> ElementId -> Text -> W3Spec Text
getElementCssValue SessionId
sessionId ElementId
elementId Text
propertyName = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element CSS Value" (SessionId -> ElementId -> Text -> Text -> UrlPath
elementUri2 SessionId
sessionId ElementId
elementId Text
"css" Text
propertyName) HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to get the text of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-text)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/text 	Get Element Text@
getElementText :: SessionId -> ElementId -> W3Spec Text
getElementText :: SessionId -> ElementId -> W3Spec Text
getElementText SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element Text" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"text") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to get the tag name of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-tag-name)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/name 	Get Element Tag Name@
getElementTagName :: SessionId -> ElementId -> W3Spec Text
getElementTagName :: SessionId -> ElementId -> W3Spec Text
getElementTagName SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element Tag Name" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"name") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to get the rect of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-element-rect)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/rect 	Get Element Rect@
getElementRect :: SessionId -> ElementId -> W3Spec WindowRect
getElementRect :: SessionId -> ElementId -> W3Spec WindowRect
getElementRect SessionId
sessionId ElementId
elementId = Text
-> UrlPath
-> (HttpResponse -> Result WindowRect)
-> W3Spec WindowRect
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Element Rect" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"rect") HttpResponse -> Result WindowRect
parseWindowRect

-- |
--
-- Return a spec to check if an element is enabled given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#is-element-enabled)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/enabled 	Is Element Enabled@
isElementEnabled :: SessionId -> ElementId -> W3Spec Bool
isElementEnabled :: SessionId -> ElementId -> W3Spec Bool
isElementEnabled SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Bool) -> W3Spec Bool
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Is Element Enabled" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"enabled") HttpResponse -> Result Bool
parseBodyBool

-- |
--
-- Return a spec to get the computed role of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-computed-role)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/computedrole 	Get Computed Role@
getElementComputedRole :: SessionId -> ElementId -> W3Spec Text
getElementComputedRole :: SessionId -> ElementId -> W3Spec Text
getElementComputedRole SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Computed Role" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"computedrole") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to get the computed label of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#get-computed-label)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/computedlabel 	Get Computed Label@
getElementComputedLabel :: SessionId -> ElementId -> W3Spec Text
getElementComputedLabel :: SessionId -> ElementId -> W3Spec Text
getElementComputedLabel SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Get Computed Label" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"computedlabel") HttpResponse -> Result Text
parseBodyTxt

-- |
--
-- Return a spec to click an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#element-click)
--
-- @POST 	\/session\/{session id}\/element\/{element id}\/click 	Element Click@
elementClick :: SessionId -> ElementId -> W3Spec ()
elementClick :: SessionId -> ElementId -> W3Spec ()
elementClick SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Element Click" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"click") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to clear an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#element-clear)
--
-- @POST 	\/session\/{session id}\/element\/{element id}\/clear 	Element Clear@
elementClear :: SessionId -> ElementId -> W3Spec ()
elementClear :: SessionId -> ElementId -> W3Spec ()
elementClear SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result ()) -> W3Spec ()
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
PostEmpty Text
"Element Clear" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"clear") HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to send keys to an element given a 'SessionId', 'ElementId', and keys to send.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#element-send-keys)
--
-- @POST 	\/session\/{session id}\/element\/{element id}\/value 	Element Send Keys@
elementSendKeys :: SessionId -> ElementId -> Text -> W3Spec ()
elementSendKeys :: SessionId -> ElementId -> Text -> W3Spec ()
elementSendKeys SessionId
sessionId ElementId
elementId Text
keysToSend = Text
-> UrlPath -> Value -> (HttpResponse -> Result ()) -> W3Spec ()
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Element Send Keys" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"value") (Text -> Value
keysJson Text
keysToSend) HttpResponse -> Result ()
voidParser

-- |
--
-- Return a spec to take a screenshot of an element given a 'SessionId' and 'ElementId'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#take-element-screenshot)
--
-- @GET 	\/session\/{session id}\/element\/{element id}\/screenshot 	Take Element Screenshot@
takeElementScreenshot :: SessionId -> ElementId -> W3Spec Text
takeElementScreenshot :: SessionId -> ElementId -> W3Spec Text
takeElementScreenshot SessionId
sessionId ElementId
elementId = Text -> UrlPath -> (HttpResponse -> Result Text) -> W3Spec Text
forall a. Text -> UrlPath -> (HttpResponse -> Result a) -> W3Spec a
Get Text
"Take Element Screenshot" (SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
sessionId ElementId
elementId Text
"screenshot") HttpResponse -> Result Text
parseBodyTxt

-- ############################ Shadow DOM Methods ##########################################

-- |
--
-- Return a spec to find an element from the shadow root given a 'SessionId', 'ElementId', and 'Selector'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#find-element-from-shadow-root)
--
-- @POST 	\/session\/{session id}\/shadow\/{shadow id}\/element 	Find Element From Shadow Root@
findElementFromShadowRoot :: SessionId -> ElementId -> Selector -> W3Spec ElementId
findElementFromShadowRoot :: SessionId -> ElementId -> Selector -> W3Spec ElementId
findElementFromShadowRoot SessionId
sessionId ElementId
shadowId Selector
selector = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result ElementId)
-> W3Spec ElementId
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Find Element From Shadow Root" (SessionId -> Text -> Text -> Text -> UrlPath
sessionUri3 SessionId
sessionId Text
"shadow" ElementId
shadowId.id Text
"element") (Selector -> Value
selectorJson Selector
selector) HttpResponse -> Result ElementId
parseElementRef

-- |
--
-- Return a spec to find elements from the shadow root given a 'SessionId', 'ElementId', and 'Selector'.
--
-- [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#find-elements-from-shadow-root)
--
-- @POST 	\/session\/{session id}\/shadow\/{shadow id}\/elements 	Find Elements From Shadow Root@
findElementsFromShadowRoot :: SessionId -> ElementId -> Selector -> W3Spec [ElementId]
findElementsFromShadowRoot :: SessionId -> ElementId -> Selector -> W3Spec [ElementId]
findElementsFromShadowRoot SessionId
sessionId ElementId
shadowId Selector
selector = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result [ElementId])
-> W3Spec [ElementId]
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Find Elements From Shadow Root" (SessionId -> Text -> Text -> Text -> UrlPath
sessionUri3 SessionId
sessionId Text
"shadow" ElementId
shadowId.id Text
"elements") (Selector -> Value
selectorJson Selector
selector) HttpResponse -> Result [ElementId]
parseElementsRef

-- ############################ Utils ##########################################

findElement' :: SessionId -> Value -> W3Spec ElementId
findElement' :: SessionId -> Value -> W3Spec ElementId
findElement' SessionId
sessionRef Value
selector = Text
-> UrlPath
-> Value
-> (HttpResponse -> Result ElementId)
-> W3Spec ElementId
forall a.
Text -> UrlPath -> Value -> (HttpResponse -> Result a) -> W3Spec a
Post Text
"Find Element" (SessionId -> Text -> UrlPath
sessionUri1 SessionId
sessionRef Text
"element") Value
selector HttpResponse -> Result ElementId
parseElementRef

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#dfn-get-element-rect)
data WindowRect = Rect
  { WindowRect -> Int
x :: Int,
    WindowRect -> Int
y :: Int,
    WindowRect -> Int
width :: Int,
    WindowRect -> Int
height :: Int
  }
  deriving (Int -> WindowRect -> ShowS
[WindowRect] -> ShowS
WindowRect -> String
(Int -> WindowRect -> ShowS)
-> (WindowRect -> String)
-> ([WindowRect] -> ShowS)
-> Show WindowRect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowRect -> ShowS
showsPrec :: Int -> WindowRect -> ShowS
$cshow :: WindowRect -> String
show :: WindowRect -> String
$cshowList :: [WindowRect] -> ShowS
showList :: [WindowRect] -> ShowS
Show, WindowRect -> WindowRect -> Bool
(WindowRect -> WindowRect -> Bool)
-> (WindowRect -> WindowRect -> Bool) -> Eq WindowRect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowRect -> WindowRect -> Bool
== :: WindowRect -> WindowRect -> Bool
$c/= :: WindowRect -> WindowRect -> Bool
/= :: WindowRect -> WindowRect -> Bool
Eq)

instance ToJSON WindowRect where
  toJSON :: WindowRect -> Value
  toJSON :: WindowRect -> Value
toJSON Rect {Int
x :: WindowRect -> Int
x :: Int
x, Int
y :: WindowRect -> Int
y :: Int
y, Int
width :: WindowRect -> Int
width :: Int
width, Int
height :: WindowRect -> Int
height :: Int
height} =
    [Pair] -> Value
object
      [ Key
"x" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x,
        Key
"y" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
y,
        Key
"width" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
width,
        Key
"height" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
height
      ]

parseTimeouts :: HttpResponse -> Result Timeouts
parseTimeouts :: HttpResponse -> Result Timeouts
parseTimeouts HttpResponse
r = do
  r' <- HttpResponse -> Result Value
bodyValue HttpResponse
r
  fromJSON r'

parseWindowRect :: HttpResponse -> Result WindowRect
parseWindowRect :: HttpResponse -> Result WindowRect
parseWindowRect HttpResponse
r =
  do
    x <- Key -> Result Int
bdyInt Key
"x"
    y <- bdyInt "y"
    width <- bdyInt "width"
    height <- bdyInt "height"
    pure $ Rect {..}
  where
    bdyInt :: Key -> Result Int
bdyInt = HttpResponse -> Key -> Result Int
bodyInt HttpResponse
r

mkScript :: Text -> [Value] -> Value
mkScript :: Text -> [Value] -> Value
mkScript Text
script [Value]
args = [Pair] -> Value
object [Key
"script" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
script, Key
"args" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value]
args]

windowHandleParser :: HttpResponse -> Result WindowHandleSpec
windowHandleParser :: HttpResponse -> Result WindowHandleSpec
windowHandleParser HttpResponse
r =
  HttpResponse -> Result Value
bodyValue HttpResponse
r
    Result Value
-> (Value -> Result WindowHandleSpec) -> Result WindowHandleSpec
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Result WindowHandleSpec
forall a. FromJSON a => Value -> Result a
fromJSON

windowHandlesParser :: HttpResponse -> Result [WindowHandle]
windowHandlesParser :: HttpResponse -> Result [WindowHandle]
windowHandlesParser HttpResponse
r = do
  HttpResponse -> Result Value
bodyValue HttpResponse
r
    Result Value
-> (Value -> Result [WindowHandle]) -> Result [WindowHandle]
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Array Array
a -> (Text -> WindowHandle
Handle (Text -> WindowHandle) -> [Text] -> [WindowHandle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Text] -> [WindowHandle])
-> Result [Text] -> Result [WindowHandle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Result Text] -> Result [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Result Text] -> Result [Text])
-> (Vector (Result Text) -> [Result Text])
-> Vector (Result Text)
-> Result [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Result Text) -> [Result Text]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (Result Text) -> Result [Text])
-> Vector (Result Text) -> Result [Text]
forall a b. (a -> b) -> a -> b
$ Value -> Result Text
asText (Value -> Result Text) -> Array -> Vector (Result Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
a)
      Value
v -> Text -> Value -> Result [WindowHandle]
forall a. Text -> Value -> Result a
aesonTypeError Text
"Array" Value
v

-- windowHandleFromValue :: Value -> Maybe WindowHandleSpec
-- windowHandleFromValue v =
--   liftA2 HandleSpec (Handle <$> lookupTxt "handle" v) ( <$> lookupTxt "type" v)

parseCookies :: HttpResponse -> Result [Cookie]
parseCookies :: HttpResponse -> Result [Cookie]
parseCookies HttpResponse
r =
  HttpResponse -> Result Value
bodyValue HttpResponse
r
    Result Value -> (Value -> Result [Cookie]) -> Result [Cookie]
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Array Array
a -> (Value -> Result Cookie) -> [Value] -> Result [Cookie]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Result Cookie
cookieFromBody (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a)
      Value
v -> Text -> Value -> Result [Cookie]
forall a. Text -> Value -> Result a
aesonTypeError Text
"Array" Value
v

parseCookie :: HttpResponse -> Result Cookie
parseCookie :: HttpResponse -> Result Cookie
parseCookie HttpResponse
r =
  HttpResponse -> Result Value
bodyValue HttpResponse
r
    Result Value -> (Value -> Result Cookie) -> Result Cookie
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Result Cookie
cookieFromBody

cookieFromBody :: Value -> Result Cookie
cookieFromBody :: Value -> Result Cookie
cookieFromBody Value
b = case Value
b of
  Object Object
kv -> do
    name <- Key -> Value -> Result Text
lookupTxt Key
"name" Value
b
    value <- lookupTxt "value" b
    path <- opt' "path"
    domain <- opt' "domain"
    secure <- optBool "secure"
    httpOnly <- optBool "httpOnly"
    sameSite <- optBase toSameSite "sameSite"
    expiry <- optInt "expiry"
    pure $ MkCookie {..}
    where
      optBase :: (Value -> Result a) -> Key -> Result (Maybe a)
      optBase :: forall a. (Value -> Result a) -> Key -> Result (Maybe a)
optBase Value -> Result a
typeCaster Key
k = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
k Object
kv Maybe Value
-> (Maybe Value -> Result (Maybe a)) -> Result (Maybe a)
forall a b. a -> (a -> b) -> b
& Result (Maybe a)
-> (Value -> Result (Maybe a)) -> Maybe Value -> Result (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Result (Maybe a)
forall a. a -> Result a
Success Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Result a -> Result (Maybe a)
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Result a -> Result (Maybe a))
-> (Value -> Result a) -> Value -> Result (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result a
typeCaster)
      opt' :: Key -> Result (Maybe Text)
opt' = (Value -> Result Text) -> Key -> Result (Maybe Text)
forall a. (Value -> Result a) -> Key -> Result (Maybe a)
optBase Value -> Result Text
asText
      optInt :: Key -> Result (Maybe Int)
optInt = (Value -> Result Int) -> Key -> Result (Maybe Int)
forall a. (Value -> Result a) -> Key -> Result (Maybe a)
optBase Value -> Result Int
asInt
      optBool :: Key -> Result (Maybe Bool)
optBool = (Value -> Result Bool) -> Key -> Result (Maybe Bool)
forall a. (Value -> Result a) -> Key -> Result (Maybe a)
optBase Value -> Result Bool
asBool
  Value
v -> Text -> Value -> Result Cookie
forall a. Text -> Value -> Result a
aesonTypeError Text
"Object" Value
v

selectorJson :: Selector -> Value
selectorJson :: Selector -> Value
selectorJson = \case
  CSS Text
css -> String -> Text -> Value
forall {v} {v}. (ToJSON v, ToJSON v) => v -> v -> Value
sJSON String
"css selector" Text
css
  XPath Text
xpath -> String -> Text -> Value
forall {v} {v}. (ToJSON v, ToJSON v) => v -> v -> Value
sJSON String
"xpath" Text
xpath
  LinkText Text
lt -> String -> Text -> Value
forall {v} {v}. (ToJSON v, ToJSON v) => v -> v -> Value
sJSON String
"link text" Text
lt
  PartialLinkText Text
plt -> String -> Text -> Value
forall {v} {v}. (ToJSON v, ToJSON v) => v -> v -> Value
sJSON String
"partial link text" Text
plt
  TagName Text
tn -> String -> Text -> Value
forall {v} {v}. (ToJSON v, ToJSON v) => v -> v -> Value
sJSON String
"tag name" Text
tn
  where
    sJSON :: v -> v -> Value
sJSON v
using v
value = [Pair] -> Value
object [Key
"using" Key -> v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
using, Key
"value" Key -> v -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
value]

voidParser :: HttpResponse -> Result ()
voidParser :: HttpResponse -> Result ()
voidParser HttpResponse
_ = () -> Result ()
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

bodyText' :: Result Value -> Key -> Result Text
bodyText' :: Result Value -> Key -> Result Text
bodyText' Result Value
v Key
k = Result Value
v Result Value -> (Value -> Result Text) -> Result Text
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Value -> Result Text
lookupTxt Key
k

bodyText :: HttpResponse -> Key -> Result Text
bodyText :: HttpResponse -> Key -> Result Text
bodyText HttpResponse
r = Result Value -> Key -> Result Text
bodyText' (HttpResponse -> Result Value
bodyValue HttpResponse
r)

bodyInt' :: Result Value -> Key -> Result Int
bodyInt' :: Result Value -> Key -> Result Int
bodyInt' Result Value
v Key
k = Result Value
v Result Value -> (Value -> Result Int) -> Result Int
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Value -> Result Int
lookupInt Key
k

bodyInt :: HttpResponse -> Key -> Result Int
bodyInt :: HttpResponse -> Key -> Result Int
bodyInt HttpResponse
r = Result Value -> Key -> Result Int
bodyInt' (HttpResponse -> Result Value
bodyValue HttpResponse
r)

parseBodyTxt :: HttpResponse -> Result Text
parseBodyTxt :: HttpResponse -> Result Text
parseBodyTxt HttpResponse
r = HttpResponse -> Result Value
bodyValue HttpResponse
r Result Value -> (Value -> Result Text) -> Result Text
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Result Text
asText

parseBodyBool :: HttpResponse -> Result Bool
parseBodyBool :: HttpResponse -> Result Bool
parseBodyBool HttpResponse
r =
  HttpResponse -> Result Value
bodyValue HttpResponse
r Result Value -> (Value -> Result Bool) -> Result Bool
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Result Bool
asBool

asBool :: Value -> Result Bool
asBool :: Value -> Result Bool
asBool = \case
  Bool Bool
b -> Bool -> Result Bool
forall a. a -> Result a
Success Bool
b
  Value
v -> Text -> Value -> Result Bool
forall a. Text -> Value -> Result a
aesonTypeError Text
"Bool" Value
v

parseElementsRef :: HttpResponse -> Result [ElementId]
parseElementsRef :: HttpResponse -> Result [ElementId]
parseElementsRef HttpResponse
r =
  HttpResponse -> Result Value
bodyValue HttpResponse
r
    Result Value -> (Value -> Result [ElementId]) -> Result [ElementId]
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Array Array
a -> (Value -> Result ElementId) -> [Value] -> Result [ElementId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Result ElementId
elemtRefFromBody ([Value] -> Result [ElementId]) -> [Value] -> Result [ElementId]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
      Value
v -> Text -> Value -> Result [ElementId]
forall a. Text -> Value -> Result a
aesonTypeError Text
"Array" Value
v

-- TODO Aeson helpers separate module
lookup :: Key -> Value -> Result Value
lookup :: Key -> Value -> Result Value
lookup Key
k Value
v =
  Value
v Value -> (Value -> Result Value) -> Result Value
forall a b. a -> (a -> b) -> b
& \case
    Object Object
o -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
k Object
o Maybe Value -> (Maybe Value -> Result Value) -> Result Value
forall a b. a -> (a -> b) -> b
& Result Value
-> (Value -> Result Value) -> Maybe Value -> Result Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Result Value
forall a. String -> Result a
A.Error (String
"the key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Key -> String
forall a. Show a => a -> String
show Key
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"does not exist in the object:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
jsonPrettyString Value
v)) Value -> Result Value
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Value
_ -> Text -> Value -> Result Value
forall a. Text -> Value -> Result a
aesonTypeError Text
"Object" Value
v

lookupTxt :: Key -> Value -> Result Text
lookupTxt :: Key -> Value -> Result Text
lookupTxt Key
k Value
v = Key -> Value -> Result Value
lookup Key
k Value
v Result Value -> (Value -> Result Text) -> Result Text
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Result Text
asText

toSameSite :: Value -> Result SameSite
toSameSite :: Value -> Result SameSite
toSameSite = \case
  String Text
"Lax" -> SameSite -> Result SameSite
forall a. a -> Result a
Success SameSite
Lax
  String Text
"Strict" -> SameSite -> Result SameSite
forall a. a -> Result a
Success SameSite
Strict
  String Text
"None" -> SameSite -> Result SameSite
forall a. a -> Result a
Success SameSite
None
  Value
v -> Text -> Text -> Value -> Result SameSite
forall a. Text -> Text -> Value -> Result a
aesonTypeError' Text
"SameSite" Text
"Expected one of: Lax, Strict, None" Value
v

lookupInt :: Key -> Value -> Result Int
lookupInt :: Key -> Value -> Result Int
lookupInt Key
k Value
v = Key -> Value -> Result Value
lookup Key
k Value
v Result Value -> (Value -> Result Int) -> Result Int
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Result Int
asInt

aesonTypeErrorMessage :: Text -> Value -> Text
aesonTypeErrorMessage :: Text -> Value -> Text
aesonTypeErrorMessage Text
t Value
v = Text
"Expected Json Value to be of type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nbut got:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
jsonToText Value
v

aesonTypeError :: Text -> Value -> Result a
aesonTypeError :: forall a. Text -> Value -> Result a
aesonTypeError Text
t Value
v = String -> Result a
forall a. String -> Result a
A.Error (String -> Result a) -> (Text -> String) -> Text -> Result a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Result a) -> Text -> Result a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Text
aesonTypeErrorMessage Text
t Value
v

aesonTypeError' :: Text -> Text -> Value -> Result a
aesonTypeError' :: forall a. Text -> Text -> Value -> Result a
aesonTypeError' Text
typ Text
info Value
v = String -> Result a
forall a. String -> Result a
A.Error (String -> Result a) -> (Text -> String) -> Text -> Result a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Result a) -> Text -> Result a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Text
aesonTypeErrorMessage Text
typ Value
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
info

asText :: Value -> Result Text
asText :: Value -> Result Text
asText = \case
  String Text
t -> Text -> Result Text
forall a. a -> Result a
Success Text
t
  Value
v -> Text -> Value -> Result Text
forall a. Text -> Value -> Result a
aesonTypeError Text
"Text" Value
v

asInt :: Value -> Result Int
asInt :: Value -> Result Int
asInt = \case
  Number Scientific
t -> Int -> Result Int
forall a. a -> Result a
Success (Int -> Result Int) -> Int -> Result Int
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
t
  Value
v -> Text -> Value -> Result Int
forall a. Text -> Value -> Result a
aesonTypeError Text
"Int" Value
v

parseSessionRef :: HttpResponse -> Result SessionId
parseSessionRef :: HttpResponse -> Result SessionId
parseSessionRef HttpResponse
r =
  Text -> SessionId
Session
    (Text -> SessionId) -> Result Text -> Result SessionId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HttpResponse -> Key -> Result Text
bodyText HttpResponse
r Key
"sessionId"

bodyValue :: HttpResponse -> Result Value
bodyValue :: HttpResponse -> Result Value
bodyValue HttpResponse
r = Key -> Value -> Result Value
lookup Key
"value" HttpResponse
r.body

-- https://www.w3.org/TR/webdriver2/#elements
elementFieldName :: Key
elementFieldName :: Key
elementFieldName = Key
"element-6066-11e4-a52e-4f735466cecf"

-- https://www.w3.org/TR/webdriver2/#shadow-root
shadowRootFieldName :: Key
shadowRootFieldName :: Key
shadowRootFieldName = Key
"shadow-6066-11e4-a52e-4f735466cecf"

parseElementRef :: HttpResponse -> Result ElementId
parseElementRef :: HttpResponse -> Result ElementId
parseElementRef HttpResponse
r =
  Text -> ElementId
Element (Text -> ElementId) -> Result Text -> Result ElementId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HttpResponse -> Key -> Result Text
bodyText HttpResponse
r Key
elementFieldName

parseShadowElementRef :: HttpResponse -> Result ElementId
parseShadowElementRef :: HttpResponse -> Result ElementId
parseShadowElementRef HttpResponse
r =
  Text -> ElementId
Element (Text -> ElementId) -> Result Text -> Result ElementId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HttpResponse -> Key -> Result Text
bodyText HttpResponse
r Key
shadowRootFieldName

elemtRefFromBody :: Value -> Result ElementId
elemtRefFromBody :: Value -> Result ElementId
elemtRefFromBody Value
b = Text -> ElementId
Element (Text -> ElementId) -> Result Text -> Result ElementId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Value -> Result Text
lookupTxt Key
elementFieldName Value
b

session :: Text
session :: Text
session = Text
"session"

sessionUri :: Text -> UrlPath
sessionUri :: Text -> UrlPath
sessionUri Text
sp = [Text] -> UrlPath
MkUrlPath [Text
session, Text
sp]

sessionUri1 :: SessionId -> Text -> UrlPath
sessionUri1 :: SessionId -> Text -> UrlPath
sessionUri1 SessionId
s Text
sp = [Text] -> UrlPath
MkUrlPath [Text
session, SessionId
s.id, Text
sp]

sessionUri2 :: SessionId -> Text -> Text -> UrlPath
sessionUri2 :: SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
s Text
sp Text
sp2 = [Text] -> UrlPath
MkUrlPath [Text
session, SessionId
s.id, Text
sp, Text
sp2]

sessionUri3 :: SessionId -> Text -> Text -> Text -> UrlPath
sessionUri3 :: SessionId -> Text -> Text -> Text -> UrlPath
sessionUri3 SessionId
s Text
sp Text
sp2 Text
sp3 = [Text] -> UrlPath
MkUrlPath [Text
session, SessionId
s.id, Text
sp, Text
sp2, Text
sp3]

sessionUri4 :: SessionId -> Text -> Text -> Text -> Text -> UrlPath
sessionUri4 :: SessionId -> Text -> Text -> Text -> Text -> UrlPath
sessionUri4 SessionId
s Text
sp Text
sp2 Text
sp3 Text
sp4 = [Text] -> UrlPath
MkUrlPath [Text
session, SessionId
s.id, Text
sp, Text
sp2, Text
sp3, Text
sp4]

window :: Text
window :: Text
window = Text
"window"

windowUri1 :: SessionId -> Text -> UrlPath
windowUri1 :: SessionId -> Text -> UrlPath
windowUri1 SessionId
sr Text
sp = SessionId -> Text -> Text -> UrlPath
sessionUri2 SessionId
sr Text
window Text
sp

elementUri1 :: SessionId -> ElementId -> Text -> UrlPath
elementUri1 :: SessionId -> ElementId -> Text -> UrlPath
elementUri1 SessionId
s ElementId
er Text
ep = SessionId -> Text -> Text -> Text -> UrlPath
sessionUri3 SessionId
s Text
"element" ElementId
er.id Text
ep

elementUri2 :: SessionId -> ElementId -> Text -> Text -> UrlPath
elementUri2 :: SessionId -> ElementId -> Text -> Text -> UrlPath
elementUri2 SessionId
s ElementId
er Text
ep Text
ep2 = SessionId -> Text -> Text -> Text -> Text -> UrlPath
sessionUri4 SessionId
s Text
"element" ElementId
er.id Text
ep Text
ep2

jsonPrettyString :: Value -> String
jsonPrettyString :: Value -> String
jsonPrettyString = Text -> String
unpack (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
jsonToText

mkShowable :: W3Spec a -> W3SpecShowable
mkShowable :: forall a. W3Spec a -> W3SpecShowable
mkShowable = \case
  Get Text
d UrlPath
p HttpResponse -> Result a
_ -> Text -> Text -> UrlPath -> Maybe Text -> W3SpecShowable
Request Text
d Text
"GET" UrlPath
p Maybe Text
forall a. Maybe a
Nothing
  Post Text
d UrlPath
p Value
b HttpResponse -> Result a
_ -> Text -> Text -> UrlPath -> Maybe Text -> W3SpecShowable
Request Text
d Text
"POST" UrlPath
p (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Value -> Text
jsonToText Value
b)
  PostEmpty Text
d UrlPath
p HttpResponse -> Result a
_ -> Text -> Text -> UrlPath -> Maybe Text -> W3SpecShowable
Request Text
d Text
"POST" UrlPath
p Maybe Text
forall a. Maybe a
Nothing
  Delete Text
d UrlPath
p HttpResponse -> Result a
_ -> Text -> Text -> UrlPath -> Maybe Text -> W3SpecShowable
Request Text
d Text
"DELETE" UrlPath
p Maybe Text
forall a. Maybe a
Nothing

parseDriverStatus :: HttpResponse -> Result DriverStatus
parseDriverStatus :: HttpResponse -> Result DriverStatus
parseDriverStatus MkHttpResponse {Int
statusCode :: Int
statusCode :: HttpResponse -> Int
statusCode, Text
statusMessage :: Text
statusMessage :: HttpResponse -> Text
statusMessage} =
  DriverStatus -> Result DriverStatus
forall a. a -> Result a
Success (DriverStatus -> Result DriverStatus)
-> DriverStatus -> Result DriverStatus
forall a b. (a -> b) -> a -> b
$
    Int
statusCode Int -> (Int -> DriverStatus) -> DriverStatus
forall a b. a -> (a -> b) -> b
& \case
      Int
200 -> DriverStatus
Ready
      Int
500 -> ServiceError {Int
statusCode :: Int
statusCode :: Int
statusCode, Text
statusMessage :: Text
statusMessage :: Text
statusMessage}
      Int
501 -> DriverStatus
Running
      Int
_ -> Unknown {Int
statusCode :: Int
statusCode :: Int
statusCode, Text
statusMessage :: Text
statusMessage :: Text
statusMessage}

keysJson :: Text -> Value
keysJson :: Text -> Value
keysJson Text
keysToSend = [Pair] -> Value
object [Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
keysToSend]

-- actions
-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
newtype Actions = MkActions {Actions -> [Action]
actions :: [Action]}

actionsToJson :: Actions -> Value
actionsToJson :: Actions -> Value
actionsToJson MkActions {[Action]
actions :: Actions -> [Action]
actions :: [Action]
actions} =
  [Pair] -> Value
object
    [ Key
"actions" Key -> [Action] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Action]
actions
    ]

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
data KeyAction
  = PauseKey {KeyAction -> Maybe Int
duration :: Maybe Int} -- ms
  | KeyDown
      { KeyAction -> Text
value :: Text
      }
  | KeyUp
      { value :: Text
      }
  deriving (Int -> KeyAction -> ShowS
[KeyAction] -> ShowS
KeyAction -> String
(Int -> KeyAction -> ShowS)
-> (KeyAction -> String)
-> ([KeyAction] -> ShowS)
-> Show KeyAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyAction -> ShowS
showsPrec :: Int -> KeyAction -> ShowS
$cshow :: KeyAction -> String
show :: KeyAction -> String
$cshowList :: [KeyAction] -> ShowS
showList :: [KeyAction] -> ShowS
Show, KeyAction -> KeyAction -> Bool
(KeyAction -> KeyAction -> Bool)
-> (KeyAction -> KeyAction -> Bool) -> Eq KeyAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyAction -> KeyAction -> Bool
== :: KeyAction -> KeyAction -> Bool
$c/= :: KeyAction -> KeyAction -> Bool
/= :: KeyAction -> KeyAction -> Bool
Eq)

instance ToJSON KeyAction where
  toJSON :: KeyAction -> Value
  toJSON :: KeyAction -> Value
toJSON PauseKey {Maybe Int
duration :: KeyAction -> Maybe Int
duration :: Maybe Int
duration} =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pause" :: Text)
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"duration" Maybe Int
duration]
  toJSON KeyDown {Text
value :: KeyAction -> Text
value :: Text
value} =
    [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"keyDown" :: Text),
        Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
value
      ]
  toJSON KeyUp {Text
value :: KeyAction -> Text
value :: Text
value} =
    [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"keyUp" :: Text),
        Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
value
      ]

-- Pointer subtypes
-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
data Pointer
  = Mouse
  | Pen
  | Touch
  deriving (Int -> Pointer -> ShowS
[Pointer] -> ShowS
Pointer -> String
(Int -> Pointer -> ShowS)
-> (Pointer -> String) -> ([Pointer] -> ShowS) -> Show Pointer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pointer -> ShowS
showsPrec :: Int -> Pointer -> ShowS
$cshow :: Pointer -> String
show :: Pointer -> String
$cshowList :: [Pointer] -> ShowS
showList :: [Pointer] -> ShowS
Show, Pointer -> Pointer -> Bool
(Pointer -> Pointer -> Bool)
-> (Pointer -> Pointer -> Bool) -> Eq Pointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pointer -> Pointer -> Bool
== :: Pointer -> Pointer -> Bool
$c/= :: Pointer -> Pointer -> Bool
/= :: Pointer -> Pointer -> Bool
Eq)

mkLwrTxt :: (Show a) => a -> Value
mkLwrTxt :: forall a. Show a => a -> Value
mkLwrTxt = Text -> Value
String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
txt

instance ToJSON Pointer where
  toJSON :: Pointer -> Value
  toJSON :: Pointer -> Value
toJSON = Pointer -> Value
forall a. Show a => a -> Value
mkLwrTxt

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
data PointerOrigin
  = Viewport
  | OriginPointer
  | OriginElement ElementId
  deriving (Int -> PointerOrigin -> ShowS
[PointerOrigin] -> ShowS
PointerOrigin -> String
(Int -> PointerOrigin -> ShowS)
-> (PointerOrigin -> String)
-> ([PointerOrigin] -> ShowS)
-> Show PointerOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointerOrigin -> ShowS
showsPrec :: Int -> PointerOrigin -> ShowS
$cshow :: PointerOrigin -> String
show :: PointerOrigin -> String
$cshowList :: [PointerOrigin] -> ShowS
showList :: [PointerOrigin] -> ShowS
Show, PointerOrigin -> PointerOrigin -> Bool
(PointerOrigin -> PointerOrigin -> Bool)
-> (PointerOrigin -> PointerOrigin -> Bool) -> Eq PointerOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointerOrigin -> PointerOrigin -> Bool
== :: PointerOrigin -> PointerOrigin -> Bool
$c/= :: PointerOrigin -> PointerOrigin -> Bool
/= :: PointerOrigin -> PointerOrigin -> Bool
Eq)

instance ToJSON PointerOrigin where
  toJSON :: PointerOrigin -> Value
  toJSON :: PointerOrigin -> Value
toJSON = \case
    PointerOrigin
Viewport -> Value
"viewport"
    PointerOrigin
OriginPointer -> Value
"pointer"
    OriginElement (Element Text
id') -> [Pair] -> Value
object [Key
"element" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
id']


-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
data Action
  = NoneAction
      { Action -> Text
id :: Text,
        -- the numeric id of the pointing device. This is a positive integer, with the values 0 and 1 reserved for mouse-type pointers.
        Action -> [Maybe Int]
noneActions :: [Maybe Int] -- delay
      }
  | Key
      { id :: Text,
        Action -> [KeyAction]
keyActions :: [KeyAction]
        -- https://github.com/jlipps/simple-wd-spec?tab=readme-ov-file#perform-actions
        -- keys codepoint https://www.w3.org/TR/webdriver2/#keyboard-actions
      }
  | Pointer
      { id :: Text,
        Action -> Pointer
subType :: Pointer,
        -- the numeric id of the pointing device. This is a positive integer, with the values 0 and 1 reserved for mouse-type pointers.
        Action -> Int
pointerId :: Int,
        Action -> Set Int
pressed :: Set Int, -- pressed buttons
        Action -> Int
x :: Int, -- start x location in viewport coordinates.
        Action -> Int
y :: Int, -- start y location in viewport coordinates
        Action -> [PointerAction]
actions :: [PointerAction]
      }
  | Wheel
      { id :: Text,
        Action -> [WheelAction]
wheelActions :: [WheelAction]
      }
  deriving (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
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show, Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
/= :: Action -> Action -> Bool
Eq)

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
data WheelAction
  = PauseWheel {WheelAction -> Maybe Int
duration :: Maybe Int} -- ms
  | Scroll
      { WheelAction -> PointerOrigin
origin :: PointerOrigin,
        WheelAction -> Int
x :: Int,
        WheelAction -> Int
y :: Int,
        WheelAction -> Int
deltaX :: Int,
        WheelAction -> Int
deltaY :: Int,
        duration :: Maybe Int -- ms
      }
  deriving (Int -> WheelAction -> ShowS
[WheelAction] -> ShowS
WheelAction -> String
(Int -> WheelAction -> ShowS)
-> (WheelAction -> String)
-> ([WheelAction] -> ShowS)
-> Show WheelAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WheelAction -> ShowS
showsPrec :: Int -> WheelAction -> ShowS
$cshow :: WheelAction -> String
show :: WheelAction -> String
$cshowList :: [WheelAction] -> ShowS
showList :: [WheelAction] -> ShowS
Show, WheelAction -> WheelAction -> Bool
(WheelAction -> WheelAction -> Bool)
-> (WheelAction -> WheelAction -> Bool) -> Eq WheelAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WheelAction -> WheelAction -> Bool
== :: WheelAction -> WheelAction -> Bool
$c/= :: WheelAction -> WheelAction -> Bool
/= :: WheelAction -> WheelAction -> Bool
Eq)

instance ToJSON WheelAction where
  toJSON :: WheelAction -> Value
  toJSON :: WheelAction -> Value
toJSON WheelAction
wa =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
base [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"duration" WheelAction
wa.duration]
    where
      base :: [Pair]
base = case WheelAction
wa of
        PauseWheel Maybe Int
_ -> [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pause" :: Text)]
        Scroll
          { PointerOrigin
origin :: WheelAction -> PointerOrigin
origin :: PointerOrigin
origin,
            Int
x :: WheelAction -> Int
x :: Int
x,
            Int
y :: WheelAction -> Int
y :: Int
y,
            Int
deltaX :: WheelAction -> Int
deltaX :: Int
deltaX,
            Int
deltaY :: WheelAction -> Int
deltaY :: Int
deltaY
          } ->
            [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"scroll" :: Text),
              Key
"origin" Key -> PointerOrigin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PointerOrigin
origin,
              Key
"x" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x,
              Key
"y" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
y,
              Key
"deltaX" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
deltaX,
              Key
"deltaY" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
deltaY
            ]

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20250210/#actions)
data PointerAction
  = PausePointer {PointerAction -> Maybe Int
duration :: Maybe Int} -- ms
  | Up
      { PointerAction -> Int
button :: Int,
        PointerAction -> Maybe Int
width :: Maybe Int,
        PointerAction -> Maybe Int
height :: Maybe Int,
        PointerAction -> Maybe Float
pressure :: Maybe Float, -- 0 -> 1
        PointerAction -> Maybe Float
tangentialPressure :: Maybe Float, -- -1 -> 1
        PointerAction -> Maybe Int
tiltX :: Maybe Int, -- -90 -> 90
        PointerAction -> Maybe Int
tiltY :: Maybe Int, -- -90 -> 90
        PointerAction -> Maybe Int
twist :: Maybe Int, -- 0 -> 359
        PointerAction -> Maybe Double
altitudeAngle :: Maybe Double, -- 0 -> pi/2
        PointerAction -> Maybe Double
azimuthAngle :: Maybe Double -- 0 -> 2pi-- button} -- button
      }
  | Down
      { button :: Int,
        width :: Maybe Int,
        height :: Maybe Int,
        pressure :: Maybe Float, -- 0 -> 1
        tangentialPressure :: Maybe Float, -- -1 -> 1
        tiltX :: Maybe Int, -- -90 -> 90
        tiltY :: Maybe Int, -- -90 -> 90
        twist :: Maybe Int, -- 0 -> 359
        altitudeAngle :: Maybe Double, -- 0 -> pi/2
        azimuthAngle :: Maybe Double -- 0 -> 2pi-- button
      }
  | Move
      { PointerAction -> PointerOrigin
origin :: PointerOrigin,
        duration :: Maybe Int, -- ms
        -- where to move to
        -- though the spec seems to indicate width and height are double
        -- gecko driver was blowing up with anything other than int
        width :: Maybe Int,
        height :: Maybe Int,
        pressure :: Maybe Float, -- 0 -> 1
        tangentialPressure :: Maybe Float, -- -1 -> 1
        tiltX :: Maybe Int, -- -90 -> 90
        tiltY :: Maybe Int, -- -90 -> 90
        twist :: Maybe Int, -- 0 -> 359
        altitudeAngle :: Maybe Double, -- 0 -> pi/2
        azimuthAngle :: Maybe Double, -- 0 -> 2pi
        PointerAction -> Int
x :: Int,
        PointerAction -> Int
y :: Int
      }
  | -- looks like not supported yet by gecko driver 02-02-2025
    -- https://searchfox.org/mozilla-central/source/remote/shared/webdriver/Actions.sys.mjs#2340
    Cancel
  deriving (Int -> PointerAction -> ShowS
[PointerAction] -> ShowS
PointerAction -> String
(Int -> PointerAction -> ShowS)
-> (PointerAction -> String)
-> ([PointerAction] -> ShowS)
-> Show PointerAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointerAction -> ShowS
showsPrec :: Int -> PointerAction -> ShowS
$cshow :: PointerAction -> String
show :: PointerAction -> String
$cshowList :: [PointerAction] -> ShowS
showList :: [PointerAction] -> ShowS
Show, PointerAction -> PointerAction -> Bool
(PointerAction -> PointerAction -> Bool)
-> (PointerAction -> PointerAction -> Bool) -> Eq PointerAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointerAction -> PointerAction -> Bool
== :: PointerAction -> PointerAction -> Bool
$c/= :: PointerAction -> PointerAction -> Bool
/= :: PointerAction -> PointerAction -> Bool
Eq)

instance ToJSON PointerAction where
  toJSON :: PointerAction -> Value
  toJSON :: PointerAction -> Value
toJSON = \case
    PausePointer Maybe Int
d ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pause" :: Text)]
          [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"duration" Maybe Int
d]
    Up
      { -- https://www.w3.org/TR/pointerevents/#dom-pointerevent-pointerid
        Int
button :: PointerAction -> Int
button :: Int
button,
        Maybe Int
width :: PointerAction -> Maybe Int
width :: Maybe Int
width, -- magnitude on the X axis), in CSS pixels (see [CSS21]) -- default = 1
        Maybe Int
height :: PointerAction -> Maybe Int
height :: Maybe Int
height, -- (magnitude on the Y axis), in CSS pixels (see [CSS21]) -- default = 1
        Maybe Float
pressure :: PointerAction -> Maybe Float
pressure :: Maybe Float
pressure, -- 0 - 1
        Maybe Float
tangentialPressure :: PointerAction -> Maybe Float
tangentialPressure :: Maybe Float
tangentialPressure, -- -1 -> 1
        Maybe Int
tiltX :: PointerAction -> Maybe Int
tiltX :: Maybe Int
tiltX, -- -90 -> 90
        Maybe Int
tiltY :: PointerAction -> Maybe Int
tiltY :: Maybe Int
tiltY, -- -90 -> 90
        Maybe Int
twist :: PointerAction -> Maybe Int
twist :: Maybe Int
twist, -- 0 -> 359
        Maybe Double
altitudeAngle :: PointerAction -> Maybe Double
altitudeAngle :: Maybe Double
altitudeAngle, -- 0 -> pi/2
        Maybe Double
azimuthAngle :: PointerAction -> Maybe Double
azimuthAngle :: Maybe Double
azimuthAngle -- 0 -> 2pi
      } ->
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pointerUp" :: Text),
            Key
"button" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
button
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
              [ Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"height" Maybe Int
height,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"width" Maybe Int
width,
                Key -> Maybe Float -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"pressure" Maybe Float
pressure,
                Key -> Maybe Float -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tangentialPressure" Maybe Float
tangentialPressure,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tiltX" Maybe Int
tiltX,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tiltY" Maybe Int
tiltY,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"twist" Maybe Int
twist,
                Key -> Maybe Double -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"altitudeAngle" Maybe Double
altitudeAngle,
                Key -> Maybe Double -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"azimuthAngle" Maybe Double
azimuthAngle
              ]
    Down
      { Int
button :: PointerAction -> Int
button :: Int
button,
        Maybe Int
width :: PointerAction -> Maybe Int
width :: Maybe Int
width,
        Maybe Int
height :: PointerAction -> Maybe Int
height :: Maybe Int
height,
        Maybe Float
pressure :: PointerAction -> Maybe Float
pressure :: Maybe Float
pressure,
        Maybe Float
tangentialPressure :: PointerAction -> Maybe Float
tangentialPressure :: Maybe Float
tangentialPressure, -- -1 -> 1
        Maybe Int
tiltX :: PointerAction -> Maybe Int
tiltX :: Maybe Int
tiltX, -- -90 -> 90
        Maybe Int
tiltY :: PointerAction -> Maybe Int
tiltY :: Maybe Int
tiltY, -- -90 -> 90
        Maybe Int
twist :: PointerAction -> Maybe Int
twist :: Maybe Int
twist, -- 0 -> 359
        Maybe Double
altitudeAngle :: PointerAction -> Maybe Double
altitudeAngle :: Maybe Double
altitudeAngle, -- 0 -> pi/2
        Maybe Double
azimuthAngle :: PointerAction -> Maybe Double
azimuthAngle :: Maybe Double
azimuthAngle -- 0 -> 2pi
      } ->
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pointerDown" :: Text),
            Key
"button" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
button
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
              [ Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"height" Maybe Int
height,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"width" Maybe Int
width,
                Key -> Maybe Float -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"pressure" Maybe Float
pressure,
                Key -> Maybe Float -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tangentialPressure" Maybe Float
tangentialPressure,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tiltX" Maybe Int
tiltX,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tiltY" Maybe Int
tiltY,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"twist" Maybe Int
twist,
                Key -> Maybe Double -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"altitudeAngle" Maybe Double
altitudeAngle,
                Key -> Maybe Double -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"azimuthAngle" Maybe Double
azimuthAngle
              ]
    Move
      { PointerOrigin
origin :: PointerAction -> PointerOrigin
origin :: PointerOrigin
origin,
        Maybe Int
duration :: PointerAction -> Maybe Int
duration :: Maybe Int
duration,
        Maybe Int
width :: PointerAction -> Maybe Int
width :: Maybe Int
width,
        Maybe Int
height :: PointerAction -> Maybe Int
height :: Maybe Int
height,
        Maybe Float
pressure :: PointerAction -> Maybe Float
pressure :: Maybe Float
pressure,
        Maybe Float
tangentialPressure :: PointerAction -> Maybe Float
tangentialPressure :: Maybe Float
tangentialPressure, -- -1 -> 1
        Maybe Int
tiltX :: PointerAction -> Maybe Int
tiltX :: Maybe Int
tiltX, -- -90 -> 90
        Maybe Int
tiltY :: PointerAction -> Maybe Int
tiltY :: Maybe Int
tiltY, -- -90 -> 90
        Maybe Int
twist :: PointerAction -> Maybe Int
twist :: Maybe Int
twist, -- 0 -> 359
        Maybe Double
altitudeAngle :: PointerAction -> Maybe Double
altitudeAngle :: Maybe Double
altitudeAngle, -- 0 -> pi/2
        Maybe Double
azimuthAngle :: PointerAction -> Maybe Double
azimuthAngle :: Maybe Double
azimuthAngle, -- 0 -> 2pi
        Int
x :: PointerAction -> Int
x :: Int
x,
        Int
y :: PointerAction -> Int
y :: Int
y
      } ->
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pointerMove" :: Text),
            Key
"origin" Key -> PointerOrigin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PointerOrigin
origin,
            Key
"x" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x,
            Key
"y" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
y
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
              [ Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"duration" Maybe Int
duration,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"height" Maybe Int
height,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"width" Maybe Int
width,
                Key -> Maybe Float -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"pressure" Maybe Float
pressure,
                Key -> Maybe Float -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tangentialPressure" Maybe Float
tangentialPressure,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tiltX" Maybe Int
tiltX,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"tiltY" Maybe Int
tiltY,
                Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"twist" Maybe Int
twist,
                Key -> Maybe Double -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"altitudeAngle" Maybe Double
altitudeAngle,
                Key -> Maybe Double -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"azimuthAngle" Maybe Double
azimuthAngle
              ]
    -- looks like Cancel not supported yet by gecko driver 02-02-2025
    -- https://searchfox.org/mozilla-central/source/remote/shared/webdriver/Actions.sys.mjs#2340
    PointerAction
Cancel -> [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pointerCancel" :: Text)]

mkPause :: Maybe Int -> Value
mkPause :: Maybe Int -> Value
mkPause Maybe Int
d = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pause" :: Text)] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Key -> Maybe Int -> Maybe Pair
forall (f :: * -> *) e b a.
(Functor f, KeyValue e b, ToJSON a) =>
Key -> f a -> f b
opt Key
"duration" Maybe Int
d]

instance ToJSON Action where
  toJSON :: Action -> Value
  toJSON :: Action -> Value
toJSON = \case
    NoneAction
      { Text
id :: Action -> Text
id :: Text
id,
        [Maybe Int]
noneActions :: Action -> [Maybe Int]
noneActions :: [Maybe Int]
noneActions
      } ->
        [Pair] -> Value
object
          [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"none" :: Text),
            Key
"id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
id,
            Key
"actions" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Maybe Int -> Value
mkPause (Maybe Int -> Value) -> [Maybe Int] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Int]
noneActions)
          ]
    Key {Text
id :: Action -> Text
id :: Text
id, [KeyAction]
keyActions :: Action -> [KeyAction]
keyActions :: [KeyAction]
keyActions} ->
      [Pair] -> Value
object
        [ Key
"id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
id,
          Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"key" :: Text),
          Key
"actions" Key -> [KeyAction] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [KeyAction]
keyActions
        ]
    Pointer
      { Pointer
subType :: Action -> Pointer
subType :: Pointer
subType,
        [PointerAction]
actions :: Action -> [PointerAction]
actions :: [PointerAction]
actions,
        Int
pointerId :: Action -> Int
pointerId :: Int
pointerId,
        Set Int
pressed :: Action -> Set Int
pressed :: Set Int
pressed,
        Text
id :: Action -> Text
id :: Text
id,
        Int
x :: Action -> Int
x :: Int
x,
        Int
y :: Action -> Int
y :: Int
y
      } ->
        [Pair] -> Value
object
          [ Key
"id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
id,
            Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"pointer" :: Text),
            Key
"subType" Key -> Pointer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Pointer
subType,
            Key
"pointerId" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
pointerId,
            Key
"pressed" Key -> Set Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set Int
pressed,
            Key
"x" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x,
            Key
"y" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
y,
            Key
"actions" Key -> [PointerAction] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [PointerAction]
actions
          ]
    Wheel {Text
id :: Action -> Text
id :: Text
id, [WheelAction]
wheelActions :: Action -> [WheelAction]
wheelActions :: [WheelAction]
wheelActions} ->
      [Pair] -> Value
object
        [ Key
"id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
id,
          Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"wheel" :: Text),
          Key
"actions" Key -> [WheelAction] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [WheelAction]
wheelActions
        ]