{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}


{- |
= DOMSnapshot

This domain facilitates obtaining document snapshots with DOM, layout, and style information.
-}


module CDP.Domains.DOMSnapshot (module CDP.Domains.DOMSnapshot) where

import           Control.Applicative  ((<$>))
import           Control.Monad
import           Control.Monad.Loops
import           Control.Monad.Trans  (liftIO)
import qualified Data.Map             as M
import           Data.Maybe          
import Data.Functor.Identity
import Data.String
import qualified Data.Text as T
import qualified Data.List as List
import qualified Data.Text.IO         as TI
import qualified Data.Vector          as V
import Data.Aeson.Types (Parser(..))
import           Data.Aeson           (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Aeson           as A
import qualified Network.HTTP.Simple as Http
import qualified Network.URI          as Uri
import qualified Network.WebSockets as WS
import Control.Concurrent
import qualified Data.ByteString.Lazy as BS
import qualified Data.Map as Map
import Data.Proxy
import System.Random
import GHC.Generics
import Data.Char
import Data.Default

import CDP.Internal.Utils


import CDP.Domains.DOMDebugger as DOMDebugger
import CDP.Domains.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity


-- | Type 'DOMSnapshot.DOMNode'.
--   A Node in the DOM tree.
data DOMSnapshotDOMNode = DOMSnapshotDOMNode
  {
    -- | `Node`'s nodeType.
    DOMSnapshotDOMNode -> Int
dOMSnapshotDOMNodeNodeType :: Int,
    -- | `Node`'s nodeName.
    DOMSnapshotDOMNode -> Text
dOMSnapshotDOMNodeNodeName :: T.Text,
    -- | `Node`'s nodeValue.
    DOMSnapshotDOMNode -> Text
dOMSnapshotDOMNodeNodeValue :: T.Text,
    -- | Only set for textarea elements, contains the text value.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeTextValue :: Maybe T.Text,
    -- | Only set for input elements, contains the input's associated text value.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeInputValue :: Maybe T.Text,
    -- | Only set for radio and checkbox input elements, indicates if the element has been checked
    DOMSnapshotDOMNode -> Maybe Bool
dOMSnapshotDOMNodeInputChecked :: Maybe Bool,
    -- | Only set for option elements, indicates if the element has been selected
    DOMSnapshotDOMNode -> Maybe Bool
dOMSnapshotDOMNodeOptionSelected :: Maybe Bool,
    -- | `Node`'s id, corresponds to DOM.Node.backendNodeId.
    DOMSnapshotDOMNode -> Int
dOMSnapshotDOMNodeBackendNodeId :: DOMPageNetworkEmulationSecurity.DOMBackendNodeId,
    -- | The indexes of the node's child nodes in the `domNodes` array returned by `getSnapshot`, if
    --   any.
    DOMSnapshotDOMNode -> Maybe [Int]
dOMSnapshotDOMNodeChildNodeIndexes :: Maybe [Int],
    -- | Attributes of an `Element` node.
    DOMSnapshotDOMNode -> Maybe [DOMSnapshotNameValue]
dOMSnapshotDOMNodeAttributes :: Maybe [DOMSnapshotNameValue],
    -- | Indexes of pseudo elements associated with this node in the `domNodes` array returned by
    --   `getSnapshot`, if any.
    DOMSnapshotDOMNode -> Maybe [Int]
dOMSnapshotDOMNodePseudoElementIndexes :: Maybe [Int],
    -- | The index of the node's related layout tree node in the `layoutTreeNodes` array returned by
    --   `getSnapshot`, if any.
    DOMSnapshotDOMNode -> Maybe Int
dOMSnapshotDOMNodeLayoutNodeIndex :: Maybe Int,
    -- | Document URL that `Document` or `FrameOwner` node points to.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeDocumentURL :: Maybe T.Text,
    -- | Base URL that `Document` or `FrameOwner` node uses for URL completion.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeBaseURL :: Maybe T.Text,
    -- | Only set for documents, contains the document's content language.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeContentLanguage :: Maybe T.Text,
    -- | Only set for documents, contains the document's character set encoding.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeDocumentEncoding :: Maybe T.Text,
    -- | `DocumentType` node's publicId.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodePublicId :: Maybe T.Text,
    -- | `DocumentType` node's systemId.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeSystemId :: Maybe T.Text,
    -- | Frame ID for frame owner elements and also for the document node.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeFrameId :: Maybe DOMPageNetworkEmulationSecurity.PageFrameId,
    -- | The index of a frame owner element's content document in the `domNodes` array returned by
    --   `getSnapshot`, if any.
    DOMSnapshotDOMNode -> Maybe Int
dOMSnapshotDOMNodeContentDocumentIndex :: Maybe Int,
    -- | Type of a pseudo element node.
    DOMSnapshotDOMNode -> Maybe DOMPseudoType
dOMSnapshotDOMNodePseudoType :: Maybe DOMPageNetworkEmulationSecurity.DOMPseudoType,
    -- | Shadow root type.
    DOMSnapshotDOMNode -> Maybe DOMShadowRootType
dOMSnapshotDOMNodeShadowRootType :: Maybe DOMPageNetworkEmulationSecurity.DOMShadowRootType,
    -- | Whether this DOM node responds to mouse clicks. This includes nodes that have had click
    --   event listeners attached via JavaScript as well as anchor tags that naturally navigate when
    --   clicked.
    DOMSnapshotDOMNode -> Maybe Bool
dOMSnapshotDOMNodeIsClickable :: Maybe Bool,
    -- | Details of the node's event listeners, if any.
    DOMSnapshotDOMNode -> Maybe [DOMDebuggerEventListener]
dOMSnapshotDOMNodeEventListeners :: Maybe [DOMDebugger.DOMDebuggerEventListener],
    -- | The selected url for nodes with a srcset attribute.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeCurrentSourceURL :: Maybe T.Text,
    -- | The url of the script (if any) that generates this node.
    DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeOriginURL :: Maybe T.Text,
    -- | Scroll offsets, set when this node is a Document.
    DOMSnapshotDOMNode -> Maybe Double
dOMSnapshotDOMNodeScrollOffsetX :: Maybe Double,
    DOMSnapshotDOMNode -> Maybe Double
dOMSnapshotDOMNodeScrollOffsetY :: Maybe Double
  }
  deriving (DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool
(DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool)
-> (DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool)
-> Eq DOMSnapshotDOMNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool
$c/= :: DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool
== :: DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool
$c== :: DOMSnapshotDOMNode -> DOMSnapshotDOMNode -> Bool
Eq, Int -> DOMSnapshotDOMNode -> ShowS
[DOMSnapshotDOMNode] -> ShowS
DOMSnapshotDOMNode -> String
(Int -> DOMSnapshotDOMNode -> ShowS)
-> (DOMSnapshotDOMNode -> String)
-> ([DOMSnapshotDOMNode] -> ShowS)
-> Show DOMSnapshotDOMNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotDOMNode] -> ShowS
$cshowList :: [DOMSnapshotDOMNode] -> ShowS
show :: DOMSnapshotDOMNode -> String
$cshow :: DOMSnapshotDOMNode -> String
showsPrec :: Int -> DOMSnapshotDOMNode -> ShowS
$cshowsPrec :: Int -> DOMSnapshotDOMNode -> ShowS
Show)
instance FromJSON DOMSnapshotDOMNode where
  parseJSON :: Value -> Parser DOMSnapshotDOMNode
parseJSON = String
-> (Object -> Parser DOMSnapshotDOMNode)
-> Value
-> Parser DOMSnapshotDOMNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotDOMNode" ((Object -> Parser DOMSnapshotDOMNode)
 -> Value -> Parser DOMSnapshotDOMNode)
-> (Object -> Parser DOMSnapshotDOMNode)
-> Value
-> Parser DOMSnapshotDOMNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Int
-> Maybe [Int]
-> Maybe [DOMSnapshotNameValue]
-> Maybe [Int]
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe DOMPseudoType
-> Maybe DOMShadowRootType
-> Maybe Bool
-> Maybe [DOMDebuggerEventListener]
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe Double
-> DOMSnapshotDOMNode
DOMSnapshotDOMNode
    (Int
 -> Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Int
 -> Maybe [Int]
 -> Maybe [DOMSnapshotNameValue]
 -> Maybe [Int]
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe DOMPseudoType
 -> Maybe DOMShadowRootType
 -> Maybe Bool
 -> Maybe [DOMDebuggerEventListener]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Double
 -> Maybe Double
 -> DOMSnapshotDOMNode)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"nodeType"
    Parser
  (Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"nodeName"
    Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"nodeValue"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"textValue"
    Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inputValue"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inputChecked"
    Parser
  (Maybe Bool
   -> Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Bool)
-> Parser
     (Int
      -> Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"optionSelected"
    Parser
  (Int
   -> Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser Int
-> Parser
     (Maybe [Int]
      -> Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"backendNodeId"
    Parser
  (Maybe [Int]
   -> Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe [Int])
-> Parser
     (Maybe [DOMSnapshotNameValue]
      -> Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"childNodeIndexes"
    Parser
  (Maybe [DOMSnapshotNameValue]
   -> Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe [DOMSnapshotNameValue])
-> Parser
     (Maybe [Int]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [DOMSnapshotNameValue])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"attributes"
    Parser
  (Maybe [Int]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe [Int])
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"pseudoElementIndexes"
    Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"layoutNodeIndex"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"documentURL"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"baseURL"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"contentLanguage"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"documentEncoding"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"publicId"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"systemId"
    Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"frameId"
    Parser
  (Maybe Int
   -> Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Int)
-> Parser
     (Maybe DOMPseudoType
      -> Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"contentDocumentIndex"
    Parser
  (Maybe DOMPseudoType
   -> Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe DOMPseudoType)
-> Parser
     (Maybe DOMShadowRootType
      -> Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMPseudoType)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"pseudoType"
    Parser
  (Maybe DOMShadowRootType
   -> Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe DOMShadowRootType)
-> Parser
     (Maybe Bool
      -> Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMShadowRootType)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"shadowRootType"
    Parser
  (Maybe Bool
   -> Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [DOMDebuggerEventListener]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"isClickable"
    Parser
  (Maybe [DOMDebuggerEventListener]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe [DOMDebuggerEventListener])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [DOMDebuggerEventListener])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"eventListeners"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Double -> Maybe Double -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"currentSourceURL"
    Parser
  (Maybe Text -> Maybe Double -> Maybe Double -> DOMSnapshotDOMNode)
-> Parser (Maybe Text)
-> Parser (Maybe Double -> Maybe Double -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"originURL"
    Parser (Maybe Double -> Maybe Double -> DOMSnapshotDOMNode)
-> Parser (Maybe Double)
-> Parser (Maybe Double -> DOMSnapshotDOMNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scrollOffsetX"
    Parser (Maybe Double -> DOMSnapshotDOMNode)
-> Parser (Maybe Double) -> Parser DOMSnapshotDOMNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scrollOffsetY"
instance ToJSON DOMSnapshotDOMNode where
  toJSON :: DOMSnapshotDOMNode -> Value
toJSON DOMSnapshotDOMNode
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"nodeType" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDOMNode -> Int
dOMSnapshotDOMNodeNodeType DOMSnapshotDOMNode
p),
    (Text
"nodeName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (DOMSnapshotDOMNode -> Text
dOMSnapshotDOMNodeNodeName DOMSnapshotDOMNode
p),
    (Text
"nodeValue" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (DOMSnapshotDOMNode -> Text
dOMSnapshotDOMNodeNodeValue DOMSnapshotDOMNode
p),
    (Text
"textValue" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeTextValue DOMSnapshotDOMNode
p),
    (Text
"inputValue" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeInputValue DOMSnapshotDOMNode
p),
    (Text
"inputChecked" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Bool
dOMSnapshotDOMNodeInputChecked DOMSnapshotDOMNode
p),
    (Text
"optionSelected" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Bool
dOMSnapshotDOMNodeOptionSelected DOMSnapshotDOMNode
p),
    (Text
"backendNodeId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDOMNode -> Int
dOMSnapshotDOMNodeBackendNodeId DOMSnapshotDOMNode
p),
    (Text
"childNodeIndexes" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe [Int]
dOMSnapshotDOMNodeChildNodeIndexes DOMSnapshotDOMNode
p),
    (Text
"attributes" Text -> [DOMSnapshotNameValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotNameValue] -> Pair)
-> Maybe [DOMSnapshotNameValue] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe [DOMSnapshotNameValue]
dOMSnapshotDOMNodeAttributes DOMSnapshotDOMNode
p),
    (Text
"pseudoElementIndexes" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe [Int]
dOMSnapshotDOMNodePseudoElementIndexes DOMSnapshotDOMNode
p),
    (Text
"layoutNodeIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Int
dOMSnapshotDOMNodeLayoutNodeIndex DOMSnapshotDOMNode
p),
    (Text
"documentURL" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeDocumentURL DOMSnapshotDOMNode
p),
    (Text
"baseURL" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeBaseURL DOMSnapshotDOMNode
p),
    (Text
"contentLanguage" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeContentLanguage DOMSnapshotDOMNode
p),
    (Text
"documentEncoding" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeDocumentEncoding DOMSnapshotDOMNode
p),
    (Text
"publicId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodePublicId DOMSnapshotDOMNode
p),
    (Text
"systemId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeSystemId DOMSnapshotDOMNode
p),
    (Text
"frameId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeFrameId DOMSnapshotDOMNode
p),
    (Text
"contentDocumentIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Int
dOMSnapshotDOMNodeContentDocumentIndex DOMSnapshotDOMNode
p),
    (Text
"pseudoType" Text -> DOMPseudoType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMPseudoType -> Pair) -> Maybe DOMPseudoType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe DOMPseudoType
dOMSnapshotDOMNodePseudoType DOMSnapshotDOMNode
p),
    (Text
"shadowRootType" Text -> DOMShadowRootType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMShadowRootType -> Pair)
-> Maybe DOMShadowRootType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe DOMShadowRootType
dOMSnapshotDOMNodeShadowRootType DOMSnapshotDOMNode
p),
    (Text
"isClickable" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Bool
dOMSnapshotDOMNodeIsClickable DOMSnapshotDOMNode
p),
    (Text
"eventListeners" Text -> [DOMDebuggerEventListener] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMDebuggerEventListener] -> Pair)
-> Maybe [DOMDebuggerEventListener] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe [DOMDebuggerEventListener]
dOMSnapshotDOMNodeEventListeners DOMSnapshotDOMNode
p),
    (Text
"currentSourceURL" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeCurrentSourceURL DOMSnapshotDOMNode
p),
    (Text
"originURL" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Text
dOMSnapshotDOMNodeOriginURL DOMSnapshotDOMNode
p),
    (Text
"scrollOffsetX" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Double
dOMSnapshotDOMNodeScrollOffsetX DOMSnapshotDOMNode
p),
    (Text
"scrollOffsetY" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDOMNode -> Maybe Double
dOMSnapshotDOMNodeScrollOffsetY DOMSnapshotDOMNode
p)
    ]

-- | Type 'DOMSnapshot.InlineTextBox'.
--   Details of post layout rendered text positions. The exact layout should not be regarded as
--   stable and may change between versions.
data DOMSnapshotInlineTextBox = DOMSnapshotInlineTextBox
  {
    -- | The bounding box in document coordinates. Note that scroll offset of the document is ignored.
    DOMSnapshotInlineTextBox -> DOMRect
dOMSnapshotInlineTextBoxBoundingBox :: DOMPageNetworkEmulationSecurity.DOMRect,
    -- | The starting index in characters, for this post layout textbox substring. Characters that
    --   would be represented as a surrogate pair in UTF-16 have length 2.
    DOMSnapshotInlineTextBox -> Int
dOMSnapshotInlineTextBoxStartCharacterIndex :: Int,
    -- | The number of characters in this post layout textbox substring. Characters that would be
    --   represented as a surrogate pair in UTF-16 have length 2.
    DOMSnapshotInlineTextBox -> Int
dOMSnapshotInlineTextBoxNumCharacters :: Int
  }
  deriving (DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool
(DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool)
-> (DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool)
-> Eq DOMSnapshotInlineTextBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool
$c/= :: DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool
== :: DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool
$c== :: DOMSnapshotInlineTextBox -> DOMSnapshotInlineTextBox -> Bool
Eq, Int -> DOMSnapshotInlineTextBox -> ShowS
[DOMSnapshotInlineTextBox] -> ShowS
DOMSnapshotInlineTextBox -> String
(Int -> DOMSnapshotInlineTextBox -> ShowS)
-> (DOMSnapshotInlineTextBox -> String)
-> ([DOMSnapshotInlineTextBox] -> ShowS)
-> Show DOMSnapshotInlineTextBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotInlineTextBox] -> ShowS
$cshowList :: [DOMSnapshotInlineTextBox] -> ShowS
show :: DOMSnapshotInlineTextBox -> String
$cshow :: DOMSnapshotInlineTextBox -> String
showsPrec :: Int -> DOMSnapshotInlineTextBox -> ShowS
$cshowsPrec :: Int -> DOMSnapshotInlineTextBox -> ShowS
Show)
instance FromJSON DOMSnapshotInlineTextBox where
  parseJSON :: Value -> Parser DOMSnapshotInlineTextBox
parseJSON = String
-> (Object -> Parser DOMSnapshotInlineTextBox)
-> Value
-> Parser DOMSnapshotInlineTextBox
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotInlineTextBox" ((Object -> Parser DOMSnapshotInlineTextBox)
 -> Value -> Parser DOMSnapshotInlineTextBox)
-> (Object -> Parser DOMSnapshotInlineTextBox)
-> Value
-> Parser DOMSnapshotInlineTextBox
forall a b. (a -> b) -> a -> b
$ \Object
o -> DOMRect -> Int -> Int -> DOMSnapshotInlineTextBox
DOMSnapshotInlineTextBox
    (DOMRect -> Int -> Int -> DOMSnapshotInlineTextBox)
-> Parser DOMRect
-> Parser (Int -> Int -> DOMSnapshotInlineTextBox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser DOMRect
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"boundingBox"
    Parser (Int -> Int -> DOMSnapshotInlineTextBox)
-> Parser Int -> Parser (Int -> DOMSnapshotInlineTextBox)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"startCharacterIndex"
    Parser (Int -> DOMSnapshotInlineTextBox)
-> Parser Int -> Parser DOMSnapshotInlineTextBox
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"numCharacters"
instance ToJSON DOMSnapshotInlineTextBox where
  toJSON :: DOMSnapshotInlineTextBox -> Value
toJSON DOMSnapshotInlineTextBox
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"boundingBox" Text -> DOMRect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMRect -> Pair) -> Maybe DOMRect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMRect -> Maybe DOMRect
forall a. a -> Maybe a
Just (DOMSnapshotInlineTextBox -> DOMRect
dOMSnapshotInlineTextBoxBoundingBox DOMSnapshotInlineTextBox
p),
    (Text
"startCharacterIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotInlineTextBox -> Int
dOMSnapshotInlineTextBoxStartCharacterIndex DOMSnapshotInlineTextBox
p),
    (Text
"numCharacters" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotInlineTextBox -> Int
dOMSnapshotInlineTextBoxNumCharacters DOMSnapshotInlineTextBox
p)
    ]

-- | Type 'DOMSnapshot.LayoutTreeNode'.
--   Details of an element in the DOM tree with a LayoutObject.
data DOMSnapshotLayoutTreeNode = DOMSnapshotLayoutTreeNode
  {
    -- | The index of the related DOM node in the `domNodes` array returned by `getSnapshot`.
    DOMSnapshotLayoutTreeNode -> Int
dOMSnapshotLayoutTreeNodeDomNodeIndex :: Int,
    -- | The bounding box in document coordinates. Note that scroll offset of the document is ignored.
    DOMSnapshotLayoutTreeNode -> DOMRect
dOMSnapshotLayoutTreeNodeBoundingBox :: DOMPageNetworkEmulationSecurity.DOMRect,
    -- | Contents of the LayoutText, if any.
    DOMSnapshotLayoutTreeNode -> Maybe Text
dOMSnapshotLayoutTreeNodeLayoutText :: Maybe T.Text,
    -- | The post-layout inline text nodes, if any.
    DOMSnapshotLayoutTreeNode -> Maybe [DOMSnapshotInlineTextBox]
dOMSnapshotLayoutTreeNodeInlineTextNodes :: Maybe [DOMSnapshotInlineTextBox],
    -- | Index into the `computedStyles` array returned by `getSnapshot`.
    DOMSnapshotLayoutTreeNode -> Maybe Int
dOMSnapshotLayoutTreeNodeStyleIndex :: Maybe Int,
    -- | Global paint order index, which is determined by the stacking order of the nodes. Nodes
    --   that are painted together will have the same index. Only provided if includePaintOrder in
    --   getSnapshot was true.
    DOMSnapshotLayoutTreeNode -> Maybe Int
dOMSnapshotLayoutTreeNodePaintOrder :: Maybe Int,
    -- | Set to true to indicate the element begins a new stacking context.
    DOMSnapshotLayoutTreeNode -> Maybe Bool
dOMSnapshotLayoutTreeNodeIsStackingContext :: Maybe Bool
  }
  deriving (DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool
(DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool)
-> (DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool)
-> Eq DOMSnapshotLayoutTreeNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool
$c/= :: DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool
== :: DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool
$c== :: DOMSnapshotLayoutTreeNode -> DOMSnapshotLayoutTreeNode -> Bool
Eq, Int -> DOMSnapshotLayoutTreeNode -> ShowS
[DOMSnapshotLayoutTreeNode] -> ShowS
DOMSnapshotLayoutTreeNode -> String
(Int -> DOMSnapshotLayoutTreeNode -> ShowS)
-> (DOMSnapshotLayoutTreeNode -> String)
-> ([DOMSnapshotLayoutTreeNode] -> ShowS)
-> Show DOMSnapshotLayoutTreeNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotLayoutTreeNode] -> ShowS
$cshowList :: [DOMSnapshotLayoutTreeNode] -> ShowS
show :: DOMSnapshotLayoutTreeNode -> String
$cshow :: DOMSnapshotLayoutTreeNode -> String
showsPrec :: Int -> DOMSnapshotLayoutTreeNode -> ShowS
$cshowsPrec :: Int -> DOMSnapshotLayoutTreeNode -> ShowS
Show)
instance FromJSON DOMSnapshotLayoutTreeNode where
  parseJSON :: Value -> Parser DOMSnapshotLayoutTreeNode
parseJSON = String
-> (Object -> Parser DOMSnapshotLayoutTreeNode)
-> Value
-> Parser DOMSnapshotLayoutTreeNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotLayoutTreeNode" ((Object -> Parser DOMSnapshotLayoutTreeNode)
 -> Value -> Parser DOMSnapshotLayoutTreeNode)
-> (Object -> Parser DOMSnapshotLayoutTreeNode)
-> Value
-> Parser DOMSnapshotLayoutTreeNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> DOMRect
-> Maybe Text
-> Maybe [DOMSnapshotInlineTextBox]
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> DOMSnapshotLayoutTreeNode
DOMSnapshotLayoutTreeNode
    (Int
 -> DOMRect
 -> Maybe Text
 -> Maybe [DOMSnapshotInlineTextBox]
 -> Maybe Int
 -> Maybe Int
 -> Maybe Bool
 -> DOMSnapshotLayoutTreeNode)
-> Parser Int
-> Parser
     (DOMRect
      -> Maybe Text
      -> Maybe [DOMSnapshotInlineTextBox]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> DOMSnapshotLayoutTreeNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"domNodeIndex"
    Parser
  (DOMRect
   -> Maybe Text
   -> Maybe [DOMSnapshotInlineTextBox]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> DOMSnapshotLayoutTreeNode)
-> Parser DOMRect
-> Parser
     (Maybe Text
      -> Maybe [DOMSnapshotInlineTextBox]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> DOMSnapshotLayoutTreeNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMRect
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"boundingBox"
    Parser
  (Maybe Text
   -> Maybe [DOMSnapshotInlineTextBox]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> DOMSnapshotLayoutTreeNode)
-> Parser (Maybe Text)
-> Parser
     (Maybe [DOMSnapshotInlineTextBox]
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> DOMSnapshotLayoutTreeNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"layoutText"
    Parser
  (Maybe [DOMSnapshotInlineTextBox]
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> DOMSnapshotLayoutTreeNode)
-> Parser (Maybe [DOMSnapshotInlineTextBox])
-> Parser
     (Maybe Int -> Maybe Int -> Maybe Bool -> DOMSnapshotLayoutTreeNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [DOMSnapshotInlineTextBox])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inlineTextNodes"
    Parser
  (Maybe Int -> Maybe Int -> Maybe Bool -> DOMSnapshotLayoutTreeNode)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Bool -> DOMSnapshotLayoutTreeNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"styleIndex"
    Parser (Maybe Int -> Maybe Bool -> DOMSnapshotLayoutTreeNode)
-> Parser (Maybe Int)
-> Parser (Maybe Bool -> DOMSnapshotLayoutTreeNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"paintOrder"
    Parser (Maybe Bool -> DOMSnapshotLayoutTreeNode)
-> Parser (Maybe Bool) -> Parser DOMSnapshotLayoutTreeNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"isStackingContext"
instance ToJSON DOMSnapshotLayoutTreeNode where
  toJSON :: DOMSnapshotLayoutTreeNode -> Value
toJSON DOMSnapshotLayoutTreeNode
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"domNodeIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeNode -> Int
dOMSnapshotLayoutTreeNodeDomNodeIndex DOMSnapshotLayoutTreeNode
p),
    (Text
"boundingBox" Text -> DOMRect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMRect -> Pair) -> Maybe DOMRect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMRect -> Maybe DOMRect
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeNode -> DOMRect
dOMSnapshotLayoutTreeNodeBoundingBox DOMSnapshotLayoutTreeNode
p),
    (Text
"layoutText" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeNode -> Maybe Text
dOMSnapshotLayoutTreeNodeLayoutText DOMSnapshotLayoutTreeNode
p),
    (Text
"inlineTextNodes" Text -> [DOMSnapshotInlineTextBox] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotInlineTextBox] -> Pair)
-> Maybe [DOMSnapshotInlineTextBox] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeNode -> Maybe [DOMSnapshotInlineTextBox]
dOMSnapshotLayoutTreeNodeInlineTextNodes DOMSnapshotLayoutTreeNode
p),
    (Text
"styleIndex" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeNode -> Maybe Int
dOMSnapshotLayoutTreeNodeStyleIndex DOMSnapshotLayoutTreeNode
p),
    (Text
"paintOrder" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeNode -> Maybe Int
dOMSnapshotLayoutTreeNodePaintOrder DOMSnapshotLayoutTreeNode
p),
    (Text
"isStackingContext" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeNode -> Maybe Bool
dOMSnapshotLayoutTreeNodeIsStackingContext DOMSnapshotLayoutTreeNode
p)
    ]

-- | Type 'DOMSnapshot.ComputedStyle'.
--   A subset of the full ComputedStyle as defined by the request whitelist.
data DOMSnapshotComputedStyle = DOMSnapshotComputedStyle
  {
    -- | Name/value pairs of computed style properties.
    DOMSnapshotComputedStyle -> [DOMSnapshotNameValue]
dOMSnapshotComputedStyleProperties :: [DOMSnapshotNameValue]
  }
  deriving (DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool
(DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool)
-> (DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool)
-> Eq DOMSnapshotComputedStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool
$c/= :: DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool
== :: DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool
$c== :: DOMSnapshotComputedStyle -> DOMSnapshotComputedStyle -> Bool
Eq, Int -> DOMSnapshotComputedStyle -> ShowS
[DOMSnapshotComputedStyle] -> ShowS
DOMSnapshotComputedStyle -> String
(Int -> DOMSnapshotComputedStyle -> ShowS)
-> (DOMSnapshotComputedStyle -> String)
-> ([DOMSnapshotComputedStyle] -> ShowS)
-> Show DOMSnapshotComputedStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotComputedStyle] -> ShowS
$cshowList :: [DOMSnapshotComputedStyle] -> ShowS
show :: DOMSnapshotComputedStyle -> String
$cshow :: DOMSnapshotComputedStyle -> String
showsPrec :: Int -> DOMSnapshotComputedStyle -> ShowS
$cshowsPrec :: Int -> DOMSnapshotComputedStyle -> ShowS
Show)
instance FromJSON DOMSnapshotComputedStyle where
  parseJSON :: Value -> Parser DOMSnapshotComputedStyle
parseJSON = String
-> (Object -> Parser DOMSnapshotComputedStyle)
-> Value
-> Parser DOMSnapshotComputedStyle
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotComputedStyle" ((Object -> Parser DOMSnapshotComputedStyle)
 -> Value -> Parser DOMSnapshotComputedStyle)
-> (Object -> Parser DOMSnapshotComputedStyle)
-> Value
-> Parser DOMSnapshotComputedStyle
forall a b. (a -> b) -> a -> b
$ \Object
o -> [DOMSnapshotNameValue] -> DOMSnapshotComputedStyle
DOMSnapshotComputedStyle
    ([DOMSnapshotNameValue] -> DOMSnapshotComputedStyle)
-> Parser [DOMSnapshotNameValue] -> Parser DOMSnapshotComputedStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [DOMSnapshotNameValue]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"properties"
instance ToJSON DOMSnapshotComputedStyle where
  toJSON :: DOMSnapshotComputedStyle -> Value
toJSON DOMSnapshotComputedStyle
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"properties" Text -> [DOMSnapshotNameValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotNameValue] -> Pair)
-> Maybe [DOMSnapshotNameValue] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DOMSnapshotNameValue] -> Maybe [DOMSnapshotNameValue]
forall a. a -> Maybe a
Just (DOMSnapshotComputedStyle -> [DOMSnapshotNameValue]
dOMSnapshotComputedStyleProperties DOMSnapshotComputedStyle
p)
    ]

-- | Type 'DOMSnapshot.NameValue'.
--   A name/value pair.
data DOMSnapshotNameValue = DOMSnapshotNameValue
  {
    -- | Attribute/property name.
    DOMSnapshotNameValue -> Text
dOMSnapshotNameValueName :: T.Text,
    -- | Attribute/property value.
    DOMSnapshotNameValue -> Text
dOMSnapshotNameValueValue :: T.Text
  }
  deriving (DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool
(DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool)
-> (DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool)
-> Eq DOMSnapshotNameValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool
$c/= :: DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool
== :: DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool
$c== :: DOMSnapshotNameValue -> DOMSnapshotNameValue -> Bool
Eq, Int -> DOMSnapshotNameValue -> ShowS
[DOMSnapshotNameValue] -> ShowS
DOMSnapshotNameValue -> String
(Int -> DOMSnapshotNameValue -> ShowS)
-> (DOMSnapshotNameValue -> String)
-> ([DOMSnapshotNameValue] -> ShowS)
-> Show DOMSnapshotNameValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotNameValue] -> ShowS
$cshowList :: [DOMSnapshotNameValue] -> ShowS
show :: DOMSnapshotNameValue -> String
$cshow :: DOMSnapshotNameValue -> String
showsPrec :: Int -> DOMSnapshotNameValue -> ShowS
$cshowsPrec :: Int -> DOMSnapshotNameValue -> ShowS
Show)
instance FromJSON DOMSnapshotNameValue where
  parseJSON :: Value -> Parser DOMSnapshotNameValue
parseJSON = String
-> (Object -> Parser DOMSnapshotNameValue)
-> Value
-> Parser DOMSnapshotNameValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotNameValue" ((Object -> Parser DOMSnapshotNameValue)
 -> Value -> Parser DOMSnapshotNameValue)
-> (Object -> Parser DOMSnapshotNameValue)
-> Value
-> Parser DOMSnapshotNameValue
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> DOMSnapshotNameValue
DOMSnapshotNameValue
    (Text -> Text -> DOMSnapshotNameValue)
-> Parser Text -> Parser (Text -> DOMSnapshotNameValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser (Text -> DOMSnapshotNameValue)
-> Parser Text -> Parser DOMSnapshotNameValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON DOMSnapshotNameValue where
  toJSON :: DOMSnapshotNameValue -> Value
toJSON DOMSnapshotNameValue
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (DOMSnapshotNameValue -> Text
dOMSnapshotNameValueName DOMSnapshotNameValue
p),
    (Text
"value" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (DOMSnapshotNameValue -> Text
dOMSnapshotNameValueValue DOMSnapshotNameValue
p)
    ]

-- | Type 'DOMSnapshot.StringIndex'.
--   Index of the string in the strings table.
type DOMSnapshotStringIndex = Int

-- | Type 'DOMSnapshot.ArrayOfStrings'.
--   Index of the string in the strings table.
type DOMSnapshotArrayOfStrings = [DOMSnapshotStringIndex]

-- | Type 'DOMSnapshot.RareStringData'.
--   Data that is only present on rare nodes.
data DOMSnapshotRareStringData = DOMSnapshotRareStringData
  {
    DOMSnapshotRareStringData -> [Int]
dOMSnapshotRareStringDataIndex :: [Int],
    DOMSnapshotRareStringData -> [Int]
dOMSnapshotRareStringDataValue :: [DOMSnapshotStringIndex]
  }
  deriving (DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool
(DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool)
-> (DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool)
-> Eq DOMSnapshotRareStringData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool
$c/= :: DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool
== :: DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool
$c== :: DOMSnapshotRareStringData -> DOMSnapshotRareStringData -> Bool
Eq, Int -> DOMSnapshotRareStringData -> ShowS
[DOMSnapshotRareStringData] -> ShowS
DOMSnapshotRareStringData -> String
(Int -> DOMSnapshotRareStringData -> ShowS)
-> (DOMSnapshotRareStringData -> String)
-> ([DOMSnapshotRareStringData] -> ShowS)
-> Show DOMSnapshotRareStringData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotRareStringData] -> ShowS
$cshowList :: [DOMSnapshotRareStringData] -> ShowS
show :: DOMSnapshotRareStringData -> String
$cshow :: DOMSnapshotRareStringData -> String
showsPrec :: Int -> DOMSnapshotRareStringData -> ShowS
$cshowsPrec :: Int -> DOMSnapshotRareStringData -> ShowS
Show)
instance FromJSON DOMSnapshotRareStringData where
  parseJSON :: Value -> Parser DOMSnapshotRareStringData
parseJSON = String
-> (Object -> Parser DOMSnapshotRareStringData)
-> Value
-> Parser DOMSnapshotRareStringData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotRareStringData" ((Object -> Parser DOMSnapshotRareStringData)
 -> Value -> Parser DOMSnapshotRareStringData)
-> (Object -> Parser DOMSnapshotRareStringData)
-> Value
-> Parser DOMSnapshotRareStringData
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int] -> [Int] -> DOMSnapshotRareStringData
DOMSnapshotRareStringData
    ([Int] -> [Int] -> DOMSnapshotRareStringData)
-> Parser [Int] -> Parser ([Int] -> DOMSnapshotRareStringData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"index"
    Parser ([Int] -> DOMSnapshotRareStringData)
-> Parser [Int] -> Parser DOMSnapshotRareStringData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON DOMSnapshotRareStringData where
  toJSON :: DOMSnapshotRareStringData -> Value
toJSON DOMSnapshotRareStringData
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"index" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotRareStringData -> [Int]
dOMSnapshotRareStringDataIndex DOMSnapshotRareStringData
p),
    (Text
"value" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotRareStringData -> [Int]
dOMSnapshotRareStringDataValue DOMSnapshotRareStringData
p)
    ]

-- | Type 'DOMSnapshot.RareBooleanData'.
data DOMSnapshotRareBooleanData = DOMSnapshotRareBooleanData
  {
    DOMSnapshotRareBooleanData -> [Int]
dOMSnapshotRareBooleanDataIndex :: [Int]
  }
  deriving (DOMSnapshotRareBooleanData -> DOMSnapshotRareBooleanData -> Bool
(DOMSnapshotRareBooleanData -> DOMSnapshotRareBooleanData -> Bool)
-> (DOMSnapshotRareBooleanData
    -> DOMSnapshotRareBooleanData -> Bool)
-> Eq DOMSnapshotRareBooleanData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotRareBooleanData -> DOMSnapshotRareBooleanData -> Bool
$c/= :: DOMSnapshotRareBooleanData -> DOMSnapshotRareBooleanData -> Bool
== :: DOMSnapshotRareBooleanData -> DOMSnapshotRareBooleanData -> Bool
$c== :: DOMSnapshotRareBooleanData -> DOMSnapshotRareBooleanData -> Bool
Eq, Int -> DOMSnapshotRareBooleanData -> ShowS
[DOMSnapshotRareBooleanData] -> ShowS
DOMSnapshotRareBooleanData -> String
(Int -> DOMSnapshotRareBooleanData -> ShowS)
-> (DOMSnapshotRareBooleanData -> String)
-> ([DOMSnapshotRareBooleanData] -> ShowS)
-> Show DOMSnapshotRareBooleanData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotRareBooleanData] -> ShowS
$cshowList :: [DOMSnapshotRareBooleanData] -> ShowS
show :: DOMSnapshotRareBooleanData -> String
$cshow :: DOMSnapshotRareBooleanData -> String
showsPrec :: Int -> DOMSnapshotRareBooleanData -> ShowS
$cshowsPrec :: Int -> DOMSnapshotRareBooleanData -> ShowS
Show)
instance FromJSON DOMSnapshotRareBooleanData where
  parseJSON :: Value -> Parser DOMSnapshotRareBooleanData
parseJSON = String
-> (Object -> Parser DOMSnapshotRareBooleanData)
-> Value
-> Parser DOMSnapshotRareBooleanData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotRareBooleanData" ((Object -> Parser DOMSnapshotRareBooleanData)
 -> Value -> Parser DOMSnapshotRareBooleanData)
-> (Object -> Parser DOMSnapshotRareBooleanData)
-> Value
-> Parser DOMSnapshotRareBooleanData
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int] -> DOMSnapshotRareBooleanData
DOMSnapshotRareBooleanData
    ([Int] -> DOMSnapshotRareBooleanData)
-> Parser [Int] -> Parser DOMSnapshotRareBooleanData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"index"
instance ToJSON DOMSnapshotRareBooleanData where
  toJSON :: DOMSnapshotRareBooleanData -> Value
toJSON DOMSnapshotRareBooleanData
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"index" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotRareBooleanData -> [Int]
dOMSnapshotRareBooleanDataIndex DOMSnapshotRareBooleanData
p)
    ]

-- | Type 'DOMSnapshot.RareIntegerData'.
data DOMSnapshotRareIntegerData = DOMSnapshotRareIntegerData
  {
    DOMSnapshotRareIntegerData -> [Int]
dOMSnapshotRareIntegerDataIndex :: [Int],
    DOMSnapshotRareIntegerData -> [Int]
dOMSnapshotRareIntegerDataValue :: [Int]
  }
  deriving (DOMSnapshotRareIntegerData -> DOMSnapshotRareIntegerData -> Bool
(DOMSnapshotRareIntegerData -> DOMSnapshotRareIntegerData -> Bool)
-> (DOMSnapshotRareIntegerData
    -> DOMSnapshotRareIntegerData -> Bool)
-> Eq DOMSnapshotRareIntegerData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotRareIntegerData -> DOMSnapshotRareIntegerData -> Bool
$c/= :: DOMSnapshotRareIntegerData -> DOMSnapshotRareIntegerData -> Bool
== :: DOMSnapshotRareIntegerData -> DOMSnapshotRareIntegerData -> Bool
$c== :: DOMSnapshotRareIntegerData -> DOMSnapshotRareIntegerData -> Bool
Eq, Int -> DOMSnapshotRareIntegerData -> ShowS
[DOMSnapshotRareIntegerData] -> ShowS
DOMSnapshotRareIntegerData -> String
(Int -> DOMSnapshotRareIntegerData -> ShowS)
-> (DOMSnapshotRareIntegerData -> String)
-> ([DOMSnapshotRareIntegerData] -> ShowS)
-> Show DOMSnapshotRareIntegerData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotRareIntegerData] -> ShowS
$cshowList :: [DOMSnapshotRareIntegerData] -> ShowS
show :: DOMSnapshotRareIntegerData -> String
$cshow :: DOMSnapshotRareIntegerData -> String
showsPrec :: Int -> DOMSnapshotRareIntegerData -> ShowS
$cshowsPrec :: Int -> DOMSnapshotRareIntegerData -> ShowS
Show)
instance FromJSON DOMSnapshotRareIntegerData where
  parseJSON :: Value -> Parser DOMSnapshotRareIntegerData
parseJSON = String
-> (Object -> Parser DOMSnapshotRareIntegerData)
-> Value
-> Parser DOMSnapshotRareIntegerData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotRareIntegerData" ((Object -> Parser DOMSnapshotRareIntegerData)
 -> Value -> Parser DOMSnapshotRareIntegerData)
-> (Object -> Parser DOMSnapshotRareIntegerData)
-> Value
-> Parser DOMSnapshotRareIntegerData
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int] -> [Int] -> DOMSnapshotRareIntegerData
DOMSnapshotRareIntegerData
    ([Int] -> [Int] -> DOMSnapshotRareIntegerData)
-> Parser [Int] -> Parser ([Int] -> DOMSnapshotRareIntegerData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"index"
    Parser ([Int] -> DOMSnapshotRareIntegerData)
-> Parser [Int] -> Parser DOMSnapshotRareIntegerData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON DOMSnapshotRareIntegerData where
  toJSON :: DOMSnapshotRareIntegerData -> Value
toJSON DOMSnapshotRareIntegerData
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"index" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotRareIntegerData -> [Int]
dOMSnapshotRareIntegerDataIndex DOMSnapshotRareIntegerData
p),
    (Text
"value" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotRareIntegerData -> [Int]
dOMSnapshotRareIntegerDataValue DOMSnapshotRareIntegerData
p)
    ]

-- | Type 'DOMSnapshot.Rectangle'.
type DOMSnapshotRectangle = [Double]

-- | Type 'DOMSnapshot.DocumentSnapshot'.
--   Document snapshot.
data DOMSnapshotDocumentSnapshot = DOMSnapshotDocumentSnapshot
  {
    -- | Document URL that `Document` or `FrameOwner` node points to.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotDocumentURL :: DOMSnapshotStringIndex,
    -- | Document title.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotTitle :: DOMSnapshotStringIndex,
    -- | Base URL that `Document` or `FrameOwner` node uses for URL completion.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotBaseURL :: DOMSnapshotStringIndex,
    -- | Contains the document's content language.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotContentLanguage :: DOMSnapshotStringIndex,
    -- | Contains the document's character set encoding.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotEncodingName :: DOMSnapshotStringIndex,
    -- | `DocumentType` node's publicId.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotPublicId :: DOMSnapshotStringIndex,
    -- | `DocumentType` node's systemId.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotSystemId :: DOMSnapshotStringIndex,
    -- | Frame ID for frame owner elements and also for the document node.
    DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotFrameId :: DOMSnapshotStringIndex,
    -- | A table with dom nodes.
    DOMSnapshotDocumentSnapshot -> DOMSnapshotNodeTreeSnapshot
dOMSnapshotDocumentSnapshotNodes :: DOMSnapshotNodeTreeSnapshot,
    -- | The nodes in the layout tree.
    DOMSnapshotDocumentSnapshot -> DOMSnapshotLayoutTreeSnapshot
dOMSnapshotDocumentSnapshotLayout :: DOMSnapshotLayoutTreeSnapshot,
    -- | The post-layout inline text nodes.
    DOMSnapshotDocumentSnapshot -> DOMSnapshotTextBoxSnapshot
dOMSnapshotDocumentSnapshotTextBoxes :: DOMSnapshotTextBoxSnapshot,
    -- | Horizontal scroll offset.
    DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotScrollOffsetX :: Maybe Double,
    -- | Vertical scroll offset.
    DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotScrollOffsetY :: Maybe Double,
    -- | Document content width.
    DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotContentWidth :: Maybe Double,
    -- | Document content height.
    DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotContentHeight :: Maybe Double
  }
  deriving (DOMSnapshotDocumentSnapshot -> DOMSnapshotDocumentSnapshot -> Bool
(DOMSnapshotDocumentSnapshot
 -> DOMSnapshotDocumentSnapshot -> Bool)
-> (DOMSnapshotDocumentSnapshot
    -> DOMSnapshotDocumentSnapshot -> Bool)
-> Eq DOMSnapshotDocumentSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotDocumentSnapshot -> DOMSnapshotDocumentSnapshot -> Bool
$c/= :: DOMSnapshotDocumentSnapshot -> DOMSnapshotDocumentSnapshot -> Bool
== :: DOMSnapshotDocumentSnapshot -> DOMSnapshotDocumentSnapshot -> Bool
$c== :: DOMSnapshotDocumentSnapshot -> DOMSnapshotDocumentSnapshot -> Bool
Eq, Int -> DOMSnapshotDocumentSnapshot -> ShowS
[DOMSnapshotDocumentSnapshot] -> ShowS
DOMSnapshotDocumentSnapshot -> String
(Int -> DOMSnapshotDocumentSnapshot -> ShowS)
-> (DOMSnapshotDocumentSnapshot -> String)
-> ([DOMSnapshotDocumentSnapshot] -> ShowS)
-> Show DOMSnapshotDocumentSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotDocumentSnapshot] -> ShowS
$cshowList :: [DOMSnapshotDocumentSnapshot] -> ShowS
show :: DOMSnapshotDocumentSnapshot -> String
$cshow :: DOMSnapshotDocumentSnapshot -> String
showsPrec :: Int -> DOMSnapshotDocumentSnapshot -> ShowS
$cshowsPrec :: Int -> DOMSnapshotDocumentSnapshot -> ShowS
Show)
instance FromJSON DOMSnapshotDocumentSnapshot where
  parseJSON :: Value -> Parser DOMSnapshotDocumentSnapshot
parseJSON = String
-> (Object -> Parser DOMSnapshotDocumentSnapshot)
-> Value
-> Parser DOMSnapshotDocumentSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotDocumentSnapshot" ((Object -> Parser DOMSnapshotDocumentSnapshot)
 -> Value -> Parser DOMSnapshotDocumentSnapshot)
-> (Object -> Parser DOMSnapshotDocumentSnapshot)
-> Value
-> Parser DOMSnapshotDocumentSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> DOMSnapshotNodeTreeSnapshot
-> DOMSnapshotLayoutTreeSnapshot
-> DOMSnapshotTextBoxSnapshot
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> DOMSnapshotDocumentSnapshot
DOMSnapshotDocumentSnapshot
    (Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> DOMSnapshotNodeTreeSnapshot
 -> DOMSnapshotLayoutTreeSnapshot
 -> DOMSnapshotTextBoxSnapshot
 -> Maybe Double
 -> Maybe Double
 -> Maybe Double
 -> Maybe Double
 -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"documentURL"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"title"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"baseURL"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"contentLanguage"
    Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"encodingName"
    Parser
  (Int
   -> Int
   -> Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"publicId"
    Parser
  (Int
   -> Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (Int
      -> DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"systemId"
    Parser
  (Int
   -> DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser Int
-> Parser
     (DOMSnapshotNodeTreeSnapshot
      -> DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"frameId"
    Parser
  (DOMSnapshotNodeTreeSnapshot
   -> DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser DOMSnapshotNodeTreeSnapshot
-> Parser
     (DOMSnapshotLayoutTreeSnapshot
      -> DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMSnapshotNodeTreeSnapshot
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"nodes"
    Parser
  (DOMSnapshotLayoutTreeSnapshot
   -> DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser DOMSnapshotLayoutTreeSnapshot
-> Parser
     (DOMSnapshotTextBoxSnapshot
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMSnapshotLayoutTreeSnapshot
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"layout"
    Parser
  (DOMSnapshotTextBoxSnapshot
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser DOMSnapshotTextBoxSnapshot
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMSnapshotTextBoxSnapshot
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"textBoxes"
    Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> DOMSnapshotDocumentSnapshot)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Double -> Maybe Double -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scrollOffsetX"
    Parser
  (Maybe Double
   -> Maybe Double -> Maybe Double -> DOMSnapshotDocumentSnapshot)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double -> Maybe Double -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scrollOffsetY"
    Parser
  (Maybe Double -> Maybe Double -> DOMSnapshotDocumentSnapshot)
-> Parser (Maybe Double)
-> Parser (Maybe Double -> DOMSnapshotDocumentSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"contentWidth"
    Parser (Maybe Double -> DOMSnapshotDocumentSnapshot)
-> Parser (Maybe Double) -> Parser DOMSnapshotDocumentSnapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"contentHeight"
instance ToJSON DOMSnapshotDocumentSnapshot where
  toJSON :: DOMSnapshotDocumentSnapshot -> Value
toJSON DOMSnapshotDocumentSnapshot
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"documentURL" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotDocumentURL DOMSnapshotDocumentSnapshot
p),
    (Text
"title" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotTitle DOMSnapshotDocumentSnapshot
p),
    (Text
"baseURL" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotBaseURL DOMSnapshotDocumentSnapshot
p),
    (Text
"contentLanguage" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotContentLanguage DOMSnapshotDocumentSnapshot
p),
    (Text
"encodingName" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotEncodingName DOMSnapshotDocumentSnapshot
p),
    (Text
"publicId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotPublicId DOMSnapshotDocumentSnapshot
p),
    (Text
"systemId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotSystemId DOMSnapshotDocumentSnapshot
p),
    (Text
"frameId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> Int
dOMSnapshotDocumentSnapshotFrameId DOMSnapshotDocumentSnapshot
p),
    (Text
"nodes" Text -> DOMSnapshotNodeTreeSnapshot -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotNodeTreeSnapshot -> Pair)
-> Maybe DOMSnapshotNodeTreeSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotNodeTreeSnapshot
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> DOMSnapshotNodeTreeSnapshot
dOMSnapshotDocumentSnapshotNodes DOMSnapshotDocumentSnapshot
p),
    (Text
"layout" Text -> DOMSnapshotLayoutTreeSnapshot -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotLayoutTreeSnapshot -> Pair)
-> Maybe DOMSnapshotLayoutTreeSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMSnapshotLayoutTreeSnapshot
-> Maybe DOMSnapshotLayoutTreeSnapshot
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> DOMSnapshotLayoutTreeSnapshot
dOMSnapshotDocumentSnapshotLayout DOMSnapshotDocumentSnapshot
p),
    (Text
"textBoxes" Text -> DOMSnapshotTextBoxSnapshot -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotTextBoxSnapshot -> Pair)
-> Maybe DOMSnapshotTextBoxSnapshot -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMSnapshotTextBoxSnapshot -> Maybe DOMSnapshotTextBoxSnapshot
forall a. a -> Maybe a
Just (DOMSnapshotDocumentSnapshot -> DOMSnapshotTextBoxSnapshot
dOMSnapshotDocumentSnapshotTextBoxes DOMSnapshotDocumentSnapshot
p),
    (Text
"scrollOffsetX" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotScrollOffsetX DOMSnapshotDocumentSnapshot
p),
    (Text
"scrollOffsetY" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotScrollOffsetY DOMSnapshotDocumentSnapshot
p),
    (Text
"contentWidth" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotContentWidth DOMSnapshotDocumentSnapshot
p),
    (Text
"contentHeight" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotDocumentSnapshot -> Maybe Double
dOMSnapshotDocumentSnapshotContentHeight DOMSnapshotDocumentSnapshot
p)
    ]

-- | Type 'DOMSnapshot.NodeTreeSnapshot'.
--   Table containing nodes.
data DOMSnapshotNodeTreeSnapshot = DOMSnapshotNodeTreeSnapshot
  {
    -- | Parent node index.
    DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotParentIndex :: Maybe [Int],
    -- | `Node`'s nodeType.
    DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotNodeType :: Maybe [Int],
    -- | Type of the shadow root the `Node` is in. String values are equal to the `ShadowRootType` enum.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotShadowRootType :: Maybe DOMSnapshotRareStringData,
    -- | `Node`'s nodeName.
    DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotNodeName :: Maybe [DOMSnapshotStringIndex],
    -- | `Node`'s nodeValue.
    DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotNodeValue :: Maybe [DOMSnapshotStringIndex],
    -- | `Node`'s id, corresponds to DOM.Node.backendNodeId.
    DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotBackendNodeId :: Maybe [DOMPageNetworkEmulationSecurity.DOMBackendNodeId],
    -- | Attributes of an `Element` node. Flatten name, value pairs.
    DOMSnapshotNodeTreeSnapshot -> Maybe [[Int]]
dOMSnapshotNodeTreeSnapshotAttributes :: Maybe [DOMSnapshotArrayOfStrings],
    -- | Only set for textarea elements, contains the text value.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotTextValue :: Maybe DOMSnapshotRareStringData,
    -- | Only set for input elements, contains the input's associated text value.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotInputValue :: Maybe DOMSnapshotRareStringData,
    -- | Only set for radio and checkbox input elements, indicates if the element has been checked
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareBooleanData
dOMSnapshotNodeTreeSnapshotInputChecked :: Maybe DOMSnapshotRareBooleanData,
    -- | Only set for option elements, indicates if the element has been selected
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareBooleanData
dOMSnapshotNodeTreeSnapshotOptionSelected :: Maybe DOMSnapshotRareBooleanData,
    -- | The index of the document in the list of the snapshot documents.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareIntegerData
dOMSnapshotNodeTreeSnapshotContentDocumentIndex :: Maybe DOMSnapshotRareIntegerData,
    -- | Type of a pseudo element node.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotPseudoType :: Maybe DOMSnapshotRareStringData,
    -- | Pseudo element identifier for this node. Only present if there is a
    --   valid pseudoType.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotPseudoIdentifier :: Maybe DOMSnapshotRareStringData,
    -- | Whether this DOM node responds to mouse clicks. This includes nodes that have had click
    --   event listeners attached via JavaScript as well as anchor tags that naturally navigate when
    --   clicked.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareBooleanData
dOMSnapshotNodeTreeSnapshotIsClickable :: Maybe DOMSnapshotRareBooleanData,
    -- | The selected url for nodes with a srcset attribute.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotCurrentSourceURL :: Maybe DOMSnapshotRareStringData,
    -- | The url of the script (if any) that generates this node.
    DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotOriginURL :: Maybe DOMSnapshotRareStringData
  }
  deriving (DOMSnapshotNodeTreeSnapshot -> DOMSnapshotNodeTreeSnapshot -> Bool
(DOMSnapshotNodeTreeSnapshot
 -> DOMSnapshotNodeTreeSnapshot -> Bool)
-> (DOMSnapshotNodeTreeSnapshot
    -> DOMSnapshotNodeTreeSnapshot -> Bool)
-> Eq DOMSnapshotNodeTreeSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotNodeTreeSnapshot -> DOMSnapshotNodeTreeSnapshot -> Bool
$c/= :: DOMSnapshotNodeTreeSnapshot -> DOMSnapshotNodeTreeSnapshot -> Bool
== :: DOMSnapshotNodeTreeSnapshot -> DOMSnapshotNodeTreeSnapshot -> Bool
$c== :: DOMSnapshotNodeTreeSnapshot -> DOMSnapshotNodeTreeSnapshot -> Bool
Eq, Int -> DOMSnapshotNodeTreeSnapshot -> ShowS
[DOMSnapshotNodeTreeSnapshot] -> ShowS
DOMSnapshotNodeTreeSnapshot -> String
(Int -> DOMSnapshotNodeTreeSnapshot -> ShowS)
-> (DOMSnapshotNodeTreeSnapshot -> String)
-> ([DOMSnapshotNodeTreeSnapshot] -> ShowS)
-> Show DOMSnapshotNodeTreeSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotNodeTreeSnapshot] -> ShowS
$cshowList :: [DOMSnapshotNodeTreeSnapshot] -> ShowS
show :: DOMSnapshotNodeTreeSnapshot -> String
$cshow :: DOMSnapshotNodeTreeSnapshot -> String
showsPrec :: Int -> DOMSnapshotNodeTreeSnapshot -> ShowS
$cshowsPrec :: Int -> DOMSnapshotNodeTreeSnapshot -> ShowS
Show)
instance FromJSON DOMSnapshotNodeTreeSnapshot where
  parseJSON :: Value -> Parser DOMSnapshotNodeTreeSnapshot
parseJSON = String
-> (Object -> Parser DOMSnapshotNodeTreeSnapshot)
-> Value
-> Parser DOMSnapshotNodeTreeSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotNodeTreeSnapshot" ((Object -> Parser DOMSnapshotNodeTreeSnapshot)
 -> Value -> Parser DOMSnapshotNodeTreeSnapshot)
-> (Object -> Parser DOMSnapshotNodeTreeSnapshot)
-> Value
-> Parser DOMSnapshotNodeTreeSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe [Int]
-> Maybe [Int]
-> Maybe DOMSnapshotRareStringData
-> Maybe [Int]
-> Maybe [Int]
-> Maybe [Int]
-> Maybe [[Int]]
-> Maybe DOMSnapshotRareStringData
-> Maybe DOMSnapshotRareStringData
-> Maybe DOMSnapshotRareBooleanData
-> Maybe DOMSnapshotRareBooleanData
-> Maybe DOMSnapshotRareIntegerData
-> Maybe DOMSnapshotRareStringData
-> Maybe DOMSnapshotRareStringData
-> Maybe DOMSnapshotRareBooleanData
-> Maybe DOMSnapshotRareStringData
-> Maybe DOMSnapshotRareStringData
-> DOMSnapshotNodeTreeSnapshot
DOMSnapshotNodeTreeSnapshot
    (Maybe [Int]
 -> Maybe [Int]
 -> Maybe DOMSnapshotRareStringData
 -> Maybe [Int]
 -> Maybe [Int]
 -> Maybe [Int]
 -> Maybe [[Int]]
 -> Maybe DOMSnapshotRareStringData
 -> Maybe DOMSnapshotRareStringData
 -> Maybe DOMSnapshotRareBooleanData
 -> Maybe DOMSnapshotRareBooleanData
 -> Maybe DOMSnapshotRareIntegerData
 -> Maybe DOMSnapshotRareStringData
 -> Maybe DOMSnapshotRareStringData
 -> Maybe DOMSnapshotRareBooleanData
 -> Maybe DOMSnapshotRareStringData
 -> Maybe DOMSnapshotRareStringData
 -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe [Int]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe [Int]
      -> Maybe [Int]
      -> Maybe [Int]
      -> Maybe [[Int]]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"parentIndex"
    Parser
  (Maybe [Int]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe [Int]
   -> Maybe [Int]
   -> Maybe [Int]
   -> Maybe [[Int]]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe DOMSnapshotRareStringData
      -> Maybe [Int]
      -> Maybe [Int]
      -> Maybe [Int]
      -> Maybe [[Int]]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"nodeType"
    Parser
  (Maybe DOMSnapshotRareStringData
   -> Maybe [Int]
   -> Maybe [Int]
   -> Maybe [Int]
   -> Maybe [[Int]]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser
     (Maybe [Int]
      -> Maybe [Int]
      -> Maybe [Int]
      -> Maybe [[Int]]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"shadowRootType"
    Parser
  (Maybe [Int]
   -> Maybe [Int]
   -> Maybe [Int]
   -> Maybe [[Int]]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe [Int]
      -> Maybe [Int]
      -> Maybe [[Int]]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"nodeName"
    Parser
  (Maybe [Int]
   -> Maybe [Int]
   -> Maybe [[Int]]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe [Int]
      -> Maybe [[Int]]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"nodeValue"
    Parser
  (Maybe [Int]
   -> Maybe [[Int]]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe [[Int]]
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"backendNodeId"
    Parser
  (Maybe [[Int]]
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe [[Int]])
-> Parser
     (Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [[Int]])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"attributes"
    Parser
  (Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser
     (Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"textValue"
    Parser
  (Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser
     (Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inputValue"
    Parser
  (Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareBooleanData)
-> Parser
     (Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareBooleanData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inputChecked"
    Parser
  (Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareBooleanData)
-> Parser
     (Maybe DOMSnapshotRareIntegerData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareBooleanData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"optionSelected"
    Parser
  (Maybe DOMSnapshotRareIntegerData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareIntegerData)
-> Parser
     (Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareIntegerData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"contentDocumentIndex"
    Parser
  (Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser
     (Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"pseudoType"
    Parser
  (Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser
     (Maybe DOMSnapshotRareBooleanData
      -> Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData
      -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"pseudoIdentifier"
    Parser
  (Maybe DOMSnapshotRareBooleanData
   -> Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData
   -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareBooleanData)
-> Parser
     (Maybe DOMSnapshotRareStringData
      -> Maybe DOMSnapshotRareStringData -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareBooleanData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"isClickable"
    Parser
  (Maybe DOMSnapshotRareStringData
   -> Maybe DOMSnapshotRareStringData -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser
     (Maybe DOMSnapshotRareStringData -> DOMSnapshotNodeTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"currentSourceURL"
    Parser
  (Maybe DOMSnapshotRareStringData -> DOMSnapshotNodeTreeSnapshot)
-> Parser (Maybe DOMSnapshotRareStringData)
-> Parser DOMSnapshotNodeTreeSnapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRareStringData)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"originURL"
instance ToJSON DOMSnapshotNodeTreeSnapshot where
  toJSON :: DOMSnapshotNodeTreeSnapshot -> Value
toJSON DOMSnapshotNodeTreeSnapshot
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"parentIndex" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotParentIndex DOMSnapshotNodeTreeSnapshot
p),
    (Text
"nodeType" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotNodeType DOMSnapshotNodeTreeSnapshot
p),
    (Text
"shadowRootType" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotShadowRootType DOMSnapshotNodeTreeSnapshot
p),
    (Text
"nodeName" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotNodeName DOMSnapshotNodeTreeSnapshot
p),
    (Text
"nodeValue" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotNodeValue DOMSnapshotNodeTreeSnapshot
p),
    (Text
"backendNodeId" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe [Int]
dOMSnapshotNodeTreeSnapshotBackendNodeId DOMSnapshotNodeTreeSnapshot
p),
    (Text
"attributes" Text -> [[Int]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([[Int]] -> Pair) -> Maybe [[Int]] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe [[Int]]
dOMSnapshotNodeTreeSnapshotAttributes DOMSnapshotNodeTreeSnapshot
p),
    (Text
"textValue" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotTextValue DOMSnapshotNodeTreeSnapshot
p),
    (Text
"inputValue" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotInputValue DOMSnapshotNodeTreeSnapshot
p),
    (Text
"inputChecked" Text -> DOMSnapshotRareBooleanData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareBooleanData -> Pair)
-> Maybe DOMSnapshotRareBooleanData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareBooleanData
dOMSnapshotNodeTreeSnapshotInputChecked DOMSnapshotNodeTreeSnapshot
p),
    (Text
"optionSelected" Text -> DOMSnapshotRareBooleanData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareBooleanData -> Pair)
-> Maybe DOMSnapshotRareBooleanData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareBooleanData
dOMSnapshotNodeTreeSnapshotOptionSelected DOMSnapshotNodeTreeSnapshot
p),
    (Text
"contentDocumentIndex" Text -> DOMSnapshotRareIntegerData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareIntegerData -> Pair)
-> Maybe DOMSnapshotRareIntegerData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareIntegerData
dOMSnapshotNodeTreeSnapshotContentDocumentIndex DOMSnapshotNodeTreeSnapshot
p),
    (Text
"pseudoType" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotPseudoType DOMSnapshotNodeTreeSnapshot
p),
    (Text
"pseudoIdentifier" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotPseudoIdentifier DOMSnapshotNodeTreeSnapshot
p),
    (Text
"isClickable" Text -> DOMSnapshotRareBooleanData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareBooleanData -> Pair)
-> Maybe DOMSnapshotRareBooleanData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareBooleanData
dOMSnapshotNodeTreeSnapshotIsClickable DOMSnapshotNodeTreeSnapshot
p),
    (Text
"currentSourceURL" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotCurrentSourceURL DOMSnapshotNodeTreeSnapshot
p),
    (Text
"originURL" Text -> DOMSnapshotRareStringData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareStringData -> Pair)
-> Maybe DOMSnapshotRareStringData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotNodeTreeSnapshot -> Maybe DOMSnapshotRareStringData
dOMSnapshotNodeTreeSnapshotOriginURL DOMSnapshotNodeTreeSnapshot
p)
    ]

-- | Type 'DOMSnapshot.LayoutTreeSnapshot'.
--   Table of details of an element in the DOM tree with a LayoutObject.
data DOMSnapshotLayoutTreeSnapshot = DOMSnapshotLayoutTreeSnapshot
  {
    -- | Index of the corresponding node in the `NodeTreeSnapshot` array returned by `captureSnapshot`.
    DOMSnapshotLayoutTreeSnapshot -> [Int]
dOMSnapshotLayoutTreeSnapshotNodeIndex :: [Int],
    -- | Array of indexes specifying computed style strings, filtered according to the `computedStyles` parameter passed to `captureSnapshot`.
    DOMSnapshotLayoutTreeSnapshot -> [[Int]]
dOMSnapshotLayoutTreeSnapshotStyles :: [DOMSnapshotArrayOfStrings],
    -- | The absolute position bounding box.
    DOMSnapshotLayoutTreeSnapshot -> [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotBounds :: [DOMSnapshotRectangle],
    -- | Contents of the LayoutText, if any.
    DOMSnapshotLayoutTreeSnapshot -> [Int]
dOMSnapshotLayoutTreeSnapshotText :: [DOMSnapshotStringIndex],
    -- | Stacking context information.
    DOMSnapshotLayoutTreeSnapshot -> DOMSnapshotRareBooleanData
dOMSnapshotLayoutTreeSnapshotStackingContexts :: DOMSnapshotRareBooleanData,
    -- | Global paint order index, which is determined by the stacking order of the nodes. Nodes
    --   that are painted together will have the same index. Only provided if includePaintOrder in
    --   captureSnapshot was true.
    DOMSnapshotLayoutTreeSnapshot -> Maybe [Int]
dOMSnapshotLayoutTreeSnapshotPaintOrders :: Maybe [Int],
    -- | The offset rect of nodes. Only available when includeDOMRects is set to true
    DOMSnapshotLayoutTreeSnapshot -> Maybe [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotOffsetRects :: Maybe [DOMSnapshotRectangle],
    -- | The scroll rect of nodes. Only available when includeDOMRects is set to true
    DOMSnapshotLayoutTreeSnapshot -> Maybe [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotScrollRects :: Maybe [DOMSnapshotRectangle],
    -- | The client rect of nodes. Only available when includeDOMRects is set to true
    DOMSnapshotLayoutTreeSnapshot -> Maybe [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotClientRects :: Maybe [DOMSnapshotRectangle],
    -- | The list of background colors that are blended with colors of overlapping elements.
    DOMSnapshotLayoutTreeSnapshot -> Maybe [Int]
dOMSnapshotLayoutTreeSnapshotBlendedBackgroundColors :: Maybe [DOMSnapshotStringIndex],
    -- | The list of computed text opacities.
    DOMSnapshotLayoutTreeSnapshot -> Maybe DOMSnapshotRectangle
dOMSnapshotLayoutTreeSnapshotTextColorOpacities :: Maybe [Double]
  }
  deriving (DOMSnapshotLayoutTreeSnapshot
-> DOMSnapshotLayoutTreeSnapshot -> Bool
(DOMSnapshotLayoutTreeSnapshot
 -> DOMSnapshotLayoutTreeSnapshot -> Bool)
-> (DOMSnapshotLayoutTreeSnapshot
    -> DOMSnapshotLayoutTreeSnapshot -> Bool)
-> Eq DOMSnapshotLayoutTreeSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotLayoutTreeSnapshot
-> DOMSnapshotLayoutTreeSnapshot -> Bool
$c/= :: DOMSnapshotLayoutTreeSnapshot
-> DOMSnapshotLayoutTreeSnapshot -> Bool
== :: DOMSnapshotLayoutTreeSnapshot
-> DOMSnapshotLayoutTreeSnapshot -> Bool
$c== :: DOMSnapshotLayoutTreeSnapshot
-> DOMSnapshotLayoutTreeSnapshot -> Bool
Eq, Int -> DOMSnapshotLayoutTreeSnapshot -> ShowS
[DOMSnapshotLayoutTreeSnapshot] -> ShowS
DOMSnapshotLayoutTreeSnapshot -> String
(Int -> DOMSnapshotLayoutTreeSnapshot -> ShowS)
-> (DOMSnapshotLayoutTreeSnapshot -> String)
-> ([DOMSnapshotLayoutTreeSnapshot] -> ShowS)
-> Show DOMSnapshotLayoutTreeSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotLayoutTreeSnapshot] -> ShowS
$cshowList :: [DOMSnapshotLayoutTreeSnapshot] -> ShowS
show :: DOMSnapshotLayoutTreeSnapshot -> String
$cshow :: DOMSnapshotLayoutTreeSnapshot -> String
showsPrec :: Int -> DOMSnapshotLayoutTreeSnapshot -> ShowS
$cshowsPrec :: Int -> DOMSnapshotLayoutTreeSnapshot -> ShowS
Show)
instance FromJSON DOMSnapshotLayoutTreeSnapshot where
  parseJSON :: Value -> Parser DOMSnapshotLayoutTreeSnapshot
parseJSON = String
-> (Object -> Parser DOMSnapshotLayoutTreeSnapshot)
-> Value
-> Parser DOMSnapshotLayoutTreeSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotLayoutTreeSnapshot" ((Object -> Parser DOMSnapshotLayoutTreeSnapshot)
 -> Value -> Parser DOMSnapshotLayoutTreeSnapshot)
-> (Object -> Parser DOMSnapshotLayoutTreeSnapshot)
-> Value
-> Parser DOMSnapshotLayoutTreeSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int]
-> [[Int]]
-> [DOMSnapshotRectangle]
-> [Int]
-> DOMSnapshotRareBooleanData
-> Maybe [Int]
-> Maybe [DOMSnapshotRectangle]
-> Maybe [DOMSnapshotRectangle]
-> Maybe [DOMSnapshotRectangle]
-> Maybe [Int]
-> Maybe DOMSnapshotRectangle
-> DOMSnapshotLayoutTreeSnapshot
DOMSnapshotLayoutTreeSnapshot
    ([Int]
 -> [[Int]]
 -> [DOMSnapshotRectangle]
 -> [Int]
 -> DOMSnapshotRareBooleanData
 -> Maybe [Int]
 -> Maybe [DOMSnapshotRectangle]
 -> Maybe [DOMSnapshotRectangle]
 -> Maybe [DOMSnapshotRectangle]
 -> Maybe [Int]
 -> Maybe DOMSnapshotRectangle
 -> DOMSnapshotLayoutTreeSnapshot)
-> Parser [Int]
-> Parser
     ([[Int]]
      -> [DOMSnapshotRectangle]
      -> [Int]
      -> DOMSnapshotRareBooleanData
      -> Maybe [Int]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"nodeIndex"
    Parser
  ([[Int]]
   -> [DOMSnapshotRectangle]
   -> [Int]
   -> DOMSnapshotRareBooleanData
   -> Maybe [Int]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser [[Int]]
-> Parser
     ([DOMSnapshotRectangle]
      -> [Int]
      -> DOMSnapshotRareBooleanData
      -> Maybe [Int]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [[Int]]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"styles"
    Parser
  ([DOMSnapshotRectangle]
   -> [Int]
   -> DOMSnapshotRareBooleanData
   -> Maybe [Int]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser [DOMSnapshotRectangle]
-> Parser
     ([Int]
      -> DOMSnapshotRareBooleanData
      -> Maybe [Int]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [DOMSnapshotRectangle]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"bounds"
    Parser
  ([Int]
   -> DOMSnapshotRareBooleanData
   -> Maybe [Int]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser [Int]
-> Parser
     (DOMSnapshotRareBooleanData
      -> Maybe [Int]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"text"
    Parser
  (DOMSnapshotRareBooleanData
   -> Maybe [Int]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser DOMSnapshotRareBooleanData
-> Parser
     (Maybe [Int]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMSnapshotRareBooleanData
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"stackingContexts"
    Parser
  (Maybe [Int]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"paintOrders"
    Parser
  (Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser (Maybe [DOMSnapshotRectangle])
-> Parser
     (Maybe [DOMSnapshotRectangle]
      -> Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [DOMSnapshotRectangle])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"offsetRects"
    Parser
  (Maybe [DOMSnapshotRectangle]
   -> Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser (Maybe [DOMSnapshotRectangle])
-> Parser
     (Maybe [DOMSnapshotRectangle]
      -> Maybe [Int]
      -> Maybe DOMSnapshotRectangle
      -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [DOMSnapshotRectangle])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scrollRects"
    Parser
  (Maybe [DOMSnapshotRectangle]
   -> Maybe [Int]
   -> Maybe DOMSnapshotRectangle
   -> DOMSnapshotLayoutTreeSnapshot)
-> Parser (Maybe [DOMSnapshotRectangle])
-> Parser
     (Maybe [Int]
      -> Maybe DOMSnapshotRectangle -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [DOMSnapshotRectangle])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"clientRects"
    Parser
  (Maybe [Int]
   -> Maybe DOMSnapshotRectangle -> DOMSnapshotLayoutTreeSnapshot)
-> Parser (Maybe [Int])
-> Parser
     (Maybe DOMSnapshotRectangle -> DOMSnapshotLayoutTreeSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"blendedBackgroundColors"
    Parser
  (Maybe DOMSnapshotRectangle -> DOMSnapshotLayoutTreeSnapshot)
-> Parser (Maybe DOMSnapshotRectangle)
-> Parser DOMSnapshotLayoutTreeSnapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMSnapshotRectangle)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"textColorOpacities"
instance ToJSON DOMSnapshotLayoutTreeSnapshot where
  toJSON :: DOMSnapshotLayoutTreeSnapshot -> Value
toJSON DOMSnapshotLayoutTreeSnapshot
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"nodeIndex" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeSnapshot -> [Int]
dOMSnapshotLayoutTreeSnapshotNodeIndex DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"styles" Text -> [[Int]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([[Int]] -> Pair) -> Maybe [[Int]] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Int]] -> Maybe [[Int]]
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeSnapshot -> [[Int]]
dOMSnapshotLayoutTreeSnapshotStyles DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"bounds" Text -> [DOMSnapshotRectangle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotRectangle] -> Pair)
-> Maybe [DOMSnapshotRectangle] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DOMSnapshotRectangle] -> Maybe [DOMSnapshotRectangle]
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeSnapshot -> [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotBounds DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"text" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeSnapshot -> [Int]
dOMSnapshotLayoutTreeSnapshotText DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"stackingContexts" Text -> DOMSnapshotRareBooleanData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRareBooleanData -> Pair)
-> Maybe DOMSnapshotRareBooleanData -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMSnapshotRareBooleanData -> Maybe DOMSnapshotRareBooleanData
forall a. a -> Maybe a
Just (DOMSnapshotLayoutTreeSnapshot -> DOMSnapshotRareBooleanData
dOMSnapshotLayoutTreeSnapshotStackingContexts DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"paintOrders" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeSnapshot -> Maybe [Int]
dOMSnapshotLayoutTreeSnapshotPaintOrders DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"offsetRects" Text -> [DOMSnapshotRectangle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotRectangle] -> Pair)
-> Maybe [DOMSnapshotRectangle] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeSnapshot -> Maybe [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotOffsetRects DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"scrollRects" Text -> [DOMSnapshotRectangle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotRectangle] -> Pair)
-> Maybe [DOMSnapshotRectangle] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeSnapshot -> Maybe [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotScrollRects DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"clientRects" Text -> [DOMSnapshotRectangle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotRectangle] -> Pair)
-> Maybe [DOMSnapshotRectangle] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeSnapshot -> Maybe [DOMSnapshotRectangle]
dOMSnapshotLayoutTreeSnapshotClientRects DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"blendedBackgroundColors" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeSnapshot -> Maybe [Int]
dOMSnapshotLayoutTreeSnapshotBlendedBackgroundColors DOMSnapshotLayoutTreeSnapshot
p),
    (Text
"textColorOpacities" Text -> DOMSnapshotRectangle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMSnapshotRectangle -> Pair)
-> Maybe DOMSnapshotRectangle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DOMSnapshotLayoutTreeSnapshot -> Maybe DOMSnapshotRectangle
dOMSnapshotLayoutTreeSnapshotTextColorOpacities DOMSnapshotLayoutTreeSnapshot
p)
    ]

-- | Type 'DOMSnapshot.TextBoxSnapshot'.
--   Table of details of the post layout rendered text positions. The exact layout should not be regarded as
--   stable and may change between versions.
data DOMSnapshotTextBoxSnapshot = DOMSnapshotTextBoxSnapshot
  {
    -- | Index of the layout tree node that owns this box collection.
    DOMSnapshotTextBoxSnapshot -> [Int]
dOMSnapshotTextBoxSnapshotLayoutIndex :: [Int],
    -- | The absolute position bounding box.
    DOMSnapshotTextBoxSnapshot -> [DOMSnapshotRectangle]
dOMSnapshotTextBoxSnapshotBounds :: [DOMSnapshotRectangle],
    -- | The starting index in characters, for this post layout textbox substring. Characters that
    --   would be represented as a surrogate pair in UTF-16 have length 2.
    DOMSnapshotTextBoxSnapshot -> [Int]
dOMSnapshotTextBoxSnapshotStart :: [Int],
    -- | The number of characters in this post layout textbox substring. Characters that would be
    --   represented as a surrogate pair in UTF-16 have length 2.
    DOMSnapshotTextBoxSnapshot -> [Int]
dOMSnapshotTextBoxSnapshotLength :: [Int]
  }
  deriving (DOMSnapshotTextBoxSnapshot -> DOMSnapshotTextBoxSnapshot -> Bool
(DOMSnapshotTextBoxSnapshot -> DOMSnapshotTextBoxSnapshot -> Bool)
-> (DOMSnapshotTextBoxSnapshot
    -> DOMSnapshotTextBoxSnapshot -> Bool)
-> Eq DOMSnapshotTextBoxSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotTextBoxSnapshot -> DOMSnapshotTextBoxSnapshot -> Bool
$c/= :: DOMSnapshotTextBoxSnapshot -> DOMSnapshotTextBoxSnapshot -> Bool
== :: DOMSnapshotTextBoxSnapshot -> DOMSnapshotTextBoxSnapshot -> Bool
$c== :: DOMSnapshotTextBoxSnapshot -> DOMSnapshotTextBoxSnapshot -> Bool
Eq, Int -> DOMSnapshotTextBoxSnapshot -> ShowS
[DOMSnapshotTextBoxSnapshot] -> ShowS
DOMSnapshotTextBoxSnapshot -> String
(Int -> DOMSnapshotTextBoxSnapshot -> ShowS)
-> (DOMSnapshotTextBoxSnapshot -> String)
-> ([DOMSnapshotTextBoxSnapshot] -> ShowS)
-> Show DOMSnapshotTextBoxSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotTextBoxSnapshot] -> ShowS
$cshowList :: [DOMSnapshotTextBoxSnapshot] -> ShowS
show :: DOMSnapshotTextBoxSnapshot -> String
$cshow :: DOMSnapshotTextBoxSnapshot -> String
showsPrec :: Int -> DOMSnapshotTextBoxSnapshot -> ShowS
$cshowsPrec :: Int -> DOMSnapshotTextBoxSnapshot -> ShowS
Show)
instance FromJSON DOMSnapshotTextBoxSnapshot where
  parseJSON :: Value -> Parser DOMSnapshotTextBoxSnapshot
parseJSON = String
-> (Object -> Parser DOMSnapshotTextBoxSnapshot)
-> Value
-> Parser DOMSnapshotTextBoxSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotTextBoxSnapshot" ((Object -> Parser DOMSnapshotTextBoxSnapshot)
 -> Value -> Parser DOMSnapshotTextBoxSnapshot)
-> (Object -> Parser DOMSnapshotTextBoxSnapshot)
-> Value
-> Parser DOMSnapshotTextBoxSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int]
-> [DOMSnapshotRectangle]
-> [Int]
-> [Int]
-> DOMSnapshotTextBoxSnapshot
DOMSnapshotTextBoxSnapshot
    ([Int]
 -> [DOMSnapshotRectangle]
 -> [Int]
 -> [Int]
 -> DOMSnapshotTextBoxSnapshot)
-> Parser [Int]
-> Parser
     ([DOMSnapshotRectangle]
      -> [Int] -> [Int] -> DOMSnapshotTextBoxSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"layoutIndex"
    Parser
  ([DOMSnapshotRectangle]
   -> [Int] -> [Int] -> DOMSnapshotTextBoxSnapshot)
-> Parser [DOMSnapshotRectangle]
-> Parser ([Int] -> [Int] -> DOMSnapshotTextBoxSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [DOMSnapshotRectangle]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"bounds"
    Parser ([Int] -> [Int] -> DOMSnapshotTextBoxSnapshot)
-> Parser [Int] -> Parser ([Int] -> DOMSnapshotTextBoxSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"start"
    Parser ([Int] -> DOMSnapshotTextBoxSnapshot)
-> Parser [Int] -> Parser DOMSnapshotTextBoxSnapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Int]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"length"
instance ToJSON DOMSnapshotTextBoxSnapshot where
  toJSON :: DOMSnapshotTextBoxSnapshot -> Value
toJSON DOMSnapshotTextBoxSnapshot
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"layoutIndex" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotTextBoxSnapshot -> [Int]
dOMSnapshotTextBoxSnapshotLayoutIndex DOMSnapshotTextBoxSnapshot
p),
    (Text
"bounds" Text -> [DOMSnapshotRectangle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([DOMSnapshotRectangle] -> Pair)
-> Maybe [DOMSnapshotRectangle] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DOMSnapshotRectangle] -> Maybe [DOMSnapshotRectangle]
forall a. a -> Maybe a
Just (DOMSnapshotTextBoxSnapshot -> [DOMSnapshotRectangle]
dOMSnapshotTextBoxSnapshotBounds DOMSnapshotTextBoxSnapshot
p),
    (Text
"start" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotTextBoxSnapshot -> [Int]
dOMSnapshotTextBoxSnapshotStart DOMSnapshotTextBoxSnapshot
p),
    (Text
"length" Text -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Int] -> Pair) -> Maybe [Int] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just (DOMSnapshotTextBoxSnapshot -> [Int]
dOMSnapshotTextBoxSnapshotLength DOMSnapshotTextBoxSnapshot
p)
    ]

-- | Disables DOM snapshot agent for the given page.

-- | Parameters of the 'DOMSnapshot.disable' command.
data PDOMSnapshotDisable = PDOMSnapshotDisable
  deriving (PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool
(PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool)
-> (PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool)
-> Eq PDOMSnapshotDisable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool
$c/= :: PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool
== :: PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool
$c== :: PDOMSnapshotDisable -> PDOMSnapshotDisable -> Bool
Eq, Int -> PDOMSnapshotDisable -> ShowS
[PDOMSnapshotDisable] -> ShowS
PDOMSnapshotDisable -> String
(Int -> PDOMSnapshotDisable -> ShowS)
-> (PDOMSnapshotDisable -> String)
-> ([PDOMSnapshotDisable] -> ShowS)
-> Show PDOMSnapshotDisable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDOMSnapshotDisable] -> ShowS
$cshowList :: [PDOMSnapshotDisable] -> ShowS
show :: PDOMSnapshotDisable -> String
$cshow :: PDOMSnapshotDisable -> String
showsPrec :: Int -> PDOMSnapshotDisable -> ShowS
$cshowsPrec :: Int -> PDOMSnapshotDisable -> ShowS
Show)
pDOMSnapshotDisable
  :: PDOMSnapshotDisable
pDOMSnapshotDisable :: PDOMSnapshotDisable
pDOMSnapshotDisable
  = PDOMSnapshotDisable
PDOMSnapshotDisable
instance ToJSON PDOMSnapshotDisable where
  toJSON :: PDOMSnapshotDisable -> Value
toJSON PDOMSnapshotDisable
_ = Value
A.Null
instance Command PDOMSnapshotDisable where
  type CommandResponse PDOMSnapshotDisable = ()
  commandName :: Proxy PDOMSnapshotDisable -> String
commandName Proxy PDOMSnapshotDisable
_ = String
"DOMSnapshot.disable"
  fromJSON :: Proxy PDOMSnapshotDisable
-> Value -> Result (CommandResponse PDOMSnapshotDisable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDOMSnapshotDisable -> Result ())
-> Proxy PDOMSnapshotDisable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDOMSnapshotDisable -> ())
-> Proxy PDOMSnapshotDisable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDOMSnapshotDisable -> ()
forall a b. a -> b -> a
const ()

-- | Enables DOM snapshot agent for the given page.

-- | Parameters of the 'DOMSnapshot.enable' command.
data PDOMSnapshotEnable = PDOMSnapshotEnable
  deriving (PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool
(PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool)
-> (PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool)
-> Eq PDOMSnapshotEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool
$c/= :: PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool
== :: PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool
$c== :: PDOMSnapshotEnable -> PDOMSnapshotEnable -> Bool
Eq, Int -> PDOMSnapshotEnable -> ShowS
[PDOMSnapshotEnable] -> ShowS
PDOMSnapshotEnable -> String
(Int -> PDOMSnapshotEnable -> ShowS)
-> (PDOMSnapshotEnable -> String)
-> ([PDOMSnapshotEnable] -> ShowS)
-> Show PDOMSnapshotEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDOMSnapshotEnable] -> ShowS
$cshowList :: [PDOMSnapshotEnable] -> ShowS
show :: PDOMSnapshotEnable -> String
$cshow :: PDOMSnapshotEnable -> String
showsPrec :: Int -> PDOMSnapshotEnable -> ShowS
$cshowsPrec :: Int -> PDOMSnapshotEnable -> ShowS
Show)
pDOMSnapshotEnable
  :: PDOMSnapshotEnable
pDOMSnapshotEnable :: PDOMSnapshotEnable
pDOMSnapshotEnable
  = PDOMSnapshotEnable
PDOMSnapshotEnable
instance ToJSON PDOMSnapshotEnable where
  toJSON :: PDOMSnapshotEnable -> Value
toJSON PDOMSnapshotEnable
_ = Value
A.Null
instance Command PDOMSnapshotEnable where
  type CommandResponse PDOMSnapshotEnable = ()
  commandName :: Proxy PDOMSnapshotEnable -> String
commandName Proxy PDOMSnapshotEnable
_ = String
"DOMSnapshot.enable"
  fromJSON :: Proxy PDOMSnapshotEnable
-> Value -> Result (CommandResponse PDOMSnapshotEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PDOMSnapshotEnable -> Result ())
-> Proxy PDOMSnapshotEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PDOMSnapshotEnable -> ())
-> Proxy PDOMSnapshotEnable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PDOMSnapshotEnable -> ()
forall a b. a -> b -> a
const ()

-- | Returns a document snapshot, including the full DOM tree of the root node (including iframes,
--   template contents, and imported documents) in a flattened array, as well as layout and
--   white-listed computed style information for the nodes. Shadow DOM in the returned DOM tree is
--   flattened.

-- | Parameters of the 'DOMSnapshot.captureSnapshot' command.
data PDOMSnapshotCaptureSnapshot = PDOMSnapshotCaptureSnapshot
  {
    -- | Whitelist of computed styles to return.
    PDOMSnapshotCaptureSnapshot -> [Text]
pDOMSnapshotCaptureSnapshotComputedStyles :: [T.Text],
    -- | Whether to include layout object paint orders into the snapshot.
    PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludePaintOrder :: Maybe Bool,
    -- | Whether to include DOM rectangles (offsetRects, clientRects, scrollRects) into the snapshot
    PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludeDOMRects :: Maybe Bool,
    -- | Whether to include blended background colors in the snapshot (default: false).
    --   Blended background color is achieved by blending background colors of all elements
    --   that overlap with the current element.
    PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludeBlendedBackgroundColors :: Maybe Bool,
    -- | Whether to include text color opacity in the snapshot (default: false).
    --   An element might have the opacity property set that affects the text color of the element.
    --   The final text color opacity is computed based on the opacity of all overlapping elements.
    PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludeTextColorOpacities :: Maybe Bool
  }
  deriving (PDOMSnapshotCaptureSnapshot -> PDOMSnapshotCaptureSnapshot -> Bool
(PDOMSnapshotCaptureSnapshot
 -> PDOMSnapshotCaptureSnapshot -> Bool)
-> (PDOMSnapshotCaptureSnapshot
    -> PDOMSnapshotCaptureSnapshot -> Bool)
-> Eq PDOMSnapshotCaptureSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDOMSnapshotCaptureSnapshot -> PDOMSnapshotCaptureSnapshot -> Bool
$c/= :: PDOMSnapshotCaptureSnapshot -> PDOMSnapshotCaptureSnapshot -> Bool
== :: PDOMSnapshotCaptureSnapshot -> PDOMSnapshotCaptureSnapshot -> Bool
$c== :: PDOMSnapshotCaptureSnapshot -> PDOMSnapshotCaptureSnapshot -> Bool
Eq, Int -> PDOMSnapshotCaptureSnapshot -> ShowS
[PDOMSnapshotCaptureSnapshot] -> ShowS
PDOMSnapshotCaptureSnapshot -> String
(Int -> PDOMSnapshotCaptureSnapshot -> ShowS)
-> (PDOMSnapshotCaptureSnapshot -> String)
-> ([PDOMSnapshotCaptureSnapshot] -> ShowS)
-> Show PDOMSnapshotCaptureSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDOMSnapshotCaptureSnapshot] -> ShowS
$cshowList :: [PDOMSnapshotCaptureSnapshot] -> ShowS
show :: PDOMSnapshotCaptureSnapshot -> String
$cshow :: PDOMSnapshotCaptureSnapshot -> String
showsPrec :: Int -> PDOMSnapshotCaptureSnapshot -> ShowS
$cshowsPrec :: Int -> PDOMSnapshotCaptureSnapshot -> ShowS
Show)
pDOMSnapshotCaptureSnapshot
  {-
  -- | Whitelist of computed styles to return.
  -}
  :: [T.Text]
  -> PDOMSnapshotCaptureSnapshot
pDOMSnapshotCaptureSnapshot :: [Text] -> PDOMSnapshotCaptureSnapshot
pDOMSnapshotCaptureSnapshot
  [Text]
arg_pDOMSnapshotCaptureSnapshotComputedStyles
  = [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> PDOMSnapshotCaptureSnapshot
PDOMSnapshotCaptureSnapshot
    [Text]
arg_pDOMSnapshotCaptureSnapshotComputedStyles
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PDOMSnapshotCaptureSnapshot where
  toJSON :: PDOMSnapshotCaptureSnapshot -> Value
toJSON PDOMSnapshotCaptureSnapshot
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"computedStyles" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (PDOMSnapshotCaptureSnapshot -> [Text]
pDOMSnapshotCaptureSnapshotComputedStyles PDOMSnapshotCaptureSnapshot
p),
    (Text
"includePaintOrder" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludePaintOrder PDOMSnapshotCaptureSnapshot
p),
    (Text
"includeDOMRects" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludeDOMRects PDOMSnapshotCaptureSnapshot
p),
    (Text
"includeBlendedBackgroundColors" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludeBlendedBackgroundColors PDOMSnapshotCaptureSnapshot
p),
    (Text
"includeTextColorOpacities" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PDOMSnapshotCaptureSnapshot -> Maybe Bool
pDOMSnapshotCaptureSnapshotIncludeTextColorOpacities PDOMSnapshotCaptureSnapshot
p)
    ]
data DOMSnapshotCaptureSnapshot = DOMSnapshotCaptureSnapshot
  {
    -- | The nodes in the DOM tree. The DOMNode at index 0 corresponds to the root document.
    DOMSnapshotCaptureSnapshot -> [DOMSnapshotDocumentSnapshot]
dOMSnapshotCaptureSnapshotDocuments :: [DOMSnapshotDocumentSnapshot],
    -- | Shared string table that all string properties refer to with indexes.
    DOMSnapshotCaptureSnapshot -> [Text]
dOMSnapshotCaptureSnapshotStrings :: [T.Text]
  }
  deriving (DOMSnapshotCaptureSnapshot -> DOMSnapshotCaptureSnapshot -> Bool
(DOMSnapshotCaptureSnapshot -> DOMSnapshotCaptureSnapshot -> Bool)
-> (DOMSnapshotCaptureSnapshot
    -> DOMSnapshotCaptureSnapshot -> Bool)
-> Eq DOMSnapshotCaptureSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMSnapshotCaptureSnapshot -> DOMSnapshotCaptureSnapshot -> Bool
$c/= :: DOMSnapshotCaptureSnapshot -> DOMSnapshotCaptureSnapshot -> Bool
== :: DOMSnapshotCaptureSnapshot -> DOMSnapshotCaptureSnapshot -> Bool
$c== :: DOMSnapshotCaptureSnapshot -> DOMSnapshotCaptureSnapshot -> Bool
Eq, Int -> DOMSnapshotCaptureSnapshot -> ShowS
[DOMSnapshotCaptureSnapshot] -> ShowS
DOMSnapshotCaptureSnapshot -> String
(Int -> DOMSnapshotCaptureSnapshot -> ShowS)
-> (DOMSnapshotCaptureSnapshot -> String)
-> ([DOMSnapshotCaptureSnapshot] -> ShowS)
-> Show DOMSnapshotCaptureSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DOMSnapshotCaptureSnapshot] -> ShowS
$cshowList :: [DOMSnapshotCaptureSnapshot] -> ShowS
show :: DOMSnapshotCaptureSnapshot -> String
$cshow :: DOMSnapshotCaptureSnapshot -> String
showsPrec :: Int -> DOMSnapshotCaptureSnapshot -> ShowS
$cshowsPrec :: Int -> DOMSnapshotCaptureSnapshot -> ShowS
Show)
instance FromJSON DOMSnapshotCaptureSnapshot where
  parseJSON :: Value -> Parser DOMSnapshotCaptureSnapshot
parseJSON = String
-> (Object -> Parser DOMSnapshotCaptureSnapshot)
-> Value
-> Parser DOMSnapshotCaptureSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DOMSnapshotCaptureSnapshot" ((Object -> Parser DOMSnapshotCaptureSnapshot)
 -> Value -> Parser DOMSnapshotCaptureSnapshot)
-> (Object -> Parser DOMSnapshotCaptureSnapshot)
-> Value
-> Parser DOMSnapshotCaptureSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> [DOMSnapshotDocumentSnapshot]
-> [Text] -> DOMSnapshotCaptureSnapshot
DOMSnapshotCaptureSnapshot
    ([DOMSnapshotDocumentSnapshot]
 -> [Text] -> DOMSnapshotCaptureSnapshot)
-> Parser [DOMSnapshotDocumentSnapshot]
-> Parser ([Text] -> DOMSnapshotCaptureSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [DOMSnapshotDocumentSnapshot]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"documents"
    Parser ([Text] -> DOMSnapshotCaptureSnapshot)
-> Parser [Text] -> Parser DOMSnapshotCaptureSnapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"strings"
instance Command PDOMSnapshotCaptureSnapshot where
  type CommandResponse PDOMSnapshotCaptureSnapshot = DOMSnapshotCaptureSnapshot
  commandName :: Proxy PDOMSnapshotCaptureSnapshot -> String
commandName Proxy PDOMSnapshotCaptureSnapshot
_ = String
"DOMSnapshot.captureSnapshot"