{-| 
This module defines the 'Command' type and related types/functions for HTTP commands referenced by the API functions in "WebDriverPreCore.HTTP.API" 

"WebDriverPreCore.HTTP.API" contains functions that generate the payload for each HTTP command and is the main interface for users of this package to interact with the WebDriver HTTP protocol.

An example of using these modules to implement a basic HTTP client can be found in the [test repository](https://github.com/pyrethrum/webdriver/tree/main/webdriver-precore/test#readme) for this package.
-}

module WebDriverPreCore.HTTP.Protocol
  (

    -- * Command
    Command (..),

    -- ** Constructors
    {-| The following constructors are utility functions that partially applied in "WebDriverPreCore.HTTP.API" to generate specific named command functions for POST requests. 
        Although these functions form the basis of many commands in the "WebDriverPreCore.HTTP.API", it would be unusual to need to use these directly.
    -}
    mkPost,
    mkPost',

    -- ** Fallback Constructors
    {-| The following constructors are provided to modify or create new commands that are not directly supported by the "WebDriverPreCore.HTTP.API".
        These constructors provide a means by which users can work around defects in this package or defects in driver implementation as well as handling driver specific extensions to the HTTP protocol. 
    -}
    voidCommand,
    loosenCommand,
    coerceCommand,
    extendPost,
    extendPostLoosen,

    -- * Capabilities
    FullCapabilities (..),
    Capabilities (..),
    UnhandledPromptBehavior (..),
    PageLoadStrategy (..),
    BrowserName (..),
    PlatformName (..),
    Proxy (..),
    VendorSpecific (..),
    SocksProxy (..),
    Timeouts (..),
    PerfLoggingPrefs (..),
    MobileEmulation (..),
    LogLevel (..),
    LogSettings (..),
    DeviceMetrics (..),
     -- * Capability Utility Functions
    alwaysMatchCapabilities,
    minCapabilities,
    minFullCapabilities,
    minFirefoxCapabilities,
    minChromeCapabilities,

    -- * Error
    module WebDriverPreCore.Error,

    -- * Core Types
    Cookie (..),
    Status (..),
    ElementId (..),
    ShadowRootElementId (..),
    FrameReference (..),
    HandleType (..),
    SameSite (..),
    Script (..),
    Selector (..),
    Session (..),
    SessionResponse (..),
    Handle (..),
    WindowHandleSpec (..),
    WindowRect (..),
    module Url,

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

import AesonUtils (nonEmpty, opt, parseObject)
import Data.Aeson as A
  ( FromJSON (..),
    Key,
    KeyValue ((.=)),
    ToJSON (toJSON),
    Value (..),
    object,
    withObject,
    withText,
    (.:),
    (.:?),
  )
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types (Parser)
import Data.Function ((&))
import Data.Map.Strict qualified as M
import Data.Maybe (catMaybes)
import Data.Set (Set, fromList, notMember)
import Data.Text (Text, pack, unpack)
import Data.Text qualified as T
import Data.Word (Word16)
import GHC.Generics (Generic)
import Utils (txt)
import WebDriverPreCore.Error
import WebDriverPreCore.HTTP.Capabilities
import WebDriverPreCore.HTTP.Command
import WebDriverPreCore.Internal.HTTPBidiCommon as Url (URL (..))
import Prelude hiding (id)

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

instance ToJSON Handle where
  toJSON :: Handle -> Value
  toJSON :: Handle -> Value
toJSON (MkHandle Text
handle) = [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]

instance FromJSON Handle where
  parseJSON :: Value -> Parser Handle
  parseJSON :: Value -> Parser Handle
parseJSON = \case
    String Text
t -> Handle -> Parser Handle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle -> Parser Handle) -> Handle -> Parser Handle
forall a b. (a -> b) -> a -> b
$ Text -> Handle
MkHandle Text
t
    Object Object
o -> do
      h <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"handle"
      pure $ MkHandle h
    Value
v -> String -> Parser Handle
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Handle) -> String -> Parser Handle
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Expected Handle as String or Object with handle property, got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall a. Show a => a -> Text
txt Value
v

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#new-window)
data WindowHandleSpec = HandleSpec
  { WindowHandleSpec -> Handle
handle :: Handle,
    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 {Handle
handle :: WindowHandleSpec -> Handle
handle :: Handle
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
.= Handle
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 -> Handle
MkHandle (Text -> Handle) -> Parser Text -> Parser Handle
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-20251028/#dfn-find-element)
newtype ElementId = MkElement {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)

instance ToJSON ElementId where
  toJSON :: ElementId -> Value
  toJSON :: ElementId -> Value
toJSON (MkElement Text
id) = [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
.= Text
id]

instance FromJSON ElementId where
  parseJSON :: Value -> Parser ElementId
  parseJSON :: Value -> Parser ElementId
parseJSON =
    String -> (Object -> Parser ElementId) -> Value -> Parser ElementId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ElementId" ((Object -> Parser ElementId) -> Value -> Parser ElementId)
-> (Object -> Parser ElementId) -> Value -> Parser ElementId
forall a b. (a -> b) -> a -> b
$
      (Text -> ElementId) -> Parser Text -> Parser ElementId
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ElementId
MkElement (Parser Text -> Parser ElementId)
-> (Object -> Parser Text) -> Object -> Parser ElementId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
elementFieldName)

newtype ShadowRootElementId = MkShadowRootElementId {ShadowRootElementId -> Text
id :: Text}
  deriving (Int -> ShadowRootElementId -> ShowS
[ShadowRootElementId] -> ShowS
ShadowRootElementId -> String
(Int -> ShadowRootElementId -> ShowS)
-> (ShadowRootElementId -> String)
-> ([ShadowRootElementId] -> ShowS)
-> Show ShadowRootElementId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShadowRootElementId -> ShowS
showsPrec :: Int -> ShadowRootElementId -> ShowS
$cshow :: ShadowRootElementId -> String
show :: ShadowRootElementId -> String
$cshowList :: [ShadowRootElementId] -> ShowS
showList :: [ShadowRootElementId] -> ShowS
Show, ShadowRootElementId -> ShadowRootElementId -> Bool
(ShadowRootElementId -> ShadowRootElementId -> Bool)
-> (ShadowRootElementId -> ShadowRootElementId -> Bool)
-> Eq ShadowRootElementId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShadowRootElementId -> ShadowRootElementId -> Bool
== :: ShadowRootElementId -> ShadowRootElementId -> Bool
$c/= :: ShadowRootElementId -> ShadowRootElementId -> Bool
/= :: ShadowRootElementId -> ShadowRootElementId -> Bool
Eq, (forall x. ShadowRootElementId -> Rep ShadowRootElementId x)
-> (forall x. Rep ShadowRootElementId x -> ShadowRootElementId)
-> Generic ShadowRootElementId
forall x. Rep ShadowRootElementId x -> ShadowRootElementId
forall x. ShadowRootElementId -> Rep ShadowRootElementId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShadowRootElementId -> Rep ShadowRootElementId x
from :: forall x. ShadowRootElementId -> Rep ShadowRootElementId x
$cto :: forall x. Rep ShadowRootElementId x -> ShadowRootElementId
to :: forall x. Rep ShadowRootElementId x -> ShadowRootElementId
Generic)

instance ToJSON ShadowRootElementId where
  toJSON :: ShadowRootElementId -> Value
  toJSON :: ShadowRootElementId -> Value
toJSON (MkShadowRootElementId Text
id) = [Pair] -> Value
object [Key
shadowRootFieldName Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
id]

instance FromJSON ShadowRootElementId where
  parseJSON :: Value -> Parser ShadowRootElementId
  parseJSON :: Value -> Parser ShadowRootElementId
parseJSON =
    String
-> (Object -> Parser ShadowRootElementId)
-> Value
-> Parser ShadowRootElementId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ElementId" ((Object -> Parser ShadowRootElementId)
 -> Value -> Parser ShadowRootElementId)
-> (Object -> Parser ShadowRootElementId)
-> Value
-> Parser ShadowRootElementId
forall a b. (a -> b) -> a -> b
$
      (Text -> ShadowRootElementId)
-> Parser Text -> Parser ShadowRootElementId
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ShadowRootElementId
MkShadowRootElementId (Parser Text -> Parser ShadowRootElementId)
-> (Object -> Parser Text) -> Object -> Parser ShadowRootElementId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
shadowRootFieldName)

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

data SessionResponse = MkSessionResponse
  { SessionResponse -> Session
sessionId :: Session,
    SessionResponse -> Maybe Text
webSocketUrl :: Maybe Text,
    SessionResponse -> Capabilities
capabilities :: Capabilities,
    SessionResponse -> Maybe (Map Text Value)
extensions :: Maybe (M.Map Text Value)
  }
  deriving (Int -> SessionResponse -> ShowS
[SessionResponse] -> ShowS
SessionResponse -> String
(Int -> SessionResponse -> ShowS)
-> (SessionResponse -> String)
-> ([SessionResponse] -> ShowS)
-> Show SessionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionResponse -> ShowS
showsPrec :: Int -> SessionResponse -> ShowS
$cshow :: SessionResponse -> String
show :: SessionResponse -> String
$cshowList :: [SessionResponse] -> ShowS
showList :: [SessionResponse] -> ShowS
Show, SessionResponse -> SessionResponse -> Bool
(SessionResponse -> SessionResponse -> Bool)
-> (SessionResponse -> SessionResponse -> Bool)
-> Eq SessionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionResponse -> SessionResponse -> Bool
== :: SessionResponse -> SessionResponse -> Bool
$c/= :: SessionResponse -> SessionResponse -> Bool
/= :: SessionResponse -> SessionResponse -> Bool
Eq, (forall x. SessionResponse -> Rep SessionResponse x)
-> (forall x. Rep SessionResponse x -> SessionResponse)
-> Generic SessionResponse
forall x. Rep SessionResponse x -> SessionResponse
forall x. SessionResponse -> Rep SessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SessionResponse -> Rep SessionResponse x
from :: forall x. SessionResponse -> Rep SessionResponse x
$cto :: forall x. Rep SessionResponse x -> SessionResponse
to :: forall x. Rep SessionResponse x -> SessionResponse
Generic)

webSocketKey :: Key
webSocketKey :: Key
webSocketKey = Key
"webSocketUrl"

data Script = MkScript
  { Script -> Text
script :: Text,
    Script -> [Value]
args :: [Value]
  }
  deriving (Int -> Script -> ShowS
[Script] -> ShowS
Script -> String
(Int -> Script -> ShowS)
-> (Script -> String) -> ([Script] -> ShowS) -> Show Script
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Script -> ShowS
showsPrec :: Int -> Script -> ShowS
$cshow :: Script -> String
show :: Script -> String
$cshowList :: [Script] -> ShowS
showList :: [Script] -> ShowS
Show, Script -> Script -> Bool
(Script -> Script -> Bool)
-> (Script -> Script -> Bool) -> Eq Script
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Script -> Script -> Bool
== :: Script -> Script -> Bool
$c/= :: Script -> Script -> Bool
/= :: Script -> Script -> Bool
Eq, (forall x. Script -> Rep Script x)
-> (forall x. Rep Script x -> Script) -> Generic Script
forall x. Rep Script x -> Script
forall x. Script -> Rep Script x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Script -> Rep Script x
from :: forall x. Script -> Rep Script x
$cto :: forall x. Rep Script x -> Script
to :: forall x. Rep Script x -> Script
Generic)

instance ToJSON Script

instance ToJSON SessionResponse where
  toJSON :: SessionResponse -> Value
  toJSON :: SessionResponse -> Value
toJSON MkSessionResponse {Session
sessionId :: SessionResponse -> Session
sessionId :: Session
sessionId, Maybe Text
webSocketUrl :: SessionResponse -> Maybe Text
webSocketUrl :: Maybe Text
webSocketUrl, Capabilities
capabilities :: SessionResponse -> Capabilities
capabilities :: Capabilities
capabilities, Maybe (Map Text Value)
extensions :: SessionResponse -> Maybe (Map Text Value)
extensions :: Maybe (Map Text Value)
extensions} =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"sessionId" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Session
sessionId.id,
        Key
"capabilities" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
mergedCaps,
        Key
webSocketKey Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
webSocketUrl
      ]
    where
      capsVal :: Value
capsVal = Capabilities -> Value
forall a. ToJSON a => a -> Value
toJSON Capabilities
capabilities
      mergedCaps :: Value
mergedCaps = Maybe (Map Text Value)
extensions Maybe (Map Text Value)
-> (Maybe (Map Text Value) -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Value
-> (Map Text Value -> Value) -> Maybe (Map Text Value) -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
capsVal Map Text Value -> Value
mergeExtensions
      mergeExtensions :: M.Map Text Value -> Value
      mergeExtensions :: Map Text Value -> Value
mergeExtensions Map Text Value
mv =
        case Value
capsVal of
          Object Object
capsObj -> Object -> Value
Object (Object -> Value)
-> (Map Text Value -> Object) -> Map Text Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
KM.union Object
capsObj (Object -> Object)
-> (Map Text Value -> Object) -> Map Text Value -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Value -> Object
forall v. Map Text v -> KeyMap v
KM.fromMapText (Map Text Value -> Value) -> Map Text Value -> Value
forall a b. (a -> b) -> a -> b
$ Map Text Value
mv
          -- this will never happen - capabilities is always an Object
          Value
_ -> String -> Value
forall a. HasCallStack => String -> a
error String
"SessionResponse - toJSON: capabilities must be an Object"

instance FromJSON SessionResponse where
  parseJSON :: Value -> Parser SessionResponse
  parseJSON :: Value -> Parser SessionResponse
parseJSON =
    String
-> (Object -> Parser SessionResponse)
-> Value
-> Parser SessionResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"SessionResponse.value"
      ( \Object
valueObj -> do
          sessionId <- Text -> Session
MkSession (Text -> Session) -> Parser Text -> Parser Session
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
valueObj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sessionId"
          --
          capabilitiesVal' :: Value <- valueObj .: "capabilities"
          allCapsObject <- parseObject "capabilities property returned from newSession should be an object" capabilitiesVal'
          webSocketUrl <- allCapsObject .:? webSocketKey
          -- webSocketUrl will come back as a url but is is a Bool flag in Capabilities
          -- so it must be converted or there will be a parse error
          let capabilitiesVal = Object -> Object
webSocketUrlToBool Object
allCapsObject
          capabilities :: Capabilities <- parseJSON $ Object capabilitiesVal
          standardCapsProps <- parseObject "JSON frotim Capabilities Object must be a JSON Object" $ toJSON capabilities
          let keys = [Key] -> Set Key
forall a. Ord a => [a] -> Set a
fromList ([Key] -> Set Key) -> (KeyMap v -> [Key]) -> KeyMap v -> Set Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [Key]
forall v. KeyMap v -> [Key]
KM.keys
              capsKeys = Object -> Set Key
forall {v}. KeyMap v -> Set Key
keys Object
standardCapsProps
              nonNullExtensionKey Key
k Value
v = Key
k Key -> Set Key -> Bool
forall a. Ord a => a -> Set a -> Bool
`notMember` Set Key
capsKeys Bool -> Bool -> Bool
&& Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
webSocketKey Bool -> Bool -> Bool
&& Value -> Bool
nonEmpty Value
v
              extensionsMap = Object -> Map Text Value
forall v. KeyMap v -> Map Text v
KM.toMapText (Object -> Map Text Value) -> Object -> Map Text Value
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KM.filterWithKey Key -> Value -> Bool
nonNullExtensionKey (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ Object
allCapsObject
              extensions =
                if Map Text Value -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Value
extensionsMap
                  then Maybe (Map Text Value)
forall a. Maybe a
Nothing
                  else Map Text Value -> Maybe (Map Text Value)
forall a. a -> Maybe a
Just Map Text Value
extensionsMap

          pure $ MkSessionResponse {sessionId, webSocketUrl, capabilities, extensions}
      )

webSocketUrlToBool :: KM.KeyMap Value -> KM.KeyMap Value
webSocketUrlToBool :: Object -> Object
webSocketUrlToBool Object
o =
  case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
webSocketKey Object
o of
    Just (String Text
url) ->
      if (Text -> Bool
T.null Text
url)
        then
          Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KM.delete Key
webSocketKey Object
o
        else
          Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
webSocketKey (Bool -> Value
Bool Bool
True) Object
o -- change to Bool
    Maybe Value
_ -> Object
o -- no change if property not present

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#dfn-status)
data Status = MkStatus
  { Status -> Bool
ready :: Bool,
    Status -> Text
message :: Text
  }
  deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, (forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic)

instance ToJSON Status

instance FromJSON Status

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#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, (forall x. SameSite -> Rep SameSite x)
-> (forall x. Rep SameSite x -> SameSite) -> Generic SameSite
forall x. Rep SameSite x -> SameSite
forall x. SameSite -> Rep SameSite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SameSite -> Rep SameSite x
from :: forall x. SameSite -> Rep SameSite x
$cto :: forall x. Rep SameSite x -> SameSite
to :: forall x. Rep SameSite x -> SameSite
Generic)

instance FromJSON SameSite

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-20251028/#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)

instance ToJSON FrameReference where
  toJSON :: FrameReference -> Value
  toJSON :: FrameReference -> Value
toJSON 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]

-- 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"

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#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 FromJSON Cookie where
  parseJSON :: Value -> Parser Cookie
  parseJSON :: Value -> Parser Cookie
parseJSON = String -> (Object -> Parser Cookie) -> Value -> Parser Cookie
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cookie" ((Object -> Parser Cookie) -> Value -> Parser Cookie)
-> (Object -> Parser Cookie) -> Value -> Parser Cookie
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    name <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    value <- v .: "value"
    path <- v .:? "path"
    domain <- v .:? "domain"
    secure <- v .:? "secure"
    httpOnly <- v .:? "httpOnly"
    sameSite <- v .:? "sameSite"
    expiry <- v .:? "expiry"
    pure MkCookie {..}

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
          ]

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#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)

instance ToJSON Selector where
  toJSON :: Selector -> Value
  toJSON :: Selector -> Value
toJSON = \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]

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#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, (forall x. WindowRect -> Rep WindowRect x)
-> (forall x. Rep WindowRect x -> WindowRect) -> Generic WindowRect
forall x. Rep WindowRect x -> WindowRect
forall x. WindowRect -> Rep WindowRect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowRect -> Rep WindowRect x
from :: forall x. WindowRect -> Rep WindowRect x
$cto :: forall x. Rep WindowRect x -> WindowRect
to :: forall x. Rep WindowRect x -> WindowRect
Generic)

instance ToJSON WindowRect

instance FromJSON WindowRect where
  parseJSON :: Value -> Parser WindowRect
  parseJSON :: Value -> Parser WindowRect
parseJSON = String
-> (Object -> Parser WindowRect) -> Value -> Parser WindowRect
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WindowRect" ((Object -> Parser WindowRect) -> Value -> Parser WindowRect)
-> (Object -> Parser WindowRect) -> Value -> Parser WindowRect
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    x <- Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
    y <- v .: "y"
    width <- v .: "width"
    height <- v .: "height"
    pure
      Rect
        { x = floor x,
          y = floor y,
          width = floor width,
          height = floor height
        }

-- | [spec](https://www.w3.org/TR/2025/WD-webdriver2-20251028/#actions)
newtype Actions = MkActions {Actions -> [Action]
actions :: [Action]}
  deriving (Int -> Actions -> ShowS
[Actions] -> ShowS
Actions -> String
(Int -> Actions -> ShowS)
-> (Actions -> String) -> ([Actions] -> ShowS) -> Show Actions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Actions -> ShowS
showsPrec :: Int -> Actions -> ShowS
$cshow :: Actions -> String
show :: Actions -> String
$cshowList :: [Actions] -> ShowS
showList :: [Actions] -> ShowS
Show, Actions -> Actions -> Bool
(Actions -> Actions -> Bool)
-> (Actions -> Actions -> Bool) -> Eq Actions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Actions -> Actions -> Bool
== :: Actions -> Actions -> Bool
$c/= :: Actions -> Actions -> Bool
/= :: Actions -> Actions -> Bool
Eq, (forall x. Actions -> Rep Actions x)
-> (forall x. Rep Actions x -> Actions) -> Generic Actions
forall x. Rep Actions x -> Actions
forall x. Actions -> Rep Actions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Actions -> Rep Actions x
from :: forall x. Actions -> Rep Actions x
$cto :: forall x. Rep Actions x -> Actions
to :: forall x. Rep Actions x -> Actions
Generic)

instance ToJSON Actions where
  toJSON :: Actions -> Value
  toJSON :: Actions -> Value
toJSON 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-20251028/#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-20251028/#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-20251028/#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 (MkElement 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-20251028/#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-20251028/#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-20251028/#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
        ]