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


{- |
= CSS

This domain exposes CSS read/write operations. All CSS objects (stylesheets, rules, and styles)
have an associated `id` used in subsequent operations on the related object. Each object type has
a specific `id` structure, and those are not interchangeable between objects of different kinds.
CSS objects can be loaded using the `get*ForNode()` calls (which accept a DOM node id). A client
can also keep track of stylesheets via the `styleSheetAdded`/`styleSheetRemoved` events and
subsequently load the required stylesheet contents using the `getStyleSheet[Text]()` methods.
-}


module CDP.Domains.CSS (module CDP.Domains.CSS) 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.DOMPageNetworkEmulationSecurity as DOMPageNetworkEmulationSecurity


-- | Type 'CSS.StyleSheetId'.
type CSSStyleSheetId = T.Text

-- | Type 'CSS.StyleSheetOrigin'.
--   Stylesheet type: "injected" for stylesheets injected via extension, "user-agent" for user-agent
--   stylesheets, "inspector" for stylesheets created by the inspector (i.e. those holding the "via
--   inspector" rules), "regular" for regular stylesheets.
data CSSStyleSheetOrigin = CSSStyleSheetOriginInjected | CSSStyleSheetOriginUserAgent | CSSStyleSheetOriginInspector | CSSStyleSheetOriginRegular
  deriving (Eq CSSStyleSheetOrigin
Eq CSSStyleSheetOrigin
-> (CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Ordering)
-> (CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool)
-> (CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool)
-> (CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool)
-> (CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool)
-> (CSSStyleSheetOrigin
    -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin)
-> (CSSStyleSheetOrigin
    -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin)
-> Ord CSSStyleSheetOrigin
CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Ordering
CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin
$cmin :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin
max :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin
$cmax :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> CSSStyleSheetOrigin
>= :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
$c>= :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
> :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
$c> :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
<= :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
$c<= :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
< :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
$c< :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
compare :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Ordering
$ccompare :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Ordering
$cp1Ord :: Eq CSSStyleSheetOrigin
Ord, CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
(CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool)
-> (CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool)
-> Eq CSSStyleSheetOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
$c/= :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
== :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
$c== :: CSSStyleSheetOrigin -> CSSStyleSheetOrigin -> Bool
Eq, Int -> CSSStyleSheetOrigin -> ShowS
[CSSStyleSheetOrigin] -> ShowS
CSSStyleSheetOrigin -> String
(Int -> CSSStyleSheetOrigin -> ShowS)
-> (CSSStyleSheetOrigin -> String)
-> ([CSSStyleSheetOrigin] -> ShowS)
-> Show CSSStyleSheetOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSStyleSheetOrigin] -> ShowS
$cshowList :: [CSSStyleSheetOrigin] -> ShowS
show :: CSSStyleSheetOrigin -> String
$cshow :: CSSStyleSheetOrigin -> String
showsPrec :: Int -> CSSStyleSheetOrigin -> ShowS
$cshowsPrec :: Int -> CSSStyleSheetOrigin -> ShowS
Show, ReadPrec [CSSStyleSheetOrigin]
ReadPrec CSSStyleSheetOrigin
Int -> ReadS CSSStyleSheetOrigin
ReadS [CSSStyleSheetOrigin]
(Int -> ReadS CSSStyleSheetOrigin)
-> ReadS [CSSStyleSheetOrigin]
-> ReadPrec CSSStyleSheetOrigin
-> ReadPrec [CSSStyleSheetOrigin]
-> Read CSSStyleSheetOrigin
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CSSStyleSheetOrigin]
$creadListPrec :: ReadPrec [CSSStyleSheetOrigin]
readPrec :: ReadPrec CSSStyleSheetOrigin
$creadPrec :: ReadPrec CSSStyleSheetOrigin
readList :: ReadS [CSSStyleSheetOrigin]
$creadList :: ReadS [CSSStyleSheetOrigin]
readsPrec :: Int -> ReadS CSSStyleSheetOrigin
$creadsPrec :: Int -> ReadS CSSStyleSheetOrigin
Read)
instance FromJSON CSSStyleSheetOrigin where
  parseJSON :: Value -> Parser CSSStyleSheetOrigin
parseJSON = String
-> (Text -> Parser CSSStyleSheetOrigin)
-> Value
-> Parser CSSStyleSheetOrigin
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"CSSStyleSheetOrigin" ((Text -> Parser CSSStyleSheetOrigin)
 -> Value -> Parser CSSStyleSheetOrigin)
-> (Text -> Parser CSSStyleSheetOrigin)
-> Value
-> Parser CSSStyleSheetOrigin
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"injected" -> CSSStyleSheetOrigin -> Parser CSSStyleSheetOrigin
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSStyleSheetOrigin
CSSStyleSheetOriginInjected
    Text
"user-agent" -> CSSStyleSheetOrigin -> Parser CSSStyleSheetOrigin
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSStyleSheetOrigin
CSSStyleSheetOriginUserAgent
    Text
"inspector" -> CSSStyleSheetOrigin -> Parser CSSStyleSheetOrigin
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSStyleSheetOrigin
CSSStyleSheetOriginInspector
    Text
"regular" -> CSSStyleSheetOrigin -> Parser CSSStyleSheetOrigin
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSStyleSheetOrigin
CSSStyleSheetOriginRegular
    Text
"_" -> String -> Parser CSSStyleSheetOrigin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse CSSStyleSheetOrigin"
instance ToJSON CSSStyleSheetOrigin where
  toJSON :: CSSStyleSheetOrigin -> Value
toJSON CSSStyleSheetOrigin
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case CSSStyleSheetOrigin
v of
    CSSStyleSheetOrigin
CSSStyleSheetOriginInjected -> Text
"injected"
    CSSStyleSheetOrigin
CSSStyleSheetOriginUserAgent -> Text
"user-agent"
    CSSStyleSheetOrigin
CSSStyleSheetOriginInspector -> Text
"inspector"
    CSSStyleSheetOrigin
CSSStyleSheetOriginRegular -> Text
"regular"

-- | Type 'CSS.PseudoElementMatches'.
--   CSS rule collection for a single pseudo style.
data CSSPseudoElementMatches = CSSPseudoElementMatches
  {
    -- | Pseudo element type.
    CSSPseudoElementMatches -> DOMPseudoType
cSSPseudoElementMatchesPseudoType :: DOMPageNetworkEmulationSecurity.DOMPseudoType,
    -- | Pseudo element custom ident.
    CSSPseudoElementMatches -> Maybe Text
cSSPseudoElementMatchesPseudoIdentifier :: Maybe T.Text,
    -- | Matches of CSS rules applicable to the pseudo style.
    CSSPseudoElementMatches -> [CSSRuleMatch]
cSSPseudoElementMatchesMatches :: [CSSRuleMatch]
  }
  deriving (CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool
(CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool)
-> (CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool)
-> Eq CSSPseudoElementMatches
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool
$c/= :: CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool
== :: CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool
$c== :: CSSPseudoElementMatches -> CSSPseudoElementMatches -> Bool
Eq, Int -> CSSPseudoElementMatches -> ShowS
[CSSPseudoElementMatches] -> ShowS
CSSPseudoElementMatches -> String
(Int -> CSSPseudoElementMatches -> ShowS)
-> (CSSPseudoElementMatches -> String)
-> ([CSSPseudoElementMatches] -> ShowS)
-> Show CSSPseudoElementMatches
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSPseudoElementMatches] -> ShowS
$cshowList :: [CSSPseudoElementMatches] -> ShowS
show :: CSSPseudoElementMatches -> String
$cshow :: CSSPseudoElementMatches -> String
showsPrec :: Int -> CSSPseudoElementMatches -> ShowS
$cshowsPrec :: Int -> CSSPseudoElementMatches -> ShowS
Show)
instance FromJSON CSSPseudoElementMatches where
  parseJSON :: Value -> Parser CSSPseudoElementMatches
parseJSON = String
-> (Object -> Parser CSSPseudoElementMatches)
-> Value
-> Parser CSSPseudoElementMatches
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSPseudoElementMatches" ((Object -> Parser CSSPseudoElementMatches)
 -> Value -> Parser CSSPseudoElementMatches)
-> (Object -> Parser CSSPseudoElementMatches)
-> Value
-> Parser CSSPseudoElementMatches
forall a b. (a -> b) -> a -> b
$ \Object
o -> DOMPseudoType
-> Maybe Text -> [CSSRuleMatch] -> CSSPseudoElementMatches
CSSPseudoElementMatches
    (DOMPseudoType
 -> Maybe Text -> [CSSRuleMatch] -> CSSPseudoElementMatches)
-> Parser DOMPseudoType
-> Parser (Maybe Text -> [CSSRuleMatch] -> CSSPseudoElementMatches)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser DOMPseudoType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"pseudoType"
    Parser (Maybe Text -> [CSSRuleMatch] -> CSSPseudoElementMatches)
-> Parser (Maybe Text)
-> Parser ([CSSRuleMatch] -> CSSPseudoElementMatches)
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
"pseudoIdentifier"
    Parser ([CSSRuleMatch] -> CSSPseudoElementMatches)
-> Parser [CSSRuleMatch] -> Parser CSSPseudoElementMatches
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CSSRuleMatch]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"matches"
instance ToJSON CSSPseudoElementMatches where
  toJSON :: CSSPseudoElementMatches -> Value
toJSON CSSPseudoElementMatches
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
"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
<$> DOMPseudoType -> Maybe DOMPseudoType
forall a. a -> Maybe a
Just (CSSPseudoElementMatches -> DOMPseudoType
cSSPseudoElementMatchesPseudoType CSSPseudoElementMatches
p),
    (Text
"pseudoIdentifier" 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
<$> (CSSPseudoElementMatches -> Maybe Text
cSSPseudoElementMatchesPseudoIdentifier CSSPseudoElementMatches
p),
    (Text
"matches" Text -> [CSSRuleMatch] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSRuleMatch] -> Pair) -> Maybe [CSSRuleMatch] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSRuleMatch] -> Maybe [CSSRuleMatch]
forall a. a -> Maybe a
Just (CSSPseudoElementMatches -> [CSSRuleMatch]
cSSPseudoElementMatchesMatches CSSPseudoElementMatches
p)
    ]

-- | Type 'CSS.InheritedStyleEntry'.
--   Inherited CSS rule collection from ancestor node.
data CSSInheritedStyleEntry = CSSInheritedStyleEntry
  {
    -- | The ancestor node's inline style, if any, in the style inheritance chain.
    CSSInheritedStyleEntry -> Maybe CSSCSSStyle
cSSInheritedStyleEntryInlineStyle :: Maybe CSSCSSStyle,
    -- | Matches of CSS rules matching the ancestor node in the style inheritance chain.
    CSSInheritedStyleEntry -> [CSSRuleMatch]
cSSInheritedStyleEntryMatchedCSSRules :: [CSSRuleMatch]
  }
  deriving (CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool
(CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool)
-> (CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool)
-> Eq CSSInheritedStyleEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool
$c/= :: CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool
== :: CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool
$c== :: CSSInheritedStyleEntry -> CSSInheritedStyleEntry -> Bool
Eq, Int -> CSSInheritedStyleEntry -> ShowS
[CSSInheritedStyleEntry] -> ShowS
CSSInheritedStyleEntry -> String
(Int -> CSSInheritedStyleEntry -> ShowS)
-> (CSSInheritedStyleEntry -> String)
-> ([CSSInheritedStyleEntry] -> ShowS)
-> Show CSSInheritedStyleEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSInheritedStyleEntry] -> ShowS
$cshowList :: [CSSInheritedStyleEntry] -> ShowS
show :: CSSInheritedStyleEntry -> String
$cshow :: CSSInheritedStyleEntry -> String
showsPrec :: Int -> CSSInheritedStyleEntry -> ShowS
$cshowsPrec :: Int -> CSSInheritedStyleEntry -> ShowS
Show)
instance FromJSON CSSInheritedStyleEntry where
  parseJSON :: Value -> Parser CSSInheritedStyleEntry
parseJSON = String
-> (Object -> Parser CSSInheritedStyleEntry)
-> Value
-> Parser CSSInheritedStyleEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSInheritedStyleEntry" ((Object -> Parser CSSInheritedStyleEntry)
 -> Value -> Parser CSSInheritedStyleEntry)
-> (Object -> Parser CSSInheritedStyleEntry)
-> Value
-> Parser CSSInheritedStyleEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe CSSCSSStyle -> [CSSRuleMatch] -> CSSInheritedStyleEntry
CSSInheritedStyleEntry
    (Maybe CSSCSSStyle -> [CSSRuleMatch] -> CSSInheritedStyleEntry)
-> Parser (Maybe CSSCSSStyle)
-> Parser ([CSSRuleMatch] -> CSSInheritedStyleEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe CSSCSSStyle)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inlineStyle"
    Parser ([CSSRuleMatch] -> CSSInheritedStyleEntry)
-> Parser [CSSRuleMatch] -> Parser CSSInheritedStyleEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CSSRuleMatch]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"matchedCSSRules"
instance ToJSON CSSInheritedStyleEntry where
  toJSON :: CSSInheritedStyleEntry -> Value
toJSON CSSInheritedStyleEntry
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
"inlineStyle" Text -> CSSCSSStyle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSCSSStyle -> Pair) -> Maybe CSSCSSStyle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSInheritedStyleEntry -> Maybe CSSCSSStyle
cSSInheritedStyleEntryInlineStyle CSSInheritedStyleEntry
p),
    (Text
"matchedCSSRules" Text -> [CSSRuleMatch] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSRuleMatch] -> Pair) -> Maybe [CSSRuleMatch] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSRuleMatch] -> Maybe [CSSRuleMatch]
forall a. a -> Maybe a
Just (CSSInheritedStyleEntry -> [CSSRuleMatch]
cSSInheritedStyleEntryMatchedCSSRules CSSInheritedStyleEntry
p)
    ]

-- | Type 'CSS.InheritedPseudoElementMatches'.
--   Inherited pseudo element matches from pseudos of an ancestor node.
data CSSInheritedPseudoElementMatches = CSSInheritedPseudoElementMatches
  {
    -- | Matches of pseudo styles from the pseudos of an ancestor node.
    CSSInheritedPseudoElementMatches -> [CSSPseudoElementMatches]
cSSInheritedPseudoElementMatchesPseudoElements :: [CSSPseudoElementMatches]
  }
  deriving (CSSInheritedPseudoElementMatches
-> CSSInheritedPseudoElementMatches -> Bool
(CSSInheritedPseudoElementMatches
 -> CSSInheritedPseudoElementMatches -> Bool)
-> (CSSInheritedPseudoElementMatches
    -> CSSInheritedPseudoElementMatches -> Bool)
-> Eq CSSInheritedPseudoElementMatches
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSInheritedPseudoElementMatches
-> CSSInheritedPseudoElementMatches -> Bool
$c/= :: CSSInheritedPseudoElementMatches
-> CSSInheritedPseudoElementMatches -> Bool
== :: CSSInheritedPseudoElementMatches
-> CSSInheritedPseudoElementMatches -> Bool
$c== :: CSSInheritedPseudoElementMatches
-> CSSInheritedPseudoElementMatches -> Bool
Eq, Int -> CSSInheritedPseudoElementMatches -> ShowS
[CSSInheritedPseudoElementMatches] -> ShowS
CSSInheritedPseudoElementMatches -> String
(Int -> CSSInheritedPseudoElementMatches -> ShowS)
-> (CSSInheritedPseudoElementMatches -> String)
-> ([CSSInheritedPseudoElementMatches] -> ShowS)
-> Show CSSInheritedPseudoElementMatches
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSInheritedPseudoElementMatches] -> ShowS
$cshowList :: [CSSInheritedPseudoElementMatches] -> ShowS
show :: CSSInheritedPseudoElementMatches -> String
$cshow :: CSSInheritedPseudoElementMatches -> String
showsPrec :: Int -> CSSInheritedPseudoElementMatches -> ShowS
$cshowsPrec :: Int -> CSSInheritedPseudoElementMatches -> ShowS
Show)
instance FromJSON CSSInheritedPseudoElementMatches where
  parseJSON :: Value -> Parser CSSInheritedPseudoElementMatches
parseJSON = String
-> (Object -> Parser CSSInheritedPseudoElementMatches)
-> Value
-> Parser CSSInheritedPseudoElementMatches
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSInheritedPseudoElementMatches" ((Object -> Parser CSSInheritedPseudoElementMatches)
 -> Value -> Parser CSSInheritedPseudoElementMatches)
-> (Object -> Parser CSSInheritedPseudoElementMatches)
-> Value
-> Parser CSSInheritedPseudoElementMatches
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSPseudoElementMatches] -> CSSInheritedPseudoElementMatches
CSSInheritedPseudoElementMatches
    ([CSSPseudoElementMatches] -> CSSInheritedPseudoElementMatches)
-> Parser [CSSPseudoElementMatches]
-> Parser CSSInheritedPseudoElementMatches
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSPseudoElementMatches]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"pseudoElements"
instance ToJSON CSSInheritedPseudoElementMatches where
  toJSON :: CSSInheritedPseudoElementMatches -> Value
toJSON CSSInheritedPseudoElementMatches
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
"pseudoElements" Text -> [CSSPseudoElementMatches] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSPseudoElementMatches] -> Pair)
-> Maybe [CSSPseudoElementMatches] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSPseudoElementMatches] -> Maybe [CSSPseudoElementMatches]
forall a. a -> Maybe a
Just (CSSInheritedPseudoElementMatches -> [CSSPseudoElementMatches]
cSSInheritedPseudoElementMatchesPseudoElements CSSInheritedPseudoElementMatches
p)
    ]

-- | Type 'CSS.RuleMatch'.
--   Match data for a CSS rule.
data CSSRuleMatch = CSSRuleMatch
  {
    -- | CSS rule in the match.
    CSSRuleMatch -> CSSCSSRule
cSSRuleMatchRule :: CSSCSSRule,
    -- | Matching selector indices in the rule's selectorList selectors (0-based).
    CSSRuleMatch -> [Int]
cSSRuleMatchMatchingSelectors :: [Int]
  }
  deriving (CSSRuleMatch -> CSSRuleMatch -> Bool
(CSSRuleMatch -> CSSRuleMatch -> Bool)
-> (CSSRuleMatch -> CSSRuleMatch -> Bool) -> Eq CSSRuleMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSRuleMatch -> CSSRuleMatch -> Bool
$c/= :: CSSRuleMatch -> CSSRuleMatch -> Bool
== :: CSSRuleMatch -> CSSRuleMatch -> Bool
$c== :: CSSRuleMatch -> CSSRuleMatch -> Bool
Eq, Int -> CSSRuleMatch -> ShowS
[CSSRuleMatch] -> ShowS
CSSRuleMatch -> String
(Int -> CSSRuleMatch -> ShowS)
-> (CSSRuleMatch -> String)
-> ([CSSRuleMatch] -> ShowS)
-> Show CSSRuleMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSRuleMatch] -> ShowS
$cshowList :: [CSSRuleMatch] -> ShowS
show :: CSSRuleMatch -> String
$cshow :: CSSRuleMatch -> String
showsPrec :: Int -> CSSRuleMatch -> ShowS
$cshowsPrec :: Int -> CSSRuleMatch -> ShowS
Show)
instance FromJSON CSSRuleMatch where
  parseJSON :: Value -> Parser CSSRuleMatch
parseJSON = String
-> (Object -> Parser CSSRuleMatch) -> Value -> Parser CSSRuleMatch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSRuleMatch" ((Object -> Parser CSSRuleMatch) -> Value -> Parser CSSRuleMatch)
-> (Object -> Parser CSSRuleMatch) -> Value -> Parser CSSRuleMatch
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSRule -> [Int] -> CSSRuleMatch
CSSRuleMatch
    (CSSCSSRule -> [Int] -> CSSRuleMatch)
-> Parser CSSCSSRule -> Parser ([Int] -> CSSRuleMatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSRule
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"rule"
    Parser ([Int] -> CSSRuleMatch)
-> Parser [Int] -> Parser CSSRuleMatch
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
"matchingSelectors"
instance ToJSON CSSRuleMatch where
  toJSON :: CSSRuleMatch -> Value
toJSON CSSRuleMatch
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
"rule" Text -> CSSCSSRule -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSCSSRule -> Pair) -> Maybe CSSCSSRule -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSCSSRule -> Maybe CSSCSSRule
forall a. a -> Maybe a
Just (CSSRuleMatch -> CSSCSSRule
cSSRuleMatchRule CSSRuleMatch
p),
    (Text
"matchingSelectors" 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 (CSSRuleMatch -> [Int]
cSSRuleMatchMatchingSelectors CSSRuleMatch
p)
    ]

-- | Type 'CSS.Value'.
--   Data for a simple selector (these are delimited by commas in a selector list).
data CSSValue = CSSValue
  {
    -- | Value text.
    CSSValue -> Text
cSSValueText :: T.Text,
    -- | Value range in the underlying resource (if available).
    CSSValue -> Maybe CSSSourceRange
cSSValueRange :: Maybe CSSSourceRange
  }
  deriving (CSSValue -> CSSValue -> Bool
(CSSValue -> CSSValue -> Bool)
-> (CSSValue -> CSSValue -> Bool) -> Eq CSSValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSValue -> CSSValue -> Bool
$c/= :: CSSValue -> CSSValue -> Bool
== :: CSSValue -> CSSValue -> Bool
$c== :: CSSValue -> CSSValue -> Bool
Eq, Int -> CSSValue -> ShowS
[CSSValue] -> ShowS
CSSValue -> String
(Int -> CSSValue -> ShowS)
-> (CSSValue -> String) -> ([CSSValue] -> ShowS) -> Show CSSValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSValue] -> ShowS
$cshowList :: [CSSValue] -> ShowS
show :: CSSValue -> String
$cshow :: CSSValue -> String
showsPrec :: Int -> CSSValue -> ShowS
$cshowsPrec :: Int -> CSSValue -> ShowS
Show)
instance FromJSON CSSValue where
  parseJSON :: Value -> Parser CSSValue
parseJSON = String -> (Object -> Parser CSSValue) -> Value -> Parser CSSValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSValue" ((Object -> Parser CSSValue) -> Value -> Parser CSSValue)
-> (Object -> Parser CSSValue) -> Value -> Parser CSSValue
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe CSSSourceRange -> CSSValue
CSSValue
    (Text -> Maybe CSSSourceRange -> CSSValue)
-> Parser Text -> Parser (Maybe CSSSourceRange -> CSSValue)
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
"text"
    Parser (Maybe CSSSourceRange -> CSSValue)
-> Parser (Maybe CSSSourceRange) -> Parser CSSValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
instance ToJSON CSSValue where
  toJSON :: CSSValue -> Value
toJSON CSSValue
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
"text" 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 (CSSValue -> Text
cSSValueText CSSValue
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSValue -> Maybe CSSSourceRange
cSSValueRange CSSValue
p)
    ]

-- | Type 'CSS.SelectorList'.
--   Selector list data.
data CSSSelectorList = CSSSelectorList
  {
    -- | Selectors in the list.
    CSSSelectorList -> [CSSValue]
cSSSelectorListSelectors :: [CSSValue],
    -- | Rule selector text.
    CSSSelectorList -> Text
cSSSelectorListText :: T.Text
  }
  deriving (CSSSelectorList -> CSSSelectorList -> Bool
(CSSSelectorList -> CSSSelectorList -> Bool)
-> (CSSSelectorList -> CSSSelectorList -> Bool)
-> Eq CSSSelectorList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSelectorList -> CSSSelectorList -> Bool
$c/= :: CSSSelectorList -> CSSSelectorList -> Bool
== :: CSSSelectorList -> CSSSelectorList -> Bool
$c== :: CSSSelectorList -> CSSSelectorList -> Bool
Eq, Int -> CSSSelectorList -> ShowS
[CSSSelectorList] -> ShowS
CSSSelectorList -> String
(Int -> CSSSelectorList -> ShowS)
-> (CSSSelectorList -> String)
-> ([CSSSelectorList] -> ShowS)
-> Show CSSSelectorList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSelectorList] -> ShowS
$cshowList :: [CSSSelectorList] -> ShowS
show :: CSSSelectorList -> String
$cshow :: CSSSelectorList -> String
showsPrec :: Int -> CSSSelectorList -> ShowS
$cshowsPrec :: Int -> CSSSelectorList -> ShowS
Show)
instance FromJSON CSSSelectorList where
  parseJSON :: Value -> Parser CSSSelectorList
parseJSON = String
-> (Object -> Parser CSSSelectorList)
-> Value
-> Parser CSSSelectorList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSelectorList" ((Object -> Parser CSSSelectorList)
 -> Value -> Parser CSSSelectorList)
-> (Object -> Parser CSSSelectorList)
-> Value
-> Parser CSSSelectorList
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSValue] -> Text -> CSSSelectorList
CSSSelectorList
    ([CSSValue] -> Text -> CSSSelectorList)
-> Parser [CSSValue] -> Parser (Text -> CSSSelectorList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSValue]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"selectors"
    Parser (Text -> CSSSelectorList)
-> Parser Text -> Parser CSSSelectorList
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
"text"
instance ToJSON CSSSelectorList where
  toJSON :: CSSSelectorList -> Value
toJSON CSSSelectorList
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
"selectors" Text -> [CSSValue] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSValue] -> Pair) -> Maybe [CSSValue] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSValue] -> Maybe [CSSValue]
forall a. a -> Maybe a
Just (CSSSelectorList -> [CSSValue]
cSSSelectorListSelectors CSSSelectorList
p),
    (Text
"text" 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 (CSSSelectorList -> Text
cSSSelectorListText CSSSelectorList
p)
    ]

-- | Type 'CSS.CSSStyleSheetHeader'.
--   CSS stylesheet metainformation.
data CSSCSSStyleSheetHeader = CSSCSSStyleSheetHeader
  {
    -- | The stylesheet identifier.
    CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderStyleSheetId :: CSSStyleSheetId,
    -- | Owner frame identifier.
    CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId,
    -- | Stylesheet resource URL. Empty if this is a constructed stylesheet created using
    --   new CSSStyleSheet() (but non-empty if this is a constructed sylesheet imported
    --   as a CSS module script).
    CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderSourceURL :: T.Text,
    -- | URL of source map associated with the stylesheet (if any).
    CSSCSSStyleSheetHeader -> Maybe Text
cSSCSSStyleSheetHeaderSourceMapURL :: Maybe T.Text,
    -- | Stylesheet origin.
    CSSCSSStyleSheetHeader -> CSSStyleSheetOrigin
cSSCSSStyleSheetHeaderOrigin :: CSSStyleSheetOrigin,
    -- | Stylesheet title.
    CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderTitle :: T.Text,
    -- | The backend id for the owner node of the stylesheet.
    CSSCSSStyleSheetHeader -> Maybe Int
cSSCSSStyleSheetHeaderOwnerNode :: Maybe DOMPageNetworkEmulationSecurity.DOMBackendNodeId,
    -- | Denotes whether the stylesheet is disabled.
    CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderDisabled :: Bool,
    -- | Whether the sourceURL field value comes from the sourceURL comment.
    CSSCSSStyleSheetHeader -> Maybe Bool
cSSCSSStyleSheetHeaderHasSourceURL :: Maybe Bool,
    -- | Whether this stylesheet is created for STYLE tag by parser. This flag is not set for
    --   document.written STYLE tags.
    CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderIsInline :: Bool,
    -- | Whether this stylesheet is mutable. Inline stylesheets become mutable
    --   after they have been modified via CSSOM API.
    --   <link> element's stylesheets become mutable only if DevTools modifies them.
    --   Constructed stylesheets (new CSSStyleSheet()) are mutable immediately after creation.
    CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderIsMutable :: Bool,
    -- | True if this stylesheet is created through new CSSStyleSheet() or imported as a
    --   CSS module script.
    CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderIsConstructed :: Bool,
    -- | Line offset of the stylesheet within the resource (zero based).
    CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderStartLine :: Double,
    -- | Column offset of the stylesheet within the resource (zero based).
    CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderStartColumn :: Double,
    -- | Size of the content (in characters).
    CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderLength :: Double,
    -- | Line offset of the end of the stylesheet within the resource (zero based).
    CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderEndLine :: Double,
    -- | Column offset of the end of the stylesheet within the resource (zero based).
    CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderEndColumn :: Double
  }
  deriving (CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool
(CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool)
-> (CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool)
-> Eq CSSCSSStyleSheetHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool
$c/= :: CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool
== :: CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool
$c== :: CSSCSSStyleSheetHeader -> CSSCSSStyleSheetHeader -> Bool
Eq, Int -> CSSCSSStyleSheetHeader -> ShowS
[CSSCSSStyleSheetHeader] -> ShowS
CSSCSSStyleSheetHeader -> String
(Int -> CSSCSSStyleSheetHeader -> ShowS)
-> (CSSCSSStyleSheetHeader -> String)
-> ([CSSCSSStyleSheetHeader] -> ShowS)
-> Show CSSCSSStyleSheetHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSStyleSheetHeader] -> ShowS
$cshowList :: [CSSCSSStyleSheetHeader] -> ShowS
show :: CSSCSSStyleSheetHeader -> String
$cshow :: CSSCSSStyleSheetHeader -> String
showsPrec :: Int -> CSSCSSStyleSheetHeader -> ShowS
$cshowsPrec :: Int -> CSSCSSStyleSheetHeader -> ShowS
Show)
instance FromJSON CSSCSSStyleSheetHeader where
  parseJSON :: Value -> Parser CSSCSSStyleSheetHeader
parseJSON = String
-> (Object -> Parser CSSCSSStyleSheetHeader)
-> Value
-> Parser CSSCSSStyleSheetHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSStyleSheetHeader" ((Object -> Parser CSSCSSStyleSheetHeader)
 -> Value -> Parser CSSCSSStyleSheetHeader)
-> (Object -> Parser CSSCSSStyleSheetHeader)
-> Value
-> Parser CSSCSSStyleSheetHeader
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Maybe Text
-> CSSStyleSheetOrigin
-> Text
-> Maybe Int
-> Bool
-> Maybe Bool
-> Bool
-> Bool
-> Bool
-> Double
-> Double
-> Double
-> Double
-> Double
-> CSSCSSStyleSheetHeader
CSSCSSStyleSheetHeader
    (Text
 -> Text
 -> Text
 -> Maybe Text
 -> CSSStyleSheetOrigin
 -> Text
 -> Maybe Int
 -> Bool
 -> Maybe Bool
 -> Bool
 -> Bool
 -> Bool
 -> Double
 -> Double
 -> Double
 -> Double
 -> Double
 -> CSSCSSStyleSheetHeader)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> CSSStyleSheetOrigin
      -> Text
      -> Maybe Int
      -> Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"styleSheetId"
    Parser
  (Text
   -> Text
   -> Maybe Text
   -> CSSStyleSheetOrigin
   -> Text
   -> Maybe Int
   -> Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> CSSStyleSheetOrigin
      -> Text
      -> Maybe Int
      -> Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"frameId"
    Parser
  (Text
   -> Maybe Text
   -> CSSStyleSheetOrigin
   -> Text
   -> Maybe Int
   -> Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Text
-> Parser
     (Maybe Text
      -> CSSStyleSheetOrigin
      -> Text
      -> Maybe Int
      -> Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"sourceURL"
    Parser
  (Maybe Text
   -> CSSStyleSheetOrigin
   -> Text
   -> Maybe Int
   -> Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser (Maybe Text)
-> Parser
     (CSSStyleSheetOrigin
      -> Text
      -> Maybe Int
      -> Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"sourceMapURL"
    Parser
  (CSSStyleSheetOrigin
   -> Text
   -> Maybe Int
   -> Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser CSSStyleSheetOrigin
-> Parser
     (Text
      -> Maybe Int
      -> Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSStyleSheetOrigin
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"origin"
    Parser
  (Text
   -> Maybe Int
   -> Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Text
-> Parser
     (Maybe Int
      -> Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"title"
    Parser
  (Maybe Int
   -> Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser (Maybe Int)
-> Parser
     (Bool
      -> Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"ownerNode"
    Parser
  (Bool
   -> Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Bool
-> Parser
     (Maybe Bool
      -> Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"disabled"
    Parser
  (Maybe Bool
   -> Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser (Maybe Bool)
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
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
"hasSourceURL"
    Parser
  (Bool
   -> Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isInline"
    Parser
  (Bool
   -> Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Bool
-> Parser
     (Bool
      -> Double
      -> Double
      -> Double
      -> Double
      -> Double
      -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isMutable"
    Parser
  (Bool
   -> Double
   -> Double
   -> Double
   -> Double
   -> Double
   -> CSSCSSStyleSheetHeader)
-> Parser Bool
-> Parser
     (Double
      -> Double -> Double -> Double -> Double -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isConstructed"
    Parser
  (Double
   -> Double -> Double -> Double -> Double -> CSSCSSStyleSheetHeader)
-> Parser Double
-> Parser
     (Double -> Double -> Double -> Double -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"startLine"
    Parser
  (Double -> Double -> Double -> Double -> CSSCSSStyleSheetHeader)
-> Parser Double
-> Parser (Double -> Double -> Double -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"startColumn"
    Parser (Double -> Double -> Double -> CSSCSSStyleSheetHeader)
-> Parser Double
-> Parser (Double -> Double -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"length"
    Parser (Double -> Double -> CSSCSSStyleSheetHeader)
-> Parser Double -> Parser (Double -> CSSCSSStyleSheetHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"endLine"
    Parser (Double -> CSSCSSStyleSheetHeader)
-> Parser Double -> Parser CSSCSSStyleSheetHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"endColumn"
instance ToJSON CSSCSSStyleSheetHeader where
  toJSON :: CSSCSSStyleSheetHeader -> Value
toJSON CSSCSSStyleSheetHeader
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
"styleSheetId" 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 (CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderStyleSheetId CSSCSSStyleSheetHeader
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
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderFrameId CSSCSSStyleSheetHeader
p),
    (Text
"sourceURL" 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 (CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderSourceURL CSSCSSStyleSheetHeader
p),
    (Text
"sourceMapURL" 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
<$> (CSSCSSStyleSheetHeader -> Maybe Text
cSSCSSStyleSheetHeaderSourceMapURL CSSCSSStyleSheetHeader
p),
    (Text
"origin" Text -> CSSStyleSheetOrigin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSStyleSheetOrigin -> Pair)
-> Maybe CSSStyleSheetOrigin -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSStyleSheetOrigin -> Maybe CSSStyleSheetOrigin
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> CSSStyleSheetOrigin
cSSCSSStyleSheetHeaderOrigin CSSCSSStyleSheetHeader
p),
    (Text
"title" 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 (CSSCSSStyleSheetHeader -> Text
cSSCSSStyleSheetHeaderTitle CSSCSSStyleSheetHeader
p),
    (Text
"ownerNode" 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
<$> (CSSCSSStyleSheetHeader -> Maybe Int
cSSCSSStyleSheetHeaderOwnerNode CSSCSSStyleSheetHeader
p),
    (Text
"disabled" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderDisabled CSSCSSStyleSheetHeader
p),
    (Text
"hasSourceURL" 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
<$> (CSSCSSStyleSheetHeader -> Maybe Bool
cSSCSSStyleSheetHeaderHasSourceURL CSSCSSStyleSheetHeader
p),
    (Text
"isInline" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderIsInline CSSCSSStyleSheetHeader
p),
    (Text
"isMutable" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderIsMutable CSSCSSStyleSheetHeader
p),
    (Text
"isConstructed" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Bool
cSSCSSStyleSheetHeaderIsConstructed CSSCSSStyleSheetHeader
p),
    (Text
"startLine" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderStartLine CSSCSSStyleSheetHeader
p),
    (Text
"startColumn" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderStartColumn CSSCSSStyleSheetHeader
p),
    (Text
"length" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderLength CSSCSSStyleSheetHeader
p),
    (Text
"endLine" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderEndLine CSSCSSStyleSheetHeader
p),
    (Text
"endColumn" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSCSSStyleSheetHeader -> Double
cSSCSSStyleSheetHeaderEndColumn CSSCSSStyleSheetHeader
p)
    ]

-- | Type 'CSS.CSSRule'.
--   CSS rule representation.
data CSSCSSRule = CSSCSSRule
  {
    -- | The css style sheet identifier (absent for user agent stylesheet and user-specified
    --   stylesheet rules) this rule came from.
    CSSCSSRule -> Maybe Text
cSSCSSRuleStyleSheetId :: Maybe CSSStyleSheetId,
    -- | Rule selector data.
    CSSCSSRule -> CSSSelectorList
cSSCSSRuleSelectorList :: CSSSelectorList,
    -- | Parent stylesheet's origin.
    CSSCSSRule -> CSSStyleSheetOrigin
cSSCSSRuleOrigin :: CSSStyleSheetOrigin,
    -- | Associated style declaration.
    CSSCSSRule -> CSSCSSStyle
cSSCSSRuleStyle :: CSSCSSStyle,
    -- | Media list array (for rules involving media queries). The array enumerates media queries
    --   starting with the innermost one, going outwards.
    CSSCSSRule -> Maybe [CSSCSSMedia]
cSSCSSRuleMedia :: Maybe [CSSCSSMedia],
    -- | Container query list array (for rules involving container queries).
    --   The array enumerates container queries starting with the innermost one, going outwards.
    CSSCSSRule -> Maybe [CSSCSSContainerQuery]
cSSCSSRuleContainerQueries :: Maybe [CSSCSSContainerQuery],
    -- | @supports CSS at-rule array.
    --   The array enumerates @supports at-rules starting with the innermost one, going outwards.
    CSSCSSRule -> Maybe [CSSCSSSupports]
cSSCSSRuleSupports :: Maybe [CSSCSSSupports],
    -- | Cascade layer array. Contains the layer hierarchy that this rule belongs to starting
    --   with the innermost layer and going outwards.
    CSSCSSRule -> Maybe [CSSCSSLayer]
cSSCSSRuleLayers :: Maybe [CSSCSSLayer],
    -- | @scope CSS at-rule array.
    --   The array enumerates @scope at-rules starting with the innermost one, going outwards.
    CSSCSSRule -> Maybe [CSSCSSScope]
cSSCSSRuleScopes :: Maybe [CSSCSSScope]
  }
  deriving (CSSCSSRule -> CSSCSSRule -> Bool
(CSSCSSRule -> CSSCSSRule -> Bool)
-> (CSSCSSRule -> CSSCSSRule -> Bool) -> Eq CSSCSSRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSRule -> CSSCSSRule -> Bool
$c/= :: CSSCSSRule -> CSSCSSRule -> Bool
== :: CSSCSSRule -> CSSCSSRule -> Bool
$c== :: CSSCSSRule -> CSSCSSRule -> Bool
Eq, Int -> CSSCSSRule -> ShowS
[CSSCSSRule] -> ShowS
CSSCSSRule -> String
(Int -> CSSCSSRule -> ShowS)
-> (CSSCSSRule -> String)
-> ([CSSCSSRule] -> ShowS)
-> Show CSSCSSRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSRule] -> ShowS
$cshowList :: [CSSCSSRule] -> ShowS
show :: CSSCSSRule -> String
$cshow :: CSSCSSRule -> String
showsPrec :: Int -> CSSCSSRule -> ShowS
$cshowsPrec :: Int -> CSSCSSRule -> ShowS
Show)
instance FromJSON CSSCSSRule where
  parseJSON :: Value -> Parser CSSCSSRule
parseJSON = String
-> (Object -> Parser CSSCSSRule) -> Value -> Parser CSSCSSRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSRule" ((Object -> Parser CSSCSSRule) -> Value -> Parser CSSCSSRule)
-> (Object -> Parser CSSCSSRule) -> Value -> Parser CSSCSSRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> CSSSelectorList
-> CSSStyleSheetOrigin
-> CSSCSSStyle
-> Maybe [CSSCSSMedia]
-> Maybe [CSSCSSContainerQuery]
-> Maybe [CSSCSSSupports]
-> Maybe [CSSCSSLayer]
-> Maybe [CSSCSSScope]
-> CSSCSSRule
CSSCSSRule
    (Maybe Text
 -> CSSSelectorList
 -> CSSStyleSheetOrigin
 -> CSSCSSStyle
 -> Maybe [CSSCSSMedia]
 -> Maybe [CSSCSSContainerQuery]
 -> Maybe [CSSCSSSupports]
 -> Maybe [CSSCSSLayer]
 -> Maybe [CSSCSSScope]
 -> CSSCSSRule)
-> Parser (Maybe Text)
-> Parser
     (CSSSelectorList
      -> CSSStyleSheetOrigin
      -> CSSCSSStyle
      -> Maybe [CSSCSSMedia]
      -> Maybe [CSSCSSContainerQuery]
      -> Maybe [CSSCSSSupports]
      -> Maybe [CSSCSSLayer]
      -> Maybe [CSSCSSScope]
      -> CSSCSSRule)
forall (f :: * -> *) a b. Functor 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
"styleSheetId"
    Parser
  (CSSSelectorList
   -> CSSStyleSheetOrigin
   -> CSSCSSStyle
   -> Maybe [CSSCSSMedia]
   -> Maybe [CSSCSSContainerQuery]
   -> Maybe [CSSCSSSupports]
   -> Maybe [CSSCSSLayer]
   -> Maybe [CSSCSSScope]
   -> CSSCSSRule)
-> Parser CSSSelectorList
-> Parser
     (CSSStyleSheetOrigin
      -> CSSCSSStyle
      -> Maybe [CSSCSSMedia]
      -> Maybe [CSSCSSContainerQuery]
      -> Maybe [CSSCSSSupports]
      -> Maybe [CSSCSSLayer]
      -> Maybe [CSSCSSScope]
      -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSSelectorList
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"selectorList"
    Parser
  (CSSStyleSheetOrigin
   -> CSSCSSStyle
   -> Maybe [CSSCSSMedia]
   -> Maybe [CSSCSSContainerQuery]
   -> Maybe [CSSCSSSupports]
   -> Maybe [CSSCSSLayer]
   -> Maybe [CSSCSSScope]
   -> CSSCSSRule)
-> Parser CSSStyleSheetOrigin
-> Parser
     (CSSCSSStyle
      -> Maybe [CSSCSSMedia]
      -> Maybe [CSSCSSContainerQuery]
      -> Maybe [CSSCSSSupports]
      -> Maybe [CSSCSSLayer]
      -> Maybe [CSSCSSScope]
      -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSStyleSheetOrigin
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"origin"
    Parser
  (CSSCSSStyle
   -> Maybe [CSSCSSMedia]
   -> Maybe [CSSCSSContainerQuery]
   -> Maybe [CSSCSSSupports]
   -> Maybe [CSSCSSLayer]
   -> Maybe [CSSCSSScope]
   -> CSSCSSRule)
-> Parser CSSCSSStyle
-> Parser
     (Maybe [CSSCSSMedia]
      -> Maybe [CSSCSSContainerQuery]
      -> Maybe [CSSCSSSupports]
      -> Maybe [CSSCSSLayer]
      -> Maybe [CSSCSSScope]
      -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSCSSStyle
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"style"
    Parser
  (Maybe [CSSCSSMedia]
   -> Maybe [CSSCSSContainerQuery]
   -> Maybe [CSSCSSSupports]
   -> Maybe [CSSCSSLayer]
   -> Maybe [CSSCSSScope]
   -> CSSCSSRule)
-> Parser (Maybe [CSSCSSMedia])
-> Parser
     (Maybe [CSSCSSContainerQuery]
      -> Maybe [CSSCSSSupports]
      -> Maybe [CSSCSSLayer]
      -> Maybe [CSSCSSScope]
      -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSMedia])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"media"
    Parser
  (Maybe [CSSCSSContainerQuery]
   -> Maybe [CSSCSSSupports]
   -> Maybe [CSSCSSLayer]
   -> Maybe [CSSCSSScope]
   -> CSSCSSRule)
-> Parser (Maybe [CSSCSSContainerQuery])
-> Parser
     (Maybe [CSSCSSSupports]
      -> Maybe [CSSCSSLayer] -> Maybe [CSSCSSScope] -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSContainerQuery])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"containerQueries"
    Parser
  (Maybe [CSSCSSSupports]
   -> Maybe [CSSCSSLayer] -> Maybe [CSSCSSScope] -> CSSCSSRule)
-> Parser (Maybe [CSSCSSSupports])
-> Parser
     (Maybe [CSSCSSLayer] -> Maybe [CSSCSSScope] -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSSupports])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"supports"
    Parser (Maybe [CSSCSSLayer] -> Maybe [CSSCSSScope] -> CSSCSSRule)
-> Parser (Maybe [CSSCSSLayer])
-> Parser (Maybe [CSSCSSScope] -> CSSCSSRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSLayer])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"layers"
    Parser (Maybe [CSSCSSScope] -> CSSCSSRule)
-> Parser (Maybe [CSSCSSScope]) -> Parser CSSCSSRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSScope])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scopes"
instance ToJSON CSSCSSRule where
  toJSON :: CSSCSSRule -> Value
toJSON CSSCSSRule
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
"styleSheetId" 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
<$> (CSSCSSRule -> Maybe Text
cSSCSSRuleStyleSheetId CSSCSSRule
p),
    (Text
"selectorList" Text -> CSSSelectorList -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSelectorList -> Pair) -> Maybe CSSSelectorList -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSelectorList -> Maybe CSSSelectorList
forall a. a -> Maybe a
Just (CSSCSSRule -> CSSSelectorList
cSSCSSRuleSelectorList CSSCSSRule
p),
    (Text
"origin" Text -> CSSStyleSheetOrigin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSStyleSheetOrigin -> Pair)
-> Maybe CSSStyleSheetOrigin -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSStyleSheetOrigin -> Maybe CSSStyleSheetOrigin
forall a. a -> Maybe a
Just (CSSCSSRule -> CSSStyleSheetOrigin
cSSCSSRuleOrigin CSSCSSRule
p),
    (Text
"style" Text -> CSSCSSStyle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSCSSStyle -> Pair) -> Maybe CSSCSSStyle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSCSSStyle -> Maybe CSSCSSStyle
forall a. a -> Maybe a
Just (CSSCSSRule -> CSSCSSStyle
cSSCSSRuleStyle CSSCSSRule
p),
    (Text
"media" Text -> [CSSCSSMedia] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSMedia] -> Pair) -> Maybe [CSSCSSMedia] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSRule -> Maybe [CSSCSSMedia]
cSSCSSRuleMedia CSSCSSRule
p),
    (Text
"containerQueries" Text -> [CSSCSSContainerQuery] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSContainerQuery] -> Pair)
-> Maybe [CSSCSSContainerQuery] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSRule -> Maybe [CSSCSSContainerQuery]
cSSCSSRuleContainerQueries CSSCSSRule
p),
    (Text
"supports" Text -> [CSSCSSSupports] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSSupports] -> Pair) -> Maybe [CSSCSSSupports] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSRule -> Maybe [CSSCSSSupports]
cSSCSSRuleSupports CSSCSSRule
p),
    (Text
"layers" Text -> [CSSCSSLayer] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSLayer] -> Pair) -> Maybe [CSSCSSLayer] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSRule -> Maybe [CSSCSSLayer]
cSSCSSRuleLayers CSSCSSRule
p),
    (Text
"scopes" Text -> [CSSCSSScope] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSScope] -> Pair) -> Maybe [CSSCSSScope] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSRule -> Maybe [CSSCSSScope]
cSSCSSRuleScopes CSSCSSRule
p)
    ]

-- | Type 'CSS.RuleUsage'.
--   CSS coverage information.
data CSSRuleUsage = CSSRuleUsage
  {
    -- | The css style sheet identifier (absent for user agent stylesheet and user-specified
    --   stylesheet rules) this rule came from.
    CSSRuleUsage -> Text
cSSRuleUsageStyleSheetId :: CSSStyleSheetId,
    -- | Offset of the start of the rule (including selector) from the beginning of the stylesheet.
    CSSRuleUsage -> Double
cSSRuleUsageStartOffset :: Double,
    -- | Offset of the end of the rule body from the beginning of the stylesheet.
    CSSRuleUsage -> Double
cSSRuleUsageEndOffset :: Double,
    -- | Indicates whether the rule was actually used by some element in the page.
    CSSRuleUsage -> Bool
cSSRuleUsageUsed :: Bool
  }
  deriving (CSSRuleUsage -> CSSRuleUsage -> Bool
(CSSRuleUsage -> CSSRuleUsage -> Bool)
-> (CSSRuleUsage -> CSSRuleUsage -> Bool) -> Eq CSSRuleUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSRuleUsage -> CSSRuleUsage -> Bool
$c/= :: CSSRuleUsage -> CSSRuleUsage -> Bool
== :: CSSRuleUsage -> CSSRuleUsage -> Bool
$c== :: CSSRuleUsage -> CSSRuleUsage -> Bool
Eq, Int -> CSSRuleUsage -> ShowS
[CSSRuleUsage] -> ShowS
CSSRuleUsage -> String
(Int -> CSSRuleUsage -> ShowS)
-> (CSSRuleUsage -> String)
-> ([CSSRuleUsage] -> ShowS)
-> Show CSSRuleUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSRuleUsage] -> ShowS
$cshowList :: [CSSRuleUsage] -> ShowS
show :: CSSRuleUsage -> String
$cshow :: CSSRuleUsage -> String
showsPrec :: Int -> CSSRuleUsage -> ShowS
$cshowsPrec :: Int -> CSSRuleUsage -> ShowS
Show)
instance FromJSON CSSRuleUsage where
  parseJSON :: Value -> Parser CSSRuleUsage
parseJSON = String
-> (Object -> Parser CSSRuleUsage) -> Value -> Parser CSSRuleUsage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSRuleUsage" ((Object -> Parser CSSRuleUsage) -> Value -> Parser CSSRuleUsage)
-> (Object -> Parser CSSRuleUsage) -> Value -> Parser CSSRuleUsage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Double -> Double -> Bool -> CSSRuleUsage
CSSRuleUsage
    (Text -> Double -> Double -> Bool -> CSSRuleUsage)
-> Parser Text -> Parser (Double -> Double -> Bool -> CSSRuleUsage)
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
"styleSheetId"
    Parser (Double -> Double -> Bool -> CSSRuleUsage)
-> Parser Double -> Parser (Double -> Bool -> CSSRuleUsage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"startOffset"
    Parser (Double -> Bool -> CSSRuleUsage)
-> Parser Double -> Parser (Bool -> CSSRuleUsage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"endOffset"
    Parser (Bool -> CSSRuleUsage) -> Parser Bool -> Parser CSSRuleUsage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"used"
instance ToJSON CSSRuleUsage where
  toJSON :: CSSRuleUsage -> Value
toJSON CSSRuleUsage
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
"styleSheetId" 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 (CSSRuleUsage -> Text
cSSRuleUsageStyleSheetId CSSRuleUsage
p),
    (Text
"startOffset" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSRuleUsage -> Double
cSSRuleUsageStartOffset CSSRuleUsage
p),
    (Text
"endOffset" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSRuleUsage -> Double
cSSRuleUsageEndOffset CSSRuleUsage
p),
    (Text
"used" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSRuleUsage -> Bool
cSSRuleUsageUsed CSSRuleUsage
p)
    ]

-- | Type 'CSS.SourceRange'.
--   Text range within a resource. All numbers are zero-based.
data CSSSourceRange = CSSSourceRange
  {
    -- | Start line of range.
    CSSSourceRange -> Int
cSSSourceRangeStartLine :: Int,
    -- | Start column of range (inclusive).
    CSSSourceRange -> Int
cSSSourceRangeStartColumn :: Int,
    -- | End line of range
    CSSSourceRange -> Int
cSSSourceRangeEndLine :: Int,
    -- | End column of range (exclusive).
    CSSSourceRange -> Int
cSSSourceRangeEndColumn :: Int
  }
  deriving (CSSSourceRange -> CSSSourceRange -> Bool
(CSSSourceRange -> CSSSourceRange -> Bool)
-> (CSSSourceRange -> CSSSourceRange -> Bool) -> Eq CSSSourceRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSourceRange -> CSSSourceRange -> Bool
$c/= :: CSSSourceRange -> CSSSourceRange -> Bool
== :: CSSSourceRange -> CSSSourceRange -> Bool
$c== :: CSSSourceRange -> CSSSourceRange -> Bool
Eq, Int -> CSSSourceRange -> ShowS
[CSSSourceRange] -> ShowS
CSSSourceRange -> String
(Int -> CSSSourceRange -> ShowS)
-> (CSSSourceRange -> String)
-> ([CSSSourceRange] -> ShowS)
-> Show CSSSourceRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSourceRange] -> ShowS
$cshowList :: [CSSSourceRange] -> ShowS
show :: CSSSourceRange -> String
$cshow :: CSSSourceRange -> String
showsPrec :: Int -> CSSSourceRange -> ShowS
$cshowsPrec :: Int -> CSSSourceRange -> ShowS
Show)
instance FromJSON CSSSourceRange where
  parseJSON :: Value -> Parser CSSSourceRange
parseJSON = String
-> (Object -> Parser CSSSourceRange)
-> Value
-> Parser CSSSourceRange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSourceRange" ((Object -> Parser CSSSourceRange)
 -> Value -> Parser CSSSourceRange)
-> (Object -> Parser CSSSourceRange)
-> Value
-> Parser CSSSourceRange
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> Int -> Int -> CSSSourceRange
CSSSourceRange
    (Int -> Int -> Int -> Int -> CSSSourceRange)
-> Parser Int -> Parser (Int -> Int -> Int -> CSSSourceRange)
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
"startLine"
    Parser (Int -> Int -> Int -> CSSSourceRange)
-> Parser Int -> Parser (Int -> Int -> CSSSourceRange)
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
"startColumn"
    Parser (Int -> Int -> CSSSourceRange)
-> Parser Int -> Parser (Int -> CSSSourceRange)
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
"endLine"
    Parser (Int -> CSSSourceRange)
-> Parser Int -> Parser CSSSourceRange
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
"endColumn"
instance ToJSON CSSSourceRange where
  toJSON :: CSSSourceRange -> Value
toJSON CSSSourceRange
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
"startLine" 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 (CSSSourceRange -> Int
cSSSourceRangeStartLine CSSSourceRange
p),
    (Text
"startColumn" 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 (CSSSourceRange -> Int
cSSSourceRangeStartColumn CSSSourceRange
p),
    (Text
"endLine" 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 (CSSSourceRange -> Int
cSSSourceRangeEndLine CSSSourceRange
p),
    (Text
"endColumn" 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 (CSSSourceRange -> Int
cSSSourceRangeEndColumn CSSSourceRange
p)
    ]

-- | Type 'CSS.ShorthandEntry'.
data CSSShorthandEntry = CSSShorthandEntry
  {
    -- | Shorthand name.
    CSSShorthandEntry -> Text
cSSShorthandEntryName :: T.Text,
    -- | Shorthand value.
    CSSShorthandEntry -> Text
cSSShorthandEntryValue :: T.Text,
    -- | Whether the property has "!important" annotation (implies `false` if absent).
    CSSShorthandEntry -> Maybe Bool
cSSShorthandEntryImportant :: Maybe Bool
  }
  deriving (CSSShorthandEntry -> CSSShorthandEntry -> Bool
(CSSShorthandEntry -> CSSShorthandEntry -> Bool)
-> (CSSShorthandEntry -> CSSShorthandEntry -> Bool)
-> Eq CSSShorthandEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSShorthandEntry -> CSSShorthandEntry -> Bool
$c/= :: CSSShorthandEntry -> CSSShorthandEntry -> Bool
== :: CSSShorthandEntry -> CSSShorthandEntry -> Bool
$c== :: CSSShorthandEntry -> CSSShorthandEntry -> Bool
Eq, Int -> CSSShorthandEntry -> ShowS
[CSSShorthandEntry] -> ShowS
CSSShorthandEntry -> String
(Int -> CSSShorthandEntry -> ShowS)
-> (CSSShorthandEntry -> String)
-> ([CSSShorthandEntry] -> ShowS)
-> Show CSSShorthandEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSShorthandEntry] -> ShowS
$cshowList :: [CSSShorthandEntry] -> ShowS
show :: CSSShorthandEntry -> String
$cshow :: CSSShorthandEntry -> String
showsPrec :: Int -> CSSShorthandEntry -> ShowS
$cshowsPrec :: Int -> CSSShorthandEntry -> ShowS
Show)
instance FromJSON CSSShorthandEntry where
  parseJSON :: Value -> Parser CSSShorthandEntry
parseJSON = String
-> (Object -> Parser CSSShorthandEntry)
-> Value
-> Parser CSSShorthandEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSShorthandEntry" ((Object -> Parser CSSShorthandEntry)
 -> Value -> Parser CSSShorthandEntry)
-> (Object -> Parser CSSShorthandEntry)
-> Value
-> Parser CSSShorthandEntry
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Maybe Bool -> CSSShorthandEntry
CSSShorthandEntry
    (Text -> Text -> Maybe Bool -> CSSShorthandEntry)
-> Parser Text -> Parser (Text -> Maybe Bool -> CSSShorthandEntry)
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 -> Maybe Bool -> CSSShorthandEntry)
-> Parser Text -> Parser (Maybe Bool -> CSSShorthandEntry)
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"
    Parser (Maybe Bool -> CSSShorthandEntry)
-> Parser (Maybe Bool) -> Parser CSSShorthandEntry
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
"important"
instance ToJSON CSSShorthandEntry where
  toJSON :: CSSShorthandEntry -> Value
toJSON CSSShorthandEntry
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 (CSSShorthandEntry -> Text
cSSShorthandEntryName CSSShorthandEntry
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 (CSSShorthandEntry -> Text
cSSShorthandEntryValue CSSShorthandEntry
p),
    (Text
"important" 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
<$> (CSSShorthandEntry -> Maybe Bool
cSSShorthandEntryImportant CSSShorthandEntry
p)
    ]

-- | Type 'CSS.CSSComputedStyleProperty'.
data CSSCSSComputedStyleProperty = CSSCSSComputedStyleProperty
  {
    -- | Computed style property name.
    CSSCSSComputedStyleProperty -> Text
cSSCSSComputedStylePropertyName :: T.Text,
    -- | Computed style property value.
    CSSCSSComputedStyleProperty -> Text
cSSCSSComputedStylePropertyValue :: T.Text
  }
  deriving (CSSCSSComputedStyleProperty -> CSSCSSComputedStyleProperty -> Bool
(CSSCSSComputedStyleProperty
 -> CSSCSSComputedStyleProperty -> Bool)
-> (CSSCSSComputedStyleProperty
    -> CSSCSSComputedStyleProperty -> Bool)
-> Eq CSSCSSComputedStyleProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSComputedStyleProperty -> CSSCSSComputedStyleProperty -> Bool
$c/= :: CSSCSSComputedStyleProperty -> CSSCSSComputedStyleProperty -> Bool
== :: CSSCSSComputedStyleProperty -> CSSCSSComputedStyleProperty -> Bool
$c== :: CSSCSSComputedStyleProperty -> CSSCSSComputedStyleProperty -> Bool
Eq, Int -> CSSCSSComputedStyleProperty -> ShowS
[CSSCSSComputedStyleProperty] -> ShowS
CSSCSSComputedStyleProperty -> String
(Int -> CSSCSSComputedStyleProperty -> ShowS)
-> (CSSCSSComputedStyleProperty -> String)
-> ([CSSCSSComputedStyleProperty] -> ShowS)
-> Show CSSCSSComputedStyleProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSComputedStyleProperty] -> ShowS
$cshowList :: [CSSCSSComputedStyleProperty] -> ShowS
show :: CSSCSSComputedStyleProperty -> String
$cshow :: CSSCSSComputedStyleProperty -> String
showsPrec :: Int -> CSSCSSComputedStyleProperty -> ShowS
$cshowsPrec :: Int -> CSSCSSComputedStyleProperty -> ShowS
Show)
instance FromJSON CSSCSSComputedStyleProperty where
  parseJSON :: Value -> Parser CSSCSSComputedStyleProperty
parseJSON = String
-> (Object -> Parser CSSCSSComputedStyleProperty)
-> Value
-> Parser CSSCSSComputedStyleProperty
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSComputedStyleProperty" ((Object -> Parser CSSCSSComputedStyleProperty)
 -> Value -> Parser CSSCSSComputedStyleProperty)
-> (Object -> Parser CSSCSSComputedStyleProperty)
-> Value
-> Parser CSSCSSComputedStyleProperty
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> CSSCSSComputedStyleProperty
CSSCSSComputedStyleProperty
    (Text -> Text -> CSSCSSComputedStyleProperty)
-> Parser Text -> Parser (Text -> CSSCSSComputedStyleProperty)
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 -> CSSCSSComputedStyleProperty)
-> Parser Text -> Parser CSSCSSComputedStyleProperty
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 CSSCSSComputedStyleProperty where
  toJSON :: CSSCSSComputedStyleProperty -> Value
toJSON CSSCSSComputedStyleProperty
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 (CSSCSSComputedStyleProperty -> Text
cSSCSSComputedStylePropertyName CSSCSSComputedStyleProperty
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 (CSSCSSComputedStyleProperty -> Text
cSSCSSComputedStylePropertyValue CSSCSSComputedStyleProperty
p)
    ]

-- | Type 'CSS.CSSStyle'.
--   CSS style representation.
data CSSCSSStyle = CSSCSSStyle
  {
    -- | The css style sheet identifier (absent for user agent stylesheet and user-specified
    --   stylesheet rules) this rule came from.
    CSSCSSStyle -> Maybe Text
cSSCSSStyleStyleSheetId :: Maybe CSSStyleSheetId,
    -- | CSS properties in the style.
    CSSCSSStyle -> [CSSCSSProperty]
cSSCSSStyleCssProperties :: [CSSCSSProperty],
    -- | Computed values for all shorthands found in the style.
    CSSCSSStyle -> [CSSShorthandEntry]
cSSCSSStyleShorthandEntries :: [CSSShorthandEntry],
    -- | Style declaration text (if available).
    CSSCSSStyle -> Maybe Text
cSSCSSStyleCssText :: Maybe T.Text,
    -- | Style declaration range in the enclosing stylesheet (if available).
    CSSCSSStyle -> Maybe CSSSourceRange
cSSCSSStyleRange :: Maybe CSSSourceRange
  }
  deriving (CSSCSSStyle -> CSSCSSStyle -> Bool
(CSSCSSStyle -> CSSCSSStyle -> Bool)
-> (CSSCSSStyle -> CSSCSSStyle -> Bool) -> Eq CSSCSSStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSStyle -> CSSCSSStyle -> Bool
$c/= :: CSSCSSStyle -> CSSCSSStyle -> Bool
== :: CSSCSSStyle -> CSSCSSStyle -> Bool
$c== :: CSSCSSStyle -> CSSCSSStyle -> Bool
Eq, Int -> CSSCSSStyle -> ShowS
[CSSCSSStyle] -> ShowS
CSSCSSStyle -> String
(Int -> CSSCSSStyle -> ShowS)
-> (CSSCSSStyle -> String)
-> ([CSSCSSStyle] -> ShowS)
-> Show CSSCSSStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSStyle] -> ShowS
$cshowList :: [CSSCSSStyle] -> ShowS
show :: CSSCSSStyle -> String
$cshow :: CSSCSSStyle -> String
showsPrec :: Int -> CSSCSSStyle -> ShowS
$cshowsPrec :: Int -> CSSCSSStyle -> ShowS
Show)
instance FromJSON CSSCSSStyle where
  parseJSON :: Value -> Parser CSSCSSStyle
parseJSON = String
-> (Object -> Parser CSSCSSStyle) -> Value -> Parser CSSCSSStyle
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSStyle" ((Object -> Parser CSSCSSStyle) -> Value -> Parser CSSCSSStyle)
-> (Object -> Parser CSSCSSStyle) -> Value -> Parser CSSCSSStyle
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> [CSSCSSProperty]
-> [CSSShorthandEntry]
-> Maybe Text
-> Maybe CSSSourceRange
-> CSSCSSStyle
CSSCSSStyle
    (Maybe Text
 -> [CSSCSSProperty]
 -> [CSSShorthandEntry]
 -> Maybe Text
 -> Maybe CSSSourceRange
 -> CSSCSSStyle)
-> Parser (Maybe Text)
-> Parser
     ([CSSCSSProperty]
      -> [CSSShorthandEntry]
      -> Maybe Text
      -> Maybe CSSSourceRange
      -> CSSCSSStyle)
forall (f :: * -> *) a b. Functor 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
"styleSheetId"
    Parser
  ([CSSCSSProperty]
   -> [CSSShorthandEntry]
   -> Maybe Text
   -> Maybe CSSSourceRange
   -> CSSCSSStyle)
-> Parser [CSSCSSProperty]
-> Parser
     ([CSSShorthandEntry]
      -> Maybe Text -> Maybe CSSSourceRange -> CSSCSSStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CSSCSSProperty]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"cssProperties"
    Parser
  ([CSSShorthandEntry]
   -> Maybe Text -> Maybe CSSSourceRange -> CSSCSSStyle)
-> Parser [CSSShorthandEntry]
-> Parser (Maybe Text -> Maybe CSSSourceRange -> CSSCSSStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CSSShorthandEntry]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"shorthandEntries"
    Parser (Maybe Text -> Maybe CSSSourceRange -> CSSCSSStyle)
-> Parser (Maybe Text)
-> Parser (Maybe CSSSourceRange -> CSSCSSStyle)
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
"cssText"
    Parser (Maybe CSSSourceRange -> CSSCSSStyle)
-> Parser (Maybe CSSSourceRange) -> Parser CSSCSSStyle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
instance ToJSON CSSCSSStyle where
  toJSON :: CSSCSSStyle -> Value
toJSON CSSCSSStyle
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
"styleSheetId" 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
<$> (CSSCSSStyle -> Maybe Text
cSSCSSStyleStyleSheetId CSSCSSStyle
p),
    (Text
"cssProperties" Text -> [CSSCSSProperty] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSProperty] -> Pair) -> Maybe [CSSCSSProperty] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSCSSProperty] -> Maybe [CSSCSSProperty]
forall a. a -> Maybe a
Just (CSSCSSStyle -> [CSSCSSProperty]
cSSCSSStyleCssProperties CSSCSSStyle
p),
    (Text
"shorthandEntries" Text -> [CSSShorthandEntry] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSShorthandEntry] -> Pair)
-> Maybe [CSSShorthandEntry] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSShorthandEntry] -> Maybe [CSSShorthandEntry]
forall a. a -> Maybe a
Just (CSSCSSStyle -> [CSSShorthandEntry]
cSSCSSStyleShorthandEntries CSSCSSStyle
p),
    (Text
"cssText" 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
<$> (CSSCSSStyle -> Maybe Text
cSSCSSStyleCssText CSSCSSStyle
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSStyle -> Maybe CSSSourceRange
cSSCSSStyleRange CSSCSSStyle
p)
    ]

-- | Type 'CSS.CSSProperty'.
--   CSS property declaration data.
data CSSCSSProperty = CSSCSSProperty
  {
    -- | The property name.
    CSSCSSProperty -> Text
cSSCSSPropertyName :: T.Text,
    -- | The property value.
    CSSCSSProperty -> Text
cSSCSSPropertyValue :: T.Text,
    -- | Whether the property has "!important" annotation (implies `false` if absent).
    CSSCSSProperty -> Maybe Bool
cSSCSSPropertyImportant :: Maybe Bool,
    -- | Whether the property is implicit (implies `false` if absent).
    CSSCSSProperty -> Maybe Bool
cSSCSSPropertyImplicit :: Maybe Bool,
    -- | The full property text as specified in the style.
    CSSCSSProperty -> Maybe Text
cSSCSSPropertyText :: Maybe T.Text,
    -- | Whether the property is understood by the browser (implies `true` if absent).
    CSSCSSProperty -> Maybe Bool
cSSCSSPropertyParsedOk :: Maybe Bool,
    -- | Whether the property is disabled by the user (present for source-based properties only).
    CSSCSSProperty -> Maybe Bool
cSSCSSPropertyDisabled :: Maybe Bool,
    -- | The entire property range in the enclosing style declaration (if available).
    CSSCSSProperty -> Maybe CSSSourceRange
cSSCSSPropertyRange :: Maybe CSSSourceRange,
    -- | Parsed longhand components of this property if it is a shorthand.
    --   This field will be empty if the given property is not a shorthand.
    CSSCSSProperty -> Maybe [CSSCSSProperty]
cSSCSSPropertyLonghandProperties :: Maybe [CSSCSSProperty]
  }
  deriving (CSSCSSProperty -> CSSCSSProperty -> Bool
(CSSCSSProperty -> CSSCSSProperty -> Bool)
-> (CSSCSSProperty -> CSSCSSProperty -> Bool) -> Eq CSSCSSProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSProperty -> CSSCSSProperty -> Bool
$c/= :: CSSCSSProperty -> CSSCSSProperty -> Bool
== :: CSSCSSProperty -> CSSCSSProperty -> Bool
$c== :: CSSCSSProperty -> CSSCSSProperty -> Bool
Eq, Int -> CSSCSSProperty -> ShowS
[CSSCSSProperty] -> ShowS
CSSCSSProperty -> String
(Int -> CSSCSSProperty -> ShowS)
-> (CSSCSSProperty -> String)
-> ([CSSCSSProperty] -> ShowS)
-> Show CSSCSSProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSProperty] -> ShowS
$cshowList :: [CSSCSSProperty] -> ShowS
show :: CSSCSSProperty -> String
$cshow :: CSSCSSProperty -> String
showsPrec :: Int -> CSSCSSProperty -> ShowS
$cshowsPrec :: Int -> CSSCSSProperty -> ShowS
Show)
instance FromJSON CSSCSSProperty where
  parseJSON :: Value -> Parser CSSCSSProperty
parseJSON = String
-> (Object -> Parser CSSCSSProperty)
-> Value
-> Parser CSSCSSProperty
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSProperty" ((Object -> Parser CSSCSSProperty)
 -> Value -> Parser CSSCSSProperty)
-> (Object -> Parser CSSCSSProperty)
-> Value
-> Parser CSSCSSProperty
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe CSSSourceRange
-> Maybe [CSSCSSProperty]
-> CSSCSSProperty
CSSCSSProperty
    (Text
 -> Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe CSSSourceRange
 -> Maybe [CSSCSSProperty]
 -> CSSCSSProperty)
-> Parser Text
-> Parser
     (Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe CSSSourceRange
      -> Maybe [CSSCSSProperty]
      -> CSSCSSProperty)
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
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe CSSSourceRange
   -> Maybe [CSSCSSProperty]
   -> CSSCSSProperty)
-> Parser Text
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe CSSSourceRange
      -> Maybe [CSSCSSProperty]
      -> CSSCSSProperty)
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"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe CSSSourceRange
   -> Maybe [CSSCSSProperty]
   -> CSSCSSProperty)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe CSSSourceRange
      -> Maybe [CSSCSSProperty]
      -> CSSCSSProperty)
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
"important"
    Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe CSSSourceRange
   -> Maybe [CSSCSSProperty]
   -> CSSCSSProperty)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe CSSSourceRange
      -> Maybe [CSSCSSProperty]
      -> CSSCSSProperty)
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
"implicit"
    Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe CSSSourceRange
   -> Maybe [CSSCSSProperty]
   -> CSSCSSProperty)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe CSSSourceRange
      -> Maybe [CSSCSSProperty]
      -> CSSCSSProperty)
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
"text"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe CSSSourceRange
   -> Maybe [CSSCSSProperty]
   -> CSSCSSProperty)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe CSSSourceRange
      -> Maybe [CSSCSSProperty]
      -> CSSCSSProperty)
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
"parsedOk"
    Parser
  (Maybe Bool
   -> Maybe CSSSourceRange
   -> Maybe [CSSCSSProperty]
   -> CSSCSSProperty)
-> Parser (Maybe Bool)
-> Parser
     (Maybe CSSSourceRange -> Maybe [CSSCSSProperty] -> CSSCSSProperty)
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
"disabled"
    Parser
  (Maybe CSSSourceRange -> Maybe [CSSCSSProperty] -> CSSCSSProperty)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe [CSSCSSProperty] -> CSSCSSProperty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
    Parser (Maybe [CSSCSSProperty] -> CSSCSSProperty)
-> Parser (Maybe [CSSCSSProperty]) -> Parser CSSCSSProperty
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSProperty])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"longhandProperties"
instance ToJSON CSSCSSProperty where
  toJSON :: CSSCSSProperty -> Value
toJSON CSSCSSProperty
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 (CSSCSSProperty -> Text
cSSCSSPropertyName CSSCSSProperty
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 (CSSCSSProperty -> Text
cSSCSSPropertyValue CSSCSSProperty
p),
    (Text
"important" 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
<$> (CSSCSSProperty -> Maybe Bool
cSSCSSPropertyImportant CSSCSSProperty
p),
    (Text
"implicit" 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
<$> (CSSCSSProperty -> Maybe Bool
cSSCSSPropertyImplicit CSSCSSProperty
p),
    (Text
"text" 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
<$> (CSSCSSProperty -> Maybe Text
cSSCSSPropertyText CSSCSSProperty
p),
    (Text
"parsedOk" 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
<$> (CSSCSSProperty -> Maybe Bool
cSSCSSPropertyParsedOk CSSCSSProperty
p),
    (Text
"disabled" 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
<$> (CSSCSSProperty -> Maybe Bool
cSSCSSPropertyDisabled CSSCSSProperty
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSProperty -> Maybe CSSSourceRange
cSSCSSPropertyRange CSSCSSProperty
p),
    (Text
"longhandProperties" Text -> [CSSCSSProperty] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSProperty] -> Pair) -> Maybe [CSSCSSProperty] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSProperty -> Maybe [CSSCSSProperty]
cSSCSSPropertyLonghandProperties CSSCSSProperty
p)
    ]

-- | Type 'CSS.CSSMedia'.
--   CSS media rule descriptor.
data CSSCSSMediaSource = CSSCSSMediaSourceMediaRule | CSSCSSMediaSourceImportRule | CSSCSSMediaSourceLinkedSheet | CSSCSSMediaSourceInlineSheet
  deriving (Eq CSSCSSMediaSource
Eq CSSCSSMediaSource
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> Ordering)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> Bool)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> Bool)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> Bool)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> Bool)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource)
-> Ord CSSCSSMediaSource
CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
CSSCSSMediaSource -> CSSCSSMediaSource -> Ordering
CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource
$cmin :: CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource
max :: CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource
$cmax :: CSSCSSMediaSource -> CSSCSSMediaSource -> CSSCSSMediaSource
>= :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
$c>= :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
> :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
$c> :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
<= :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
$c<= :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
< :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
$c< :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
compare :: CSSCSSMediaSource -> CSSCSSMediaSource -> Ordering
$ccompare :: CSSCSSMediaSource -> CSSCSSMediaSource -> Ordering
$cp1Ord :: Eq CSSCSSMediaSource
Ord, CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
(CSSCSSMediaSource -> CSSCSSMediaSource -> Bool)
-> (CSSCSSMediaSource -> CSSCSSMediaSource -> Bool)
-> Eq CSSCSSMediaSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
$c/= :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
== :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
$c== :: CSSCSSMediaSource -> CSSCSSMediaSource -> Bool
Eq, Int -> CSSCSSMediaSource -> ShowS
[CSSCSSMediaSource] -> ShowS
CSSCSSMediaSource -> String
(Int -> CSSCSSMediaSource -> ShowS)
-> (CSSCSSMediaSource -> String)
-> ([CSSCSSMediaSource] -> ShowS)
-> Show CSSCSSMediaSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSMediaSource] -> ShowS
$cshowList :: [CSSCSSMediaSource] -> ShowS
show :: CSSCSSMediaSource -> String
$cshow :: CSSCSSMediaSource -> String
showsPrec :: Int -> CSSCSSMediaSource -> ShowS
$cshowsPrec :: Int -> CSSCSSMediaSource -> ShowS
Show, ReadPrec [CSSCSSMediaSource]
ReadPrec CSSCSSMediaSource
Int -> ReadS CSSCSSMediaSource
ReadS [CSSCSSMediaSource]
(Int -> ReadS CSSCSSMediaSource)
-> ReadS [CSSCSSMediaSource]
-> ReadPrec CSSCSSMediaSource
-> ReadPrec [CSSCSSMediaSource]
-> Read CSSCSSMediaSource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CSSCSSMediaSource]
$creadListPrec :: ReadPrec [CSSCSSMediaSource]
readPrec :: ReadPrec CSSCSSMediaSource
$creadPrec :: ReadPrec CSSCSSMediaSource
readList :: ReadS [CSSCSSMediaSource]
$creadList :: ReadS [CSSCSSMediaSource]
readsPrec :: Int -> ReadS CSSCSSMediaSource
$creadsPrec :: Int -> ReadS CSSCSSMediaSource
Read)
instance FromJSON CSSCSSMediaSource where
  parseJSON :: Value -> Parser CSSCSSMediaSource
parseJSON = String
-> (Text -> Parser CSSCSSMediaSource)
-> Value
-> Parser CSSCSSMediaSource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"CSSCSSMediaSource" ((Text -> Parser CSSCSSMediaSource)
 -> Value -> Parser CSSCSSMediaSource)
-> (Text -> Parser CSSCSSMediaSource)
-> Value
-> Parser CSSCSSMediaSource
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"mediaRule" -> CSSCSSMediaSource -> Parser CSSCSSMediaSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSCSSMediaSource
CSSCSSMediaSourceMediaRule
    Text
"importRule" -> CSSCSSMediaSource -> Parser CSSCSSMediaSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSCSSMediaSource
CSSCSSMediaSourceImportRule
    Text
"linkedSheet" -> CSSCSSMediaSource -> Parser CSSCSSMediaSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSCSSMediaSource
CSSCSSMediaSourceLinkedSheet
    Text
"inlineSheet" -> CSSCSSMediaSource -> Parser CSSCSSMediaSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSCSSMediaSource
CSSCSSMediaSourceInlineSheet
    Text
"_" -> String -> Parser CSSCSSMediaSource
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse CSSCSSMediaSource"
instance ToJSON CSSCSSMediaSource where
  toJSON :: CSSCSSMediaSource -> Value
toJSON CSSCSSMediaSource
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case CSSCSSMediaSource
v of
    CSSCSSMediaSource
CSSCSSMediaSourceMediaRule -> Text
"mediaRule"
    CSSCSSMediaSource
CSSCSSMediaSourceImportRule -> Text
"importRule"
    CSSCSSMediaSource
CSSCSSMediaSourceLinkedSheet -> Text
"linkedSheet"
    CSSCSSMediaSource
CSSCSSMediaSourceInlineSheet -> Text
"inlineSheet"
data CSSCSSMedia = CSSCSSMedia
  {
    -- | Media query text.
    CSSCSSMedia -> Text
cSSCSSMediaText :: T.Text,
    -- | Source of the media query: "mediaRule" if specified by a @media rule, "importRule" if
    --   specified by an @import rule, "linkedSheet" if specified by a "media" attribute in a linked
    --   stylesheet's LINK tag, "inlineSheet" if specified by a "media" attribute in an inline
    --   stylesheet's STYLE tag.
    CSSCSSMedia -> CSSCSSMediaSource
cSSCSSMediaSource :: CSSCSSMediaSource,
    -- | URL of the document containing the media query description.
    CSSCSSMedia -> Maybe Text
cSSCSSMediaSourceURL :: Maybe T.Text,
    -- | The associated rule (@media or @import) header range in the enclosing stylesheet (if
    --   available).
    CSSCSSMedia -> Maybe CSSSourceRange
cSSCSSMediaRange :: Maybe CSSSourceRange,
    -- | Identifier of the stylesheet containing this object (if exists).
    CSSCSSMedia -> Maybe Text
cSSCSSMediaStyleSheetId :: Maybe CSSStyleSheetId,
    -- | Array of media queries.
    CSSCSSMedia -> Maybe [CSSMediaQuery]
cSSCSSMediaMediaList :: Maybe [CSSMediaQuery]
  }
  deriving (CSSCSSMedia -> CSSCSSMedia -> Bool
(CSSCSSMedia -> CSSCSSMedia -> Bool)
-> (CSSCSSMedia -> CSSCSSMedia -> Bool) -> Eq CSSCSSMedia
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSMedia -> CSSCSSMedia -> Bool
$c/= :: CSSCSSMedia -> CSSCSSMedia -> Bool
== :: CSSCSSMedia -> CSSCSSMedia -> Bool
$c== :: CSSCSSMedia -> CSSCSSMedia -> Bool
Eq, Int -> CSSCSSMedia -> ShowS
[CSSCSSMedia] -> ShowS
CSSCSSMedia -> String
(Int -> CSSCSSMedia -> ShowS)
-> (CSSCSSMedia -> String)
-> ([CSSCSSMedia] -> ShowS)
-> Show CSSCSSMedia
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSMedia] -> ShowS
$cshowList :: [CSSCSSMedia] -> ShowS
show :: CSSCSSMedia -> String
$cshow :: CSSCSSMedia -> String
showsPrec :: Int -> CSSCSSMedia -> ShowS
$cshowsPrec :: Int -> CSSCSSMedia -> ShowS
Show)
instance FromJSON CSSCSSMedia where
  parseJSON :: Value -> Parser CSSCSSMedia
parseJSON = String
-> (Object -> Parser CSSCSSMedia) -> Value -> Parser CSSCSSMedia
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSMedia" ((Object -> Parser CSSCSSMedia) -> Value -> Parser CSSCSSMedia)
-> (Object -> Parser CSSCSSMedia) -> Value -> Parser CSSCSSMedia
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> CSSCSSMediaSource
-> Maybe Text
-> Maybe CSSSourceRange
-> Maybe Text
-> Maybe [CSSMediaQuery]
-> CSSCSSMedia
CSSCSSMedia
    (Text
 -> CSSCSSMediaSource
 -> Maybe Text
 -> Maybe CSSSourceRange
 -> Maybe Text
 -> Maybe [CSSMediaQuery]
 -> CSSCSSMedia)
-> Parser Text
-> Parser
     (CSSCSSMediaSource
      -> Maybe Text
      -> Maybe CSSSourceRange
      -> Maybe Text
      -> Maybe [CSSMediaQuery]
      -> CSSCSSMedia)
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
"text"
    Parser
  (CSSCSSMediaSource
   -> Maybe Text
   -> Maybe CSSSourceRange
   -> Maybe Text
   -> Maybe [CSSMediaQuery]
   -> CSSCSSMedia)
-> Parser CSSCSSMediaSource
-> Parser
     (Maybe Text
      -> Maybe CSSSourceRange
      -> Maybe Text
      -> Maybe [CSSMediaQuery]
      -> CSSCSSMedia)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSCSSMediaSource
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"source"
    Parser
  (Maybe Text
   -> Maybe CSSSourceRange
   -> Maybe Text
   -> Maybe [CSSMediaQuery]
   -> CSSCSSMedia)
-> Parser (Maybe Text)
-> Parser
     (Maybe CSSSourceRange
      -> Maybe Text -> Maybe [CSSMediaQuery] -> CSSCSSMedia)
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
"sourceURL"
    Parser
  (Maybe CSSSourceRange
   -> Maybe Text -> Maybe [CSSMediaQuery] -> CSSCSSMedia)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe Text -> Maybe [CSSMediaQuery] -> CSSCSSMedia)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
    Parser (Maybe Text -> Maybe [CSSMediaQuery] -> CSSCSSMedia)
-> Parser (Maybe Text)
-> Parser (Maybe [CSSMediaQuery] -> CSSCSSMedia)
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
"styleSheetId"
    Parser (Maybe [CSSMediaQuery] -> CSSCSSMedia)
-> Parser (Maybe [CSSMediaQuery]) -> Parser CSSCSSMedia
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSMediaQuery])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"mediaList"
instance ToJSON CSSCSSMedia where
  toJSON :: CSSCSSMedia -> Value
toJSON CSSCSSMedia
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
"text" 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 (CSSCSSMedia -> Text
cSSCSSMediaText CSSCSSMedia
p),
    (Text
"source" Text -> CSSCSSMediaSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSCSSMediaSource -> Pair)
-> Maybe CSSCSSMediaSource -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSCSSMediaSource -> Maybe CSSCSSMediaSource
forall a. a -> Maybe a
Just (CSSCSSMedia -> CSSCSSMediaSource
cSSCSSMediaSource CSSCSSMedia
p),
    (Text
"sourceURL" 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
<$> (CSSCSSMedia -> Maybe Text
cSSCSSMediaSourceURL CSSCSSMedia
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSMedia -> Maybe CSSSourceRange
cSSCSSMediaRange CSSCSSMedia
p),
    (Text
"styleSheetId" 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
<$> (CSSCSSMedia -> Maybe Text
cSSCSSMediaStyleSheetId CSSCSSMedia
p),
    (Text
"mediaList" Text -> [CSSMediaQuery] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSMediaQuery] -> Pair) -> Maybe [CSSMediaQuery] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSMedia -> Maybe [CSSMediaQuery]
cSSCSSMediaMediaList CSSCSSMedia
p)
    ]

-- | Type 'CSS.MediaQuery'.
--   Media query descriptor.
data CSSMediaQuery = CSSMediaQuery
  {
    -- | Array of media query expressions.
    CSSMediaQuery -> [CSSMediaQueryExpression]
cSSMediaQueryExpressions :: [CSSMediaQueryExpression],
    -- | Whether the media query condition is satisfied.
    CSSMediaQuery -> Bool
cSSMediaQueryActive :: Bool
  }
  deriving (CSSMediaQuery -> CSSMediaQuery -> Bool
(CSSMediaQuery -> CSSMediaQuery -> Bool)
-> (CSSMediaQuery -> CSSMediaQuery -> Bool) -> Eq CSSMediaQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSMediaQuery -> CSSMediaQuery -> Bool
$c/= :: CSSMediaQuery -> CSSMediaQuery -> Bool
== :: CSSMediaQuery -> CSSMediaQuery -> Bool
$c== :: CSSMediaQuery -> CSSMediaQuery -> Bool
Eq, Int -> CSSMediaQuery -> ShowS
[CSSMediaQuery] -> ShowS
CSSMediaQuery -> String
(Int -> CSSMediaQuery -> ShowS)
-> (CSSMediaQuery -> String)
-> ([CSSMediaQuery] -> ShowS)
-> Show CSSMediaQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSMediaQuery] -> ShowS
$cshowList :: [CSSMediaQuery] -> ShowS
show :: CSSMediaQuery -> String
$cshow :: CSSMediaQuery -> String
showsPrec :: Int -> CSSMediaQuery -> ShowS
$cshowsPrec :: Int -> CSSMediaQuery -> ShowS
Show)
instance FromJSON CSSMediaQuery where
  parseJSON :: Value -> Parser CSSMediaQuery
parseJSON = String
-> (Object -> Parser CSSMediaQuery)
-> Value
-> Parser CSSMediaQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSMediaQuery" ((Object -> Parser CSSMediaQuery) -> Value -> Parser CSSMediaQuery)
-> (Object -> Parser CSSMediaQuery)
-> Value
-> Parser CSSMediaQuery
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSMediaQueryExpression] -> Bool -> CSSMediaQuery
CSSMediaQuery
    ([CSSMediaQueryExpression] -> Bool -> CSSMediaQuery)
-> Parser [CSSMediaQueryExpression]
-> Parser (Bool -> CSSMediaQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSMediaQueryExpression]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"expressions"
    Parser (Bool -> CSSMediaQuery)
-> Parser Bool -> Parser CSSMediaQuery
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"active"
instance ToJSON CSSMediaQuery where
  toJSON :: CSSMediaQuery -> Value
toJSON CSSMediaQuery
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
"expressions" Text -> [CSSMediaQueryExpression] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSMediaQueryExpression] -> Pair)
-> Maybe [CSSMediaQueryExpression] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSMediaQueryExpression] -> Maybe [CSSMediaQueryExpression]
forall a. a -> Maybe a
Just (CSSMediaQuery -> [CSSMediaQueryExpression]
cSSMediaQueryExpressions CSSMediaQuery
p),
    (Text
"active" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSMediaQuery -> Bool
cSSMediaQueryActive CSSMediaQuery
p)
    ]

-- | Type 'CSS.MediaQueryExpression'.
--   Media query expression descriptor.
data CSSMediaQueryExpression = CSSMediaQueryExpression
  {
    -- | Media query expression value.
    CSSMediaQueryExpression -> Double
cSSMediaQueryExpressionValue :: Double,
    -- | Media query expression units.
    CSSMediaQueryExpression -> Text
cSSMediaQueryExpressionUnit :: T.Text,
    -- | Media query expression feature.
    CSSMediaQueryExpression -> Text
cSSMediaQueryExpressionFeature :: T.Text,
    -- | The associated range of the value text in the enclosing stylesheet (if available).
    CSSMediaQueryExpression -> Maybe CSSSourceRange
cSSMediaQueryExpressionValueRange :: Maybe CSSSourceRange,
    -- | Computed length of media query expression (if applicable).
    CSSMediaQueryExpression -> Maybe Double
cSSMediaQueryExpressionComputedLength :: Maybe Double
  }
  deriving (CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool
(CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool)
-> (CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool)
-> Eq CSSMediaQueryExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool
$c/= :: CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool
== :: CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool
$c== :: CSSMediaQueryExpression -> CSSMediaQueryExpression -> Bool
Eq, Int -> CSSMediaQueryExpression -> ShowS
[CSSMediaQueryExpression] -> ShowS
CSSMediaQueryExpression -> String
(Int -> CSSMediaQueryExpression -> ShowS)
-> (CSSMediaQueryExpression -> String)
-> ([CSSMediaQueryExpression] -> ShowS)
-> Show CSSMediaQueryExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSMediaQueryExpression] -> ShowS
$cshowList :: [CSSMediaQueryExpression] -> ShowS
show :: CSSMediaQueryExpression -> String
$cshow :: CSSMediaQueryExpression -> String
showsPrec :: Int -> CSSMediaQueryExpression -> ShowS
$cshowsPrec :: Int -> CSSMediaQueryExpression -> ShowS
Show)
instance FromJSON CSSMediaQueryExpression where
  parseJSON :: Value -> Parser CSSMediaQueryExpression
parseJSON = String
-> (Object -> Parser CSSMediaQueryExpression)
-> Value
-> Parser CSSMediaQueryExpression
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSMediaQueryExpression" ((Object -> Parser CSSMediaQueryExpression)
 -> Value -> Parser CSSMediaQueryExpression)
-> (Object -> Parser CSSMediaQueryExpression)
-> Value
-> Parser CSSMediaQueryExpression
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double
-> Text
-> Text
-> Maybe CSSSourceRange
-> Maybe Double
-> CSSMediaQueryExpression
CSSMediaQueryExpression
    (Double
 -> Text
 -> Text
 -> Maybe CSSSourceRange
 -> Maybe Double
 -> CSSMediaQueryExpression)
-> Parser Double
-> Parser
     (Text
      -> Text
      -> Maybe CSSSourceRange
      -> Maybe Double
      -> CSSMediaQueryExpression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
    Parser
  (Text
   -> Text
   -> Maybe CSSSourceRange
   -> Maybe Double
   -> CSSMediaQueryExpression)
-> Parser Text
-> Parser
     (Text
      -> Maybe CSSSourceRange -> Maybe Double -> CSSMediaQueryExpression)
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
"unit"
    Parser
  (Text
   -> Maybe CSSSourceRange -> Maybe Double -> CSSMediaQueryExpression)
-> Parser Text
-> Parser
     (Maybe CSSSourceRange -> Maybe Double -> CSSMediaQueryExpression)
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
"feature"
    Parser
  (Maybe CSSSourceRange -> Maybe Double -> CSSMediaQueryExpression)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe Double -> CSSMediaQueryExpression)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"valueRange"
    Parser (Maybe Double -> CSSMediaQueryExpression)
-> Parser (Maybe Double) -> Parser CSSMediaQueryExpression
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
"computedLength"
instance ToJSON CSSMediaQueryExpression where
  toJSON :: CSSMediaQueryExpression -> Value
toJSON CSSMediaQueryExpression
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
"value" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSMediaQueryExpression -> Double
cSSMediaQueryExpressionValue CSSMediaQueryExpression
p),
    (Text
"unit" 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 (CSSMediaQueryExpression -> Text
cSSMediaQueryExpressionUnit CSSMediaQueryExpression
p),
    (Text
"feature" 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 (CSSMediaQueryExpression -> Text
cSSMediaQueryExpressionFeature CSSMediaQueryExpression
p),
    (Text
"valueRange" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSMediaQueryExpression -> Maybe CSSSourceRange
cSSMediaQueryExpressionValueRange CSSMediaQueryExpression
p),
    (Text
"computedLength" 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
<$> (CSSMediaQueryExpression -> Maybe Double
cSSMediaQueryExpressionComputedLength CSSMediaQueryExpression
p)
    ]

-- | Type 'CSS.CSSContainerQuery'.
--   CSS container query rule descriptor.
data CSSCSSContainerQuery = CSSCSSContainerQuery
  {
    -- | Container query text.
    CSSCSSContainerQuery -> Text
cSSCSSContainerQueryText :: T.Text,
    -- | The associated rule header range in the enclosing stylesheet (if
    --   available).
    CSSCSSContainerQuery -> Maybe CSSSourceRange
cSSCSSContainerQueryRange :: Maybe CSSSourceRange,
    -- | Identifier of the stylesheet containing this object (if exists).
    CSSCSSContainerQuery -> Maybe Text
cSSCSSContainerQueryStyleSheetId :: Maybe CSSStyleSheetId,
    -- | Optional name for the container.
    CSSCSSContainerQuery -> Maybe Text
cSSCSSContainerQueryName :: Maybe T.Text
  }
  deriving (CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool
(CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool)
-> (CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool)
-> Eq CSSCSSContainerQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool
$c/= :: CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool
== :: CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool
$c== :: CSSCSSContainerQuery -> CSSCSSContainerQuery -> Bool
Eq, Int -> CSSCSSContainerQuery -> ShowS
[CSSCSSContainerQuery] -> ShowS
CSSCSSContainerQuery -> String
(Int -> CSSCSSContainerQuery -> ShowS)
-> (CSSCSSContainerQuery -> String)
-> ([CSSCSSContainerQuery] -> ShowS)
-> Show CSSCSSContainerQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSContainerQuery] -> ShowS
$cshowList :: [CSSCSSContainerQuery] -> ShowS
show :: CSSCSSContainerQuery -> String
$cshow :: CSSCSSContainerQuery -> String
showsPrec :: Int -> CSSCSSContainerQuery -> ShowS
$cshowsPrec :: Int -> CSSCSSContainerQuery -> ShowS
Show)
instance FromJSON CSSCSSContainerQuery where
  parseJSON :: Value -> Parser CSSCSSContainerQuery
parseJSON = String
-> (Object -> Parser CSSCSSContainerQuery)
-> Value
-> Parser CSSCSSContainerQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSContainerQuery" ((Object -> Parser CSSCSSContainerQuery)
 -> Value -> Parser CSSCSSContainerQuery)
-> (Object -> Parser CSSCSSContainerQuery)
-> Value
-> Parser CSSCSSContainerQuery
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe CSSSourceRange
-> Maybe Text
-> Maybe Text
-> CSSCSSContainerQuery
CSSCSSContainerQuery
    (Text
 -> Maybe CSSSourceRange
 -> Maybe Text
 -> Maybe Text
 -> CSSCSSContainerQuery)
-> Parser Text
-> Parser
     (Maybe CSSSourceRange
      -> Maybe Text -> Maybe Text -> CSSCSSContainerQuery)
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
"text"
    Parser
  (Maybe CSSSourceRange
   -> Maybe Text -> Maybe Text -> CSSCSSContainerQuery)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe Text -> Maybe Text -> CSSCSSContainerQuery)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
    Parser (Maybe Text -> Maybe Text -> CSSCSSContainerQuery)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> CSSCSSContainerQuery)
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
"styleSheetId"
    Parser (Maybe Text -> CSSCSSContainerQuery)
-> Parser (Maybe Text) -> Parser CSSCSSContainerQuery
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
"name"
instance ToJSON CSSCSSContainerQuery where
  toJSON :: CSSCSSContainerQuery -> Value
toJSON CSSCSSContainerQuery
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
"text" 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 (CSSCSSContainerQuery -> Text
cSSCSSContainerQueryText CSSCSSContainerQuery
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSContainerQuery -> Maybe CSSSourceRange
cSSCSSContainerQueryRange CSSCSSContainerQuery
p),
    (Text
"styleSheetId" 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
<$> (CSSCSSContainerQuery -> Maybe Text
cSSCSSContainerQueryStyleSheetId CSSCSSContainerQuery
p),
    (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
<$> (CSSCSSContainerQuery -> Maybe Text
cSSCSSContainerQueryName CSSCSSContainerQuery
p)
    ]

-- | Type 'CSS.CSSSupports'.
--   CSS Supports at-rule descriptor.
data CSSCSSSupports = CSSCSSSupports
  {
    -- | Supports rule text.
    CSSCSSSupports -> Text
cSSCSSSupportsText :: T.Text,
    -- | Whether the supports condition is satisfied.
    CSSCSSSupports -> Bool
cSSCSSSupportsActive :: Bool,
    -- | The associated rule header range in the enclosing stylesheet (if
    --   available).
    CSSCSSSupports -> Maybe CSSSourceRange
cSSCSSSupportsRange :: Maybe CSSSourceRange,
    -- | Identifier of the stylesheet containing this object (if exists).
    CSSCSSSupports -> Maybe Text
cSSCSSSupportsStyleSheetId :: Maybe CSSStyleSheetId
  }
  deriving (CSSCSSSupports -> CSSCSSSupports -> Bool
(CSSCSSSupports -> CSSCSSSupports -> Bool)
-> (CSSCSSSupports -> CSSCSSSupports -> Bool) -> Eq CSSCSSSupports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSSupports -> CSSCSSSupports -> Bool
$c/= :: CSSCSSSupports -> CSSCSSSupports -> Bool
== :: CSSCSSSupports -> CSSCSSSupports -> Bool
$c== :: CSSCSSSupports -> CSSCSSSupports -> Bool
Eq, Int -> CSSCSSSupports -> ShowS
[CSSCSSSupports] -> ShowS
CSSCSSSupports -> String
(Int -> CSSCSSSupports -> ShowS)
-> (CSSCSSSupports -> String)
-> ([CSSCSSSupports] -> ShowS)
-> Show CSSCSSSupports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSSupports] -> ShowS
$cshowList :: [CSSCSSSupports] -> ShowS
show :: CSSCSSSupports -> String
$cshow :: CSSCSSSupports -> String
showsPrec :: Int -> CSSCSSSupports -> ShowS
$cshowsPrec :: Int -> CSSCSSSupports -> ShowS
Show)
instance FromJSON CSSCSSSupports where
  parseJSON :: Value -> Parser CSSCSSSupports
parseJSON = String
-> (Object -> Parser CSSCSSSupports)
-> Value
-> Parser CSSCSSSupports
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSSupports" ((Object -> Parser CSSCSSSupports)
 -> Value -> Parser CSSCSSSupports)
-> (Object -> Parser CSSCSSSupports)
-> Value
-> Parser CSSCSSSupports
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Bool -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSSupports
CSSCSSSupports
    (Text
 -> Bool -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSSupports)
-> Parser Text
-> Parser
     (Bool -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSSupports)
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
"text"
    Parser
  (Bool -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSSupports)
-> Parser Bool
-> Parser (Maybe CSSSourceRange -> Maybe Text -> CSSCSSSupports)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"active"
    Parser (Maybe CSSSourceRange -> Maybe Text -> CSSCSSSupports)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe Text -> CSSCSSSupports)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
    Parser (Maybe Text -> CSSCSSSupports)
-> Parser (Maybe Text) -> Parser CSSCSSSupports
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
"styleSheetId"
instance ToJSON CSSCSSSupports where
  toJSON :: CSSCSSSupports -> Value
toJSON CSSCSSSupports
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
"text" 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 (CSSCSSSupports -> Text
cSSCSSSupportsText CSSCSSSupports
p),
    (Text
"active" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSCSSSupports -> Bool
cSSCSSSupportsActive CSSCSSSupports
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSSupports -> Maybe CSSSourceRange
cSSCSSSupportsRange CSSCSSSupports
p),
    (Text
"styleSheetId" 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
<$> (CSSCSSSupports -> Maybe Text
cSSCSSSupportsStyleSheetId CSSCSSSupports
p)
    ]

-- | Type 'CSS.CSSScope'.
--   CSS Scope at-rule descriptor.
data CSSCSSScope = CSSCSSScope
  {
    -- | Scope rule text.
    CSSCSSScope -> Text
cSSCSSScopeText :: T.Text,
    -- | The associated rule header range in the enclosing stylesheet (if
    --   available).
    CSSCSSScope -> Maybe CSSSourceRange
cSSCSSScopeRange :: Maybe CSSSourceRange,
    -- | Identifier of the stylesheet containing this object (if exists).
    CSSCSSScope -> Maybe Text
cSSCSSScopeStyleSheetId :: Maybe CSSStyleSheetId
  }
  deriving (CSSCSSScope -> CSSCSSScope -> Bool
(CSSCSSScope -> CSSCSSScope -> Bool)
-> (CSSCSSScope -> CSSCSSScope -> Bool) -> Eq CSSCSSScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSScope -> CSSCSSScope -> Bool
$c/= :: CSSCSSScope -> CSSCSSScope -> Bool
== :: CSSCSSScope -> CSSCSSScope -> Bool
$c== :: CSSCSSScope -> CSSCSSScope -> Bool
Eq, Int -> CSSCSSScope -> ShowS
[CSSCSSScope] -> ShowS
CSSCSSScope -> String
(Int -> CSSCSSScope -> ShowS)
-> (CSSCSSScope -> String)
-> ([CSSCSSScope] -> ShowS)
-> Show CSSCSSScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSScope] -> ShowS
$cshowList :: [CSSCSSScope] -> ShowS
show :: CSSCSSScope -> String
$cshow :: CSSCSSScope -> String
showsPrec :: Int -> CSSCSSScope -> ShowS
$cshowsPrec :: Int -> CSSCSSScope -> ShowS
Show)
instance FromJSON CSSCSSScope where
  parseJSON :: Value -> Parser CSSCSSScope
parseJSON = String
-> (Object -> Parser CSSCSSScope) -> Value -> Parser CSSCSSScope
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSScope" ((Object -> Parser CSSCSSScope) -> Value -> Parser CSSCSSScope)
-> (Object -> Parser CSSCSSScope) -> Value -> Parser CSSCSSScope
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSScope
CSSCSSScope
    (Text -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSScope)
-> Parser Text
-> Parser (Maybe CSSSourceRange -> Maybe Text -> CSSCSSScope)
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
"text"
    Parser (Maybe CSSSourceRange -> Maybe Text -> CSSCSSScope)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe Text -> CSSCSSScope)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
    Parser (Maybe Text -> CSSCSSScope)
-> Parser (Maybe Text) -> Parser CSSCSSScope
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
"styleSheetId"
instance ToJSON CSSCSSScope where
  toJSON :: CSSCSSScope -> Value
toJSON CSSCSSScope
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
"text" 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 (CSSCSSScope -> Text
cSSCSSScopeText CSSCSSScope
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSScope -> Maybe CSSSourceRange
cSSCSSScopeRange CSSCSSScope
p),
    (Text
"styleSheetId" 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
<$> (CSSCSSScope -> Maybe Text
cSSCSSScopeStyleSheetId CSSCSSScope
p)
    ]

-- | Type 'CSS.CSSLayer'.
--   CSS Layer at-rule descriptor.
data CSSCSSLayer = CSSCSSLayer
  {
    -- | Layer name.
    CSSCSSLayer -> Text
cSSCSSLayerText :: T.Text,
    -- | The associated rule header range in the enclosing stylesheet (if
    --   available).
    CSSCSSLayer -> Maybe CSSSourceRange
cSSCSSLayerRange :: Maybe CSSSourceRange,
    -- | Identifier of the stylesheet containing this object (if exists).
    CSSCSSLayer -> Maybe Text
cSSCSSLayerStyleSheetId :: Maybe CSSStyleSheetId
  }
  deriving (CSSCSSLayer -> CSSCSSLayer -> Bool
(CSSCSSLayer -> CSSCSSLayer -> Bool)
-> (CSSCSSLayer -> CSSCSSLayer -> Bool) -> Eq CSSCSSLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSLayer -> CSSCSSLayer -> Bool
$c/= :: CSSCSSLayer -> CSSCSSLayer -> Bool
== :: CSSCSSLayer -> CSSCSSLayer -> Bool
$c== :: CSSCSSLayer -> CSSCSSLayer -> Bool
Eq, Int -> CSSCSSLayer -> ShowS
[CSSCSSLayer] -> ShowS
CSSCSSLayer -> String
(Int -> CSSCSSLayer -> ShowS)
-> (CSSCSSLayer -> String)
-> ([CSSCSSLayer] -> ShowS)
-> Show CSSCSSLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSLayer] -> ShowS
$cshowList :: [CSSCSSLayer] -> ShowS
show :: CSSCSSLayer -> String
$cshow :: CSSCSSLayer -> String
showsPrec :: Int -> CSSCSSLayer -> ShowS
$cshowsPrec :: Int -> CSSCSSLayer -> ShowS
Show)
instance FromJSON CSSCSSLayer where
  parseJSON :: Value -> Parser CSSCSSLayer
parseJSON = String
-> (Object -> Parser CSSCSSLayer) -> Value -> Parser CSSCSSLayer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSLayer" ((Object -> Parser CSSCSSLayer) -> Value -> Parser CSSCSSLayer)
-> (Object -> Parser CSSCSSLayer) -> Value -> Parser CSSCSSLayer
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSLayer
CSSCSSLayer
    (Text -> Maybe CSSSourceRange -> Maybe Text -> CSSCSSLayer)
-> Parser Text
-> Parser (Maybe CSSSourceRange -> Maybe Text -> CSSCSSLayer)
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
"text"
    Parser (Maybe CSSSourceRange -> Maybe Text -> CSSCSSLayer)
-> Parser (Maybe CSSSourceRange)
-> Parser (Maybe Text -> CSSCSSLayer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSSourceRange)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"range"
    Parser (Maybe Text -> CSSCSSLayer)
-> Parser (Maybe Text) -> Parser CSSCSSLayer
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
"styleSheetId"
instance ToJSON CSSCSSLayer where
  toJSON :: CSSCSSLayer -> Value
toJSON CSSCSSLayer
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
"text" 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 (CSSCSSLayer -> Text
cSSCSSLayerText CSSCSSLayer
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSLayer -> Maybe CSSSourceRange
cSSCSSLayerRange CSSCSSLayer
p),
    (Text
"styleSheetId" 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
<$> (CSSCSSLayer -> Maybe Text
cSSCSSLayerStyleSheetId CSSCSSLayer
p)
    ]

-- | Type 'CSS.CSSLayerData'.
--   CSS Layer data.
data CSSCSSLayerData = CSSCSSLayerData
  {
    -- | Layer name.
    CSSCSSLayerData -> Text
cSSCSSLayerDataName :: T.Text,
    -- | Direct sub-layers
    CSSCSSLayerData -> Maybe [CSSCSSLayerData]
cSSCSSLayerDataSubLayers :: Maybe [CSSCSSLayerData],
    -- | Layer order. The order determines the order of the layer in the cascade order.
    --   A higher number has higher priority in the cascade order.
    CSSCSSLayerData -> Double
cSSCSSLayerDataOrder :: Double
  }
  deriving (CSSCSSLayerData -> CSSCSSLayerData -> Bool
(CSSCSSLayerData -> CSSCSSLayerData -> Bool)
-> (CSSCSSLayerData -> CSSCSSLayerData -> Bool)
-> Eq CSSCSSLayerData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSLayerData -> CSSCSSLayerData -> Bool
$c/= :: CSSCSSLayerData -> CSSCSSLayerData -> Bool
== :: CSSCSSLayerData -> CSSCSSLayerData -> Bool
$c== :: CSSCSSLayerData -> CSSCSSLayerData -> Bool
Eq, Int -> CSSCSSLayerData -> ShowS
[CSSCSSLayerData] -> ShowS
CSSCSSLayerData -> String
(Int -> CSSCSSLayerData -> ShowS)
-> (CSSCSSLayerData -> String)
-> ([CSSCSSLayerData] -> ShowS)
-> Show CSSCSSLayerData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSLayerData] -> ShowS
$cshowList :: [CSSCSSLayerData] -> ShowS
show :: CSSCSSLayerData -> String
$cshow :: CSSCSSLayerData -> String
showsPrec :: Int -> CSSCSSLayerData -> ShowS
$cshowsPrec :: Int -> CSSCSSLayerData -> ShowS
Show)
instance FromJSON CSSCSSLayerData where
  parseJSON :: Value -> Parser CSSCSSLayerData
parseJSON = String
-> (Object -> Parser CSSCSSLayerData)
-> Value
-> Parser CSSCSSLayerData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSLayerData" ((Object -> Parser CSSCSSLayerData)
 -> Value -> Parser CSSCSSLayerData)
-> (Object -> Parser CSSCSSLayerData)
-> Value
-> Parser CSSCSSLayerData
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe [CSSCSSLayerData] -> Double -> CSSCSSLayerData
CSSCSSLayerData
    (Text -> Maybe [CSSCSSLayerData] -> Double -> CSSCSSLayerData)
-> Parser Text
-> Parser (Maybe [CSSCSSLayerData] -> Double -> CSSCSSLayerData)
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 (Maybe [CSSCSSLayerData] -> Double -> CSSCSSLayerData)
-> Parser (Maybe [CSSCSSLayerData])
-> Parser (Double -> CSSCSSLayerData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSLayerData])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"subLayers"
    Parser (Double -> CSSCSSLayerData)
-> Parser Double -> Parser CSSCSSLayerData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"order"
instance ToJSON CSSCSSLayerData where
  toJSON :: CSSCSSLayerData -> Value
toJSON CSSCSSLayerData
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 (CSSCSSLayerData -> Text
cSSCSSLayerDataName CSSCSSLayerData
p),
    (Text
"subLayers" Text -> [CSSCSSLayerData] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSLayerData] -> Pair)
-> Maybe [CSSCSSLayerData] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSCSSLayerData -> Maybe [CSSCSSLayerData]
cSSCSSLayerDataSubLayers CSSCSSLayerData
p),
    (Text
"order" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSCSSLayerData -> Double
cSSCSSLayerDataOrder CSSCSSLayerData
p)
    ]

-- | Type 'CSS.PlatformFontUsage'.
--   Information about amount of glyphs that were rendered with given font.
data CSSPlatformFontUsage = CSSPlatformFontUsage
  {
    -- | Font's family name reported by platform.
    CSSPlatformFontUsage -> Text
cSSPlatformFontUsageFamilyName :: T.Text,
    -- | Indicates if the font was downloaded or resolved locally.
    CSSPlatformFontUsage -> Bool
cSSPlatformFontUsageIsCustomFont :: Bool,
    -- | Amount of glyphs that were rendered with this font.
    CSSPlatformFontUsage -> Double
cSSPlatformFontUsageGlyphCount :: Double
  }
  deriving (CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool
(CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool)
-> (CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool)
-> Eq CSSPlatformFontUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool
$c/= :: CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool
== :: CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool
$c== :: CSSPlatformFontUsage -> CSSPlatformFontUsage -> Bool
Eq, Int -> CSSPlatformFontUsage -> ShowS
[CSSPlatformFontUsage] -> ShowS
CSSPlatformFontUsage -> String
(Int -> CSSPlatformFontUsage -> ShowS)
-> (CSSPlatformFontUsage -> String)
-> ([CSSPlatformFontUsage] -> ShowS)
-> Show CSSPlatformFontUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSPlatformFontUsage] -> ShowS
$cshowList :: [CSSPlatformFontUsage] -> ShowS
show :: CSSPlatformFontUsage -> String
$cshow :: CSSPlatformFontUsage -> String
showsPrec :: Int -> CSSPlatformFontUsage -> ShowS
$cshowsPrec :: Int -> CSSPlatformFontUsage -> ShowS
Show)
instance FromJSON CSSPlatformFontUsage where
  parseJSON :: Value -> Parser CSSPlatformFontUsage
parseJSON = String
-> (Object -> Parser CSSPlatformFontUsage)
-> Value
-> Parser CSSPlatformFontUsage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSPlatformFontUsage" ((Object -> Parser CSSPlatformFontUsage)
 -> Value -> Parser CSSPlatformFontUsage)
-> (Object -> Parser CSSPlatformFontUsage)
-> Value
-> Parser CSSPlatformFontUsage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Double -> CSSPlatformFontUsage
CSSPlatformFontUsage
    (Text -> Bool -> Double -> CSSPlatformFontUsage)
-> Parser Text -> Parser (Bool -> Double -> CSSPlatformFontUsage)
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
"familyName"
    Parser (Bool -> Double -> CSSPlatformFontUsage)
-> Parser Bool -> Parser (Double -> CSSPlatformFontUsage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isCustomFont"
    Parser (Double -> CSSPlatformFontUsage)
-> Parser Double -> Parser CSSPlatformFontUsage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"glyphCount"
instance ToJSON CSSPlatformFontUsage where
  toJSON :: CSSPlatformFontUsage -> Value
toJSON CSSPlatformFontUsage
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
"familyName" 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 (CSSPlatformFontUsage -> Text
cSSPlatformFontUsageFamilyName CSSPlatformFontUsage
p),
    (Text
"isCustomFont" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (CSSPlatformFontUsage -> Bool
cSSPlatformFontUsageIsCustomFont CSSPlatformFontUsage
p),
    (Text
"glyphCount" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSPlatformFontUsage -> Double
cSSPlatformFontUsageGlyphCount CSSPlatformFontUsage
p)
    ]

-- | Type 'CSS.FontVariationAxis'.
--   Information about font variation axes for variable fonts
data CSSFontVariationAxis = CSSFontVariationAxis
  {
    -- | The font-variation-setting tag (a.k.a. "axis tag").
    CSSFontVariationAxis -> Text
cSSFontVariationAxisTag :: T.Text,
    -- | Human-readable variation name in the default language (normally, "en").
    CSSFontVariationAxis -> Text
cSSFontVariationAxisName :: T.Text,
    -- | The minimum value (inclusive) the font supports for this tag.
    CSSFontVariationAxis -> Double
cSSFontVariationAxisMinValue :: Double,
    -- | The maximum value (inclusive) the font supports for this tag.
    CSSFontVariationAxis -> Double
cSSFontVariationAxisMaxValue :: Double,
    -- | The default value.
    CSSFontVariationAxis -> Double
cSSFontVariationAxisDefaultValue :: Double
  }
  deriving (CSSFontVariationAxis -> CSSFontVariationAxis -> Bool
(CSSFontVariationAxis -> CSSFontVariationAxis -> Bool)
-> (CSSFontVariationAxis -> CSSFontVariationAxis -> Bool)
-> Eq CSSFontVariationAxis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSFontVariationAxis -> CSSFontVariationAxis -> Bool
$c/= :: CSSFontVariationAxis -> CSSFontVariationAxis -> Bool
== :: CSSFontVariationAxis -> CSSFontVariationAxis -> Bool
$c== :: CSSFontVariationAxis -> CSSFontVariationAxis -> Bool
Eq, Int -> CSSFontVariationAxis -> ShowS
[CSSFontVariationAxis] -> ShowS
CSSFontVariationAxis -> String
(Int -> CSSFontVariationAxis -> ShowS)
-> (CSSFontVariationAxis -> String)
-> ([CSSFontVariationAxis] -> ShowS)
-> Show CSSFontVariationAxis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSFontVariationAxis] -> ShowS
$cshowList :: [CSSFontVariationAxis] -> ShowS
show :: CSSFontVariationAxis -> String
$cshow :: CSSFontVariationAxis -> String
showsPrec :: Int -> CSSFontVariationAxis -> ShowS
$cshowsPrec :: Int -> CSSFontVariationAxis -> ShowS
Show)
instance FromJSON CSSFontVariationAxis where
  parseJSON :: Value -> Parser CSSFontVariationAxis
parseJSON = String
-> (Object -> Parser CSSFontVariationAxis)
-> Value
-> Parser CSSFontVariationAxis
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSFontVariationAxis" ((Object -> Parser CSSFontVariationAxis)
 -> Value -> Parser CSSFontVariationAxis)
-> (Object -> Parser CSSFontVariationAxis)
-> Value
-> Parser CSSFontVariationAxis
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Double -> Double -> Double -> CSSFontVariationAxis
CSSFontVariationAxis
    (Text
 -> Text -> Double -> Double -> Double -> CSSFontVariationAxis)
-> Parser Text
-> Parser
     (Text -> Double -> Double -> Double -> CSSFontVariationAxis)
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
"tag"
    Parser (Text -> Double -> Double -> Double -> CSSFontVariationAxis)
-> Parser Text
-> Parser (Double -> Double -> Double -> CSSFontVariationAxis)
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
"name"
    Parser (Double -> Double -> Double -> CSSFontVariationAxis)
-> Parser Double
-> Parser (Double -> Double -> CSSFontVariationAxis)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"minValue"
    Parser (Double -> Double -> CSSFontVariationAxis)
-> Parser Double -> Parser (Double -> CSSFontVariationAxis)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"maxValue"
    Parser (Double -> CSSFontVariationAxis)
-> Parser Double -> Parser CSSFontVariationAxis
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"defaultValue"
instance ToJSON CSSFontVariationAxis where
  toJSON :: CSSFontVariationAxis -> Value
toJSON CSSFontVariationAxis
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
"tag" 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 (CSSFontVariationAxis -> Text
cSSFontVariationAxisTag CSSFontVariationAxis
p),
    (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 (CSSFontVariationAxis -> Text
cSSFontVariationAxisName CSSFontVariationAxis
p),
    (Text
"minValue" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSFontVariationAxis -> Double
cSSFontVariationAxisMinValue CSSFontVariationAxis
p),
    (Text
"maxValue" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSFontVariationAxis -> Double
cSSFontVariationAxisMaxValue CSSFontVariationAxis
p),
    (Text
"defaultValue" 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
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (CSSFontVariationAxis -> Double
cSSFontVariationAxisDefaultValue CSSFontVariationAxis
p)
    ]

-- | Type 'CSS.FontFace'.
--   Properties of a web font: https://www.w3.org/TR/2008/REC-CSS2-20080411/fonts.html#font-descriptions
--   and additional information such as platformFontFamily and fontVariationAxes.
data CSSFontFace = CSSFontFace
  {
    -- | The font-family.
    CSSFontFace -> Text
cSSFontFaceFontFamily :: T.Text,
    -- | The font-style.
    CSSFontFace -> Text
cSSFontFaceFontStyle :: T.Text,
    -- | The font-variant.
    CSSFontFace -> Text
cSSFontFaceFontVariant :: T.Text,
    -- | The font-weight.
    CSSFontFace -> Text
cSSFontFaceFontWeight :: T.Text,
    -- | The font-stretch.
    CSSFontFace -> Text
cSSFontFaceFontStretch :: T.Text,
    -- | The font-display.
    CSSFontFace -> Text
cSSFontFaceFontDisplay :: T.Text,
    -- | The unicode-range.
    CSSFontFace -> Text
cSSFontFaceUnicodeRange :: T.Text,
    -- | The src.
    CSSFontFace -> Text
cSSFontFaceSrc :: T.Text,
    -- | The resolved platform font family
    CSSFontFace -> Text
cSSFontFacePlatformFontFamily :: T.Text,
    -- | Available variation settings (a.k.a. "axes").
    CSSFontFace -> Maybe [CSSFontVariationAxis]
cSSFontFaceFontVariationAxes :: Maybe [CSSFontVariationAxis]
  }
  deriving (CSSFontFace -> CSSFontFace -> Bool
(CSSFontFace -> CSSFontFace -> Bool)
-> (CSSFontFace -> CSSFontFace -> Bool) -> Eq CSSFontFace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSFontFace -> CSSFontFace -> Bool
$c/= :: CSSFontFace -> CSSFontFace -> Bool
== :: CSSFontFace -> CSSFontFace -> Bool
$c== :: CSSFontFace -> CSSFontFace -> Bool
Eq, Int -> CSSFontFace -> ShowS
[CSSFontFace] -> ShowS
CSSFontFace -> String
(Int -> CSSFontFace -> ShowS)
-> (CSSFontFace -> String)
-> ([CSSFontFace] -> ShowS)
-> Show CSSFontFace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSFontFace] -> ShowS
$cshowList :: [CSSFontFace] -> ShowS
show :: CSSFontFace -> String
$cshow :: CSSFontFace -> String
showsPrec :: Int -> CSSFontFace -> ShowS
$cshowsPrec :: Int -> CSSFontFace -> ShowS
Show)
instance FromJSON CSSFontFace where
  parseJSON :: Value -> Parser CSSFontFace
parseJSON = String
-> (Object -> Parser CSSFontFace) -> Value -> Parser CSSFontFace
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSFontFace" ((Object -> Parser CSSFontFace) -> Value -> Parser CSSFontFace)
-> (Object -> Parser CSSFontFace) -> Value -> Parser CSSFontFace
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Maybe [CSSFontVariationAxis]
-> CSSFontFace
CSSFontFace
    (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Maybe [CSSFontVariationAxis]
 -> CSSFontFace)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe [CSSFontVariationAxis]
      -> CSSFontFace)
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
"fontFamily"
    Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe [CSSFontVariationAxis]
   -> CSSFontFace)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe [CSSFontVariationAxis]
      -> CSSFontFace)
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
"fontStyle"
    Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe [CSSFontVariationAxis]
   -> CSSFontFace)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe [CSSFontVariationAxis]
      -> CSSFontFace)
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
"fontVariant"
    Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe [CSSFontVariationAxis]
   -> CSSFontFace)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Maybe [CSSFontVariationAxis]
      -> CSSFontFace)
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
"fontWeight"
    Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Maybe [CSSFontVariationAxis]
   -> CSSFontFace)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Maybe [CSSFontVariationAxis]
      -> CSSFontFace)
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
"fontStretch"
    Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Maybe [CSSFontVariationAxis]
   -> CSSFontFace)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Maybe [CSSFontVariationAxis] -> CSSFontFace)
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
"fontDisplay"
    Parser
  (Text
   -> Text -> Text -> Maybe [CSSFontVariationAxis] -> CSSFontFace)
-> Parser Text
-> Parser
     (Text -> Text -> Maybe [CSSFontVariationAxis] -> CSSFontFace)
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
"unicodeRange"
    Parser
  (Text -> Text -> Maybe [CSSFontVariationAxis] -> CSSFontFace)
-> Parser Text
-> Parser (Text -> Maybe [CSSFontVariationAxis] -> CSSFontFace)
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
"src"
    Parser (Text -> Maybe [CSSFontVariationAxis] -> CSSFontFace)
-> Parser Text
-> Parser (Maybe [CSSFontVariationAxis] -> CSSFontFace)
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
"platformFontFamily"
    Parser (Maybe [CSSFontVariationAxis] -> CSSFontFace)
-> Parser (Maybe [CSSFontVariationAxis]) -> Parser CSSFontFace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSFontVariationAxis])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"fontVariationAxes"
instance ToJSON CSSFontFace where
  toJSON :: CSSFontFace -> Value
toJSON CSSFontFace
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
"fontFamily" 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 (CSSFontFace -> Text
cSSFontFaceFontFamily CSSFontFace
p),
    (Text
"fontStyle" 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 (CSSFontFace -> Text
cSSFontFaceFontStyle CSSFontFace
p),
    (Text
"fontVariant" 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 (CSSFontFace -> Text
cSSFontFaceFontVariant CSSFontFace
p),
    (Text
"fontWeight" 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 (CSSFontFace -> Text
cSSFontFaceFontWeight CSSFontFace
p),
    (Text
"fontStretch" 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 (CSSFontFace -> Text
cSSFontFaceFontStretch CSSFontFace
p),
    (Text
"fontDisplay" 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 (CSSFontFace -> Text
cSSFontFaceFontDisplay CSSFontFace
p),
    (Text
"unicodeRange" 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 (CSSFontFace -> Text
cSSFontFaceUnicodeRange CSSFontFace
p),
    (Text
"src" 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 (CSSFontFace -> Text
cSSFontFaceSrc CSSFontFace
p),
    (Text
"platformFontFamily" 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 (CSSFontFace -> Text
cSSFontFacePlatformFontFamily CSSFontFace
p),
    (Text
"fontVariationAxes" Text -> [CSSFontVariationAxis] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSFontVariationAxis] -> Pair)
-> Maybe [CSSFontVariationAxis] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CSSFontFace -> Maybe [CSSFontVariationAxis]
cSSFontFaceFontVariationAxes CSSFontFace
p)
    ]

-- | Type 'CSS.CSSKeyframesRule'.
--   CSS keyframes rule representation.
data CSSCSSKeyframesRule = CSSCSSKeyframesRule
  {
    -- | Animation name.
    CSSCSSKeyframesRule -> CSSValue
cSSCSSKeyframesRuleAnimationName :: CSSValue,
    -- | List of keyframes.
    CSSCSSKeyframesRule -> [CSSCSSKeyframeRule]
cSSCSSKeyframesRuleKeyframes :: [CSSCSSKeyframeRule]
  }
  deriving (CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool
(CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool)
-> (CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool)
-> Eq CSSCSSKeyframesRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool
$c/= :: CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool
== :: CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool
$c== :: CSSCSSKeyframesRule -> CSSCSSKeyframesRule -> Bool
Eq, Int -> CSSCSSKeyframesRule -> ShowS
[CSSCSSKeyframesRule] -> ShowS
CSSCSSKeyframesRule -> String
(Int -> CSSCSSKeyframesRule -> ShowS)
-> (CSSCSSKeyframesRule -> String)
-> ([CSSCSSKeyframesRule] -> ShowS)
-> Show CSSCSSKeyframesRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSKeyframesRule] -> ShowS
$cshowList :: [CSSCSSKeyframesRule] -> ShowS
show :: CSSCSSKeyframesRule -> String
$cshow :: CSSCSSKeyframesRule -> String
showsPrec :: Int -> CSSCSSKeyframesRule -> ShowS
$cshowsPrec :: Int -> CSSCSSKeyframesRule -> ShowS
Show)
instance FromJSON CSSCSSKeyframesRule where
  parseJSON :: Value -> Parser CSSCSSKeyframesRule
parseJSON = String
-> (Object -> Parser CSSCSSKeyframesRule)
-> Value
-> Parser CSSCSSKeyframesRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSKeyframesRule" ((Object -> Parser CSSCSSKeyframesRule)
 -> Value -> Parser CSSCSSKeyframesRule)
-> (Object -> Parser CSSCSSKeyframesRule)
-> Value
-> Parser CSSCSSKeyframesRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSValue -> [CSSCSSKeyframeRule] -> CSSCSSKeyframesRule
CSSCSSKeyframesRule
    (CSSValue -> [CSSCSSKeyframeRule] -> CSSCSSKeyframesRule)
-> Parser CSSValue
-> Parser ([CSSCSSKeyframeRule] -> CSSCSSKeyframesRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSValue
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"animationName"
    Parser ([CSSCSSKeyframeRule] -> CSSCSSKeyframesRule)
-> Parser [CSSCSSKeyframeRule] -> Parser CSSCSSKeyframesRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [CSSCSSKeyframeRule]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyframes"
instance ToJSON CSSCSSKeyframesRule where
  toJSON :: CSSCSSKeyframesRule -> Value
toJSON CSSCSSKeyframesRule
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
"animationName" Text -> CSSValue -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSValue -> Pair) -> Maybe CSSValue -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSValue -> Maybe CSSValue
forall a. a -> Maybe a
Just (CSSCSSKeyframesRule -> CSSValue
cSSCSSKeyframesRuleAnimationName CSSCSSKeyframesRule
p),
    (Text
"keyframes" Text -> [CSSCSSKeyframeRule] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSKeyframeRule] -> Pair)
-> Maybe [CSSCSSKeyframeRule] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSCSSKeyframeRule] -> Maybe [CSSCSSKeyframeRule]
forall a. a -> Maybe a
Just (CSSCSSKeyframesRule -> [CSSCSSKeyframeRule]
cSSCSSKeyframesRuleKeyframes CSSCSSKeyframesRule
p)
    ]

-- | Type 'CSS.CSSKeyframeRule'.
--   CSS keyframe rule representation.
data CSSCSSKeyframeRule = CSSCSSKeyframeRule
  {
    -- | The css style sheet identifier (absent for user agent stylesheet and user-specified
    --   stylesheet rules) this rule came from.
    CSSCSSKeyframeRule -> Maybe Text
cSSCSSKeyframeRuleStyleSheetId :: Maybe CSSStyleSheetId,
    -- | Parent stylesheet's origin.
    CSSCSSKeyframeRule -> CSSStyleSheetOrigin
cSSCSSKeyframeRuleOrigin :: CSSStyleSheetOrigin,
    -- | Associated key text.
    CSSCSSKeyframeRule -> CSSValue
cSSCSSKeyframeRuleKeyText :: CSSValue,
    -- | Associated style declaration.
    CSSCSSKeyframeRule -> CSSCSSStyle
cSSCSSKeyframeRuleStyle :: CSSCSSStyle
  }
  deriving (CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool
(CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool)
-> (CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool)
-> Eq CSSCSSKeyframeRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool
$c/= :: CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool
== :: CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool
$c== :: CSSCSSKeyframeRule -> CSSCSSKeyframeRule -> Bool
Eq, Int -> CSSCSSKeyframeRule -> ShowS
[CSSCSSKeyframeRule] -> ShowS
CSSCSSKeyframeRule -> String
(Int -> CSSCSSKeyframeRule -> ShowS)
-> (CSSCSSKeyframeRule -> String)
-> ([CSSCSSKeyframeRule] -> ShowS)
-> Show CSSCSSKeyframeRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCSSKeyframeRule] -> ShowS
$cshowList :: [CSSCSSKeyframeRule] -> ShowS
show :: CSSCSSKeyframeRule -> String
$cshow :: CSSCSSKeyframeRule -> String
showsPrec :: Int -> CSSCSSKeyframeRule -> ShowS
$cshowsPrec :: Int -> CSSCSSKeyframeRule -> ShowS
Show)
instance FromJSON CSSCSSKeyframeRule where
  parseJSON :: Value -> Parser CSSCSSKeyframeRule
parseJSON = String
-> (Object -> Parser CSSCSSKeyframeRule)
-> Value
-> Parser CSSCSSKeyframeRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCSSKeyframeRule" ((Object -> Parser CSSCSSKeyframeRule)
 -> Value -> Parser CSSCSSKeyframeRule)
-> (Object -> Parser CSSCSSKeyframeRule)
-> Value
-> Parser CSSCSSKeyframeRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> CSSStyleSheetOrigin
-> CSSValue
-> CSSCSSStyle
-> CSSCSSKeyframeRule
CSSCSSKeyframeRule
    (Maybe Text
 -> CSSStyleSheetOrigin
 -> CSSValue
 -> CSSCSSStyle
 -> CSSCSSKeyframeRule)
-> Parser (Maybe Text)
-> Parser
     (CSSStyleSheetOrigin
      -> CSSValue -> CSSCSSStyle -> CSSCSSKeyframeRule)
forall (f :: * -> *) a b. Functor 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
"styleSheetId"
    Parser
  (CSSStyleSheetOrigin
   -> CSSValue -> CSSCSSStyle -> CSSCSSKeyframeRule)
-> Parser CSSStyleSheetOrigin
-> Parser (CSSValue -> CSSCSSStyle -> CSSCSSKeyframeRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSStyleSheetOrigin
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"origin"
    Parser (CSSValue -> CSSCSSStyle -> CSSCSSKeyframeRule)
-> Parser CSSValue -> Parser (CSSCSSStyle -> CSSCSSKeyframeRule)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSValue
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyText"
    Parser (CSSCSSStyle -> CSSCSSKeyframeRule)
-> Parser CSSCSSStyle -> Parser CSSCSSKeyframeRule
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSCSSStyle
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"style"
instance ToJSON CSSCSSKeyframeRule where
  toJSON :: CSSCSSKeyframeRule -> Value
toJSON CSSCSSKeyframeRule
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
"styleSheetId" 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
<$> (CSSCSSKeyframeRule -> Maybe Text
cSSCSSKeyframeRuleStyleSheetId CSSCSSKeyframeRule
p),
    (Text
"origin" Text -> CSSStyleSheetOrigin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSStyleSheetOrigin -> Pair)
-> Maybe CSSStyleSheetOrigin -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSStyleSheetOrigin -> Maybe CSSStyleSheetOrigin
forall a. a -> Maybe a
Just (CSSCSSKeyframeRule -> CSSStyleSheetOrigin
cSSCSSKeyframeRuleOrigin CSSCSSKeyframeRule
p),
    (Text
"keyText" Text -> CSSValue -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSValue -> Pair) -> Maybe CSSValue -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSValue -> Maybe CSSValue
forall a. a -> Maybe a
Just (CSSCSSKeyframeRule -> CSSValue
cSSCSSKeyframeRuleKeyText CSSCSSKeyframeRule
p),
    (Text
"style" Text -> CSSCSSStyle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSCSSStyle -> Pair) -> Maybe CSSCSSStyle -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSCSSStyle -> Maybe CSSCSSStyle
forall a. a -> Maybe a
Just (CSSCSSKeyframeRule -> CSSCSSStyle
cSSCSSKeyframeRuleStyle CSSCSSKeyframeRule
p)
    ]

-- | Type 'CSS.StyleDeclarationEdit'.
--   A descriptor of operation to mutate style declaration text.
data CSSStyleDeclarationEdit = CSSStyleDeclarationEdit
  {
    -- | The css style sheet identifier.
    CSSStyleDeclarationEdit -> Text
cSSStyleDeclarationEditStyleSheetId :: CSSStyleSheetId,
    -- | The range of the style text in the enclosing stylesheet.
    CSSStyleDeclarationEdit -> CSSSourceRange
cSSStyleDeclarationEditRange :: CSSSourceRange,
    -- | New style text.
    CSSStyleDeclarationEdit -> Text
cSSStyleDeclarationEditText :: T.Text
  }
  deriving (CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool
(CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool)
-> (CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool)
-> Eq CSSStyleDeclarationEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool
$c/= :: CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool
== :: CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool
$c== :: CSSStyleDeclarationEdit -> CSSStyleDeclarationEdit -> Bool
Eq, Int -> CSSStyleDeclarationEdit -> ShowS
[CSSStyleDeclarationEdit] -> ShowS
CSSStyleDeclarationEdit -> String
(Int -> CSSStyleDeclarationEdit -> ShowS)
-> (CSSStyleDeclarationEdit -> String)
-> ([CSSStyleDeclarationEdit] -> ShowS)
-> Show CSSStyleDeclarationEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSStyleDeclarationEdit] -> ShowS
$cshowList :: [CSSStyleDeclarationEdit] -> ShowS
show :: CSSStyleDeclarationEdit -> String
$cshow :: CSSStyleDeclarationEdit -> String
showsPrec :: Int -> CSSStyleDeclarationEdit -> ShowS
$cshowsPrec :: Int -> CSSStyleDeclarationEdit -> ShowS
Show)
instance FromJSON CSSStyleDeclarationEdit where
  parseJSON :: Value -> Parser CSSStyleDeclarationEdit
parseJSON = String
-> (Object -> Parser CSSStyleDeclarationEdit)
-> Value
-> Parser CSSStyleDeclarationEdit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSStyleDeclarationEdit" ((Object -> Parser CSSStyleDeclarationEdit)
 -> Value -> Parser CSSStyleDeclarationEdit)
-> (Object -> Parser CSSStyleDeclarationEdit)
-> Value
-> Parser CSSStyleDeclarationEdit
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CSSSourceRange -> Text -> CSSStyleDeclarationEdit
CSSStyleDeclarationEdit
    (Text -> CSSSourceRange -> Text -> CSSStyleDeclarationEdit)
-> Parser Text
-> Parser (CSSSourceRange -> Text -> CSSStyleDeclarationEdit)
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
"styleSheetId"
    Parser (CSSSourceRange -> Text -> CSSStyleDeclarationEdit)
-> Parser CSSSourceRange
-> Parser (Text -> CSSStyleDeclarationEdit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CSSSourceRange
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"range"
    Parser (Text -> CSSStyleDeclarationEdit)
-> Parser Text -> Parser CSSStyleDeclarationEdit
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
"text"
instance ToJSON CSSStyleDeclarationEdit where
  toJSON :: CSSStyleDeclarationEdit -> Value
toJSON CSSStyleDeclarationEdit
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
"styleSheetId" 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 (CSSStyleDeclarationEdit -> Text
cSSStyleDeclarationEditStyleSheetId CSSStyleDeclarationEdit
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (CSSStyleDeclarationEdit -> CSSSourceRange
cSSStyleDeclarationEditRange CSSStyleDeclarationEdit
p),
    (Text
"text" 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 (CSSStyleDeclarationEdit -> Text
cSSStyleDeclarationEditText CSSStyleDeclarationEdit
p)
    ]

-- | Type of the 'CSS.fontsUpdated' event.
data CSSFontsUpdated = CSSFontsUpdated
  {
    -- | The web font that has loaded.
    CSSFontsUpdated -> Maybe CSSFontFace
cSSFontsUpdatedFont :: Maybe CSSFontFace
  }
  deriving (CSSFontsUpdated -> CSSFontsUpdated -> Bool
(CSSFontsUpdated -> CSSFontsUpdated -> Bool)
-> (CSSFontsUpdated -> CSSFontsUpdated -> Bool)
-> Eq CSSFontsUpdated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSFontsUpdated -> CSSFontsUpdated -> Bool
$c/= :: CSSFontsUpdated -> CSSFontsUpdated -> Bool
== :: CSSFontsUpdated -> CSSFontsUpdated -> Bool
$c== :: CSSFontsUpdated -> CSSFontsUpdated -> Bool
Eq, Int -> CSSFontsUpdated -> ShowS
[CSSFontsUpdated] -> ShowS
CSSFontsUpdated -> String
(Int -> CSSFontsUpdated -> ShowS)
-> (CSSFontsUpdated -> String)
-> ([CSSFontsUpdated] -> ShowS)
-> Show CSSFontsUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSFontsUpdated] -> ShowS
$cshowList :: [CSSFontsUpdated] -> ShowS
show :: CSSFontsUpdated -> String
$cshow :: CSSFontsUpdated -> String
showsPrec :: Int -> CSSFontsUpdated -> ShowS
$cshowsPrec :: Int -> CSSFontsUpdated -> ShowS
Show)
instance FromJSON CSSFontsUpdated where
  parseJSON :: Value -> Parser CSSFontsUpdated
parseJSON = String
-> (Object -> Parser CSSFontsUpdated)
-> Value
-> Parser CSSFontsUpdated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSFontsUpdated" ((Object -> Parser CSSFontsUpdated)
 -> Value -> Parser CSSFontsUpdated)
-> (Object -> Parser CSSFontsUpdated)
-> Value
-> Parser CSSFontsUpdated
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe CSSFontFace -> CSSFontsUpdated
CSSFontsUpdated
    (Maybe CSSFontFace -> CSSFontsUpdated)
-> Parser (Maybe CSSFontFace) -> Parser CSSFontsUpdated
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe CSSFontFace)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"font"
instance Event CSSFontsUpdated where
  eventName :: Proxy CSSFontsUpdated -> String
eventName Proxy CSSFontsUpdated
_ = String
"CSS.fontsUpdated"

-- | Type of the 'CSS.mediaQueryResultChanged' event.
data CSSMediaQueryResultChanged = CSSMediaQueryResultChanged
  deriving (CSSMediaQueryResultChanged -> CSSMediaQueryResultChanged -> Bool
(CSSMediaQueryResultChanged -> CSSMediaQueryResultChanged -> Bool)
-> (CSSMediaQueryResultChanged
    -> CSSMediaQueryResultChanged -> Bool)
-> Eq CSSMediaQueryResultChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSMediaQueryResultChanged -> CSSMediaQueryResultChanged -> Bool
$c/= :: CSSMediaQueryResultChanged -> CSSMediaQueryResultChanged -> Bool
== :: CSSMediaQueryResultChanged -> CSSMediaQueryResultChanged -> Bool
$c== :: CSSMediaQueryResultChanged -> CSSMediaQueryResultChanged -> Bool
Eq, Int -> CSSMediaQueryResultChanged -> ShowS
[CSSMediaQueryResultChanged] -> ShowS
CSSMediaQueryResultChanged -> String
(Int -> CSSMediaQueryResultChanged -> ShowS)
-> (CSSMediaQueryResultChanged -> String)
-> ([CSSMediaQueryResultChanged] -> ShowS)
-> Show CSSMediaQueryResultChanged
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSMediaQueryResultChanged] -> ShowS
$cshowList :: [CSSMediaQueryResultChanged] -> ShowS
show :: CSSMediaQueryResultChanged -> String
$cshow :: CSSMediaQueryResultChanged -> String
showsPrec :: Int -> CSSMediaQueryResultChanged -> ShowS
$cshowsPrec :: Int -> CSSMediaQueryResultChanged -> ShowS
Show, ReadPrec [CSSMediaQueryResultChanged]
ReadPrec CSSMediaQueryResultChanged
Int -> ReadS CSSMediaQueryResultChanged
ReadS [CSSMediaQueryResultChanged]
(Int -> ReadS CSSMediaQueryResultChanged)
-> ReadS [CSSMediaQueryResultChanged]
-> ReadPrec CSSMediaQueryResultChanged
-> ReadPrec [CSSMediaQueryResultChanged]
-> Read CSSMediaQueryResultChanged
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CSSMediaQueryResultChanged]
$creadListPrec :: ReadPrec [CSSMediaQueryResultChanged]
readPrec :: ReadPrec CSSMediaQueryResultChanged
$creadPrec :: ReadPrec CSSMediaQueryResultChanged
readList :: ReadS [CSSMediaQueryResultChanged]
$creadList :: ReadS [CSSMediaQueryResultChanged]
readsPrec :: Int -> ReadS CSSMediaQueryResultChanged
$creadsPrec :: Int -> ReadS CSSMediaQueryResultChanged
Read)
instance FromJSON CSSMediaQueryResultChanged where
  parseJSON :: Value -> Parser CSSMediaQueryResultChanged
parseJSON Value
_ = CSSMediaQueryResultChanged -> Parser CSSMediaQueryResultChanged
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSSMediaQueryResultChanged
CSSMediaQueryResultChanged
instance Event CSSMediaQueryResultChanged where
  eventName :: Proxy CSSMediaQueryResultChanged -> String
eventName Proxy CSSMediaQueryResultChanged
_ = String
"CSS.mediaQueryResultChanged"

-- | Type of the 'CSS.styleSheetAdded' event.
data CSSStyleSheetAdded = CSSStyleSheetAdded
  {
    -- | Added stylesheet metainfo.
    CSSStyleSheetAdded -> CSSCSSStyleSheetHeader
cSSStyleSheetAddedHeader :: CSSCSSStyleSheetHeader
  }
  deriving (CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool
(CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool)
-> (CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool)
-> Eq CSSStyleSheetAdded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool
$c/= :: CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool
== :: CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool
$c== :: CSSStyleSheetAdded -> CSSStyleSheetAdded -> Bool
Eq, Int -> CSSStyleSheetAdded -> ShowS
[CSSStyleSheetAdded] -> ShowS
CSSStyleSheetAdded -> String
(Int -> CSSStyleSheetAdded -> ShowS)
-> (CSSStyleSheetAdded -> String)
-> ([CSSStyleSheetAdded] -> ShowS)
-> Show CSSStyleSheetAdded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSStyleSheetAdded] -> ShowS
$cshowList :: [CSSStyleSheetAdded] -> ShowS
show :: CSSStyleSheetAdded -> String
$cshow :: CSSStyleSheetAdded -> String
showsPrec :: Int -> CSSStyleSheetAdded -> ShowS
$cshowsPrec :: Int -> CSSStyleSheetAdded -> ShowS
Show)
instance FromJSON CSSStyleSheetAdded where
  parseJSON :: Value -> Parser CSSStyleSheetAdded
parseJSON = String
-> (Object -> Parser CSSStyleSheetAdded)
-> Value
-> Parser CSSStyleSheetAdded
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSStyleSheetAdded" ((Object -> Parser CSSStyleSheetAdded)
 -> Value -> Parser CSSStyleSheetAdded)
-> (Object -> Parser CSSStyleSheetAdded)
-> Value
-> Parser CSSStyleSheetAdded
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSStyleSheetHeader -> CSSStyleSheetAdded
CSSStyleSheetAdded
    (CSSCSSStyleSheetHeader -> CSSStyleSheetAdded)
-> Parser CSSCSSStyleSheetHeader -> Parser CSSStyleSheetAdded
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSStyleSheetHeader
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"header"
instance Event CSSStyleSheetAdded where
  eventName :: Proxy CSSStyleSheetAdded -> String
eventName Proxy CSSStyleSheetAdded
_ = String
"CSS.styleSheetAdded"

-- | Type of the 'CSS.styleSheetChanged' event.
data CSSStyleSheetChanged = CSSStyleSheetChanged
  {
    CSSStyleSheetChanged -> Text
cSSStyleSheetChangedStyleSheetId :: CSSStyleSheetId
  }
  deriving (CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool
(CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool)
-> (CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool)
-> Eq CSSStyleSheetChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool
$c/= :: CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool
== :: CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool
$c== :: CSSStyleSheetChanged -> CSSStyleSheetChanged -> Bool
Eq, Int -> CSSStyleSheetChanged -> ShowS
[CSSStyleSheetChanged] -> ShowS
CSSStyleSheetChanged -> String
(Int -> CSSStyleSheetChanged -> ShowS)
-> (CSSStyleSheetChanged -> String)
-> ([CSSStyleSheetChanged] -> ShowS)
-> Show CSSStyleSheetChanged
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSStyleSheetChanged] -> ShowS
$cshowList :: [CSSStyleSheetChanged] -> ShowS
show :: CSSStyleSheetChanged -> String
$cshow :: CSSStyleSheetChanged -> String
showsPrec :: Int -> CSSStyleSheetChanged -> ShowS
$cshowsPrec :: Int -> CSSStyleSheetChanged -> ShowS
Show)
instance FromJSON CSSStyleSheetChanged where
  parseJSON :: Value -> Parser CSSStyleSheetChanged
parseJSON = String
-> (Object -> Parser CSSStyleSheetChanged)
-> Value
-> Parser CSSStyleSheetChanged
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSStyleSheetChanged" ((Object -> Parser CSSStyleSheetChanged)
 -> Value -> Parser CSSStyleSheetChanged)
-> (Object -> Parser CSSStyleSheetChanged)
-> Value
-> Parser CSSStyleSheetChanged
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CSSStyleSheetChanged
CSSStyleSheetChanged
    (Text -> CSSStyleSheetChanged)
-> Parser Text -> Parser CSSStyleSheetChanged
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
"styleSheetId"
instance Event CSSStyleSheetChanged where
  eventName :: Proxy CSSStyleSheetChanged -> String
eventName Proxy CSSStyleSheetChanged
_ = String
"CSS.styleSheetChanged"

-- | Type of the 'CSS.styleSheetRemoved' event.
data CSSStyleSheetRemoved = CSSStyleSheetRemoved
  {
    -- | Identifier of the removed stylesheet.
    CSSStyleSheetRemoved -> Text
cSSStyleSheetRemovedStyleSheetId :: CSSStyleSheetId
  }
  deriving (CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool
(CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool)
-> (CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool)
-> Eq CSSStyleSheetRemoved
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool
$c/= :: CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool
== :: CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool
$c== :: CSSStyleSheetRemoved -> CSSStyleSheetRemoved -> Bool
Eq, Int -> CSSStyleSheetRemoved -> ShowS
[CSSStyleSheetRemoved] -> ShowS
CSSStyleSheetRemoved -> String
(Int -> CSSStyleSheetRemoved -> ShowS)
-> (CSSStyleSheetRemoved -> String)
-> ([CSSStyleSheetRemoved] -> ShowS)
-> Show CSSStyleSheetRemoved
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSStyleSheetRemoved] -> ShowS
$cshowList :: [CSSStyleSheetRemoved] -> ShowS
show :: CSSStyleSheetRemoved -> String
$cshow :: CSSStyleSheetRemoved -> String
showsPrec :: Int -> CSSStyleSheetRemoved -> ShowS
$cshowsPrec :: Int -> CSSStyleSheetRemoved -> ShowS
Show)
instance FromJSON CSSStyleSheetRemoved where
  parseJSON :: Value -> Parser CSSStyleSheetRemoved
parseJSON = String
-> (Object -> Parser CSSStyleSheetRemoved)
-> Value
-> Parser CSSStyleSheetRemoved
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSStyleSheetRemoved" ((Object -> Parser CSSStyleSheetRemoved)
 -> Value -> Parser CSSStyleSheetRemoved)
-> (Object -> Parser CSSStyleSheetRemoved)
-> Value
-> Parser CSSStyleSheetRemoved
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CSSStyleSheetRemoved
CSSStyleSheetRemoved
    (Text -> CSSStyleSheetRemoved)
-> Parser Text -> Parser CSSStyleSheetRemoved
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
"styleSheetId"
instance Event CSSStyleSheetRemoved where
  eventName :: Proxy CSSStyleSheetRemoved -> String
eventName Proxy CSSStyleSheetRemoved
_ = String
"CSS.styleSheetRemoved"

-- | Inserts a new rule with the given `ruleText` in a stylesheet with given `styleSheetId`, at the
--   position specified by `location`.

-- | Parameters of the 'CSS.addRule' command.
data PCSSAddRule = PCSSAddRule
  {
    -- | The css style sheet identifier where a new rule should be inserted.
    PCSSAddRule -> Text
pCSSAddRuleStyleSheetId :: CSSStyleSheetId,
    -- | The text of a new rule.
    PCSSAddRule -> Text
pCSSAddRuleRuleText :: T.Text,
    -- | Text position of a new rule in the target style sheet.
    PCSSAddRule -> CSSSourceRange
pCSSAddRuleLocation :: CSSSourceRange
  }
  deriving (PCSSAddRule -> PCSSAddRule -> Bool
(PCSSAddRule -> PCSSAddRule -> Bool)
-> (PCSSAddRule -> PCSSAddRule -> Bool) -> Eq PCSSAddRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSAddRule -> PCSSAddRule -> Bool
$c/= :: PCSSAddRule -> PCSSAddRule -> Bool
== :: PCSSAddRule -> PCSSAddRule -> Bool
$c== :: PCSSAddRule -> PCSSAddRule -> Bool
Eq, Int -> PCSSAddRule -> ShowS
[PCSSAddRule] -> ShowS
PCSSAddRule -> String
(Int -> PCSSAddRule -> ShowS)
-> (PCSSAddRule -> String)
-> ([PCSSAddRule] -> ShowS)
-> Show PCSSAddRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSAddRule] -> ShowS
$cshowList :: [PCSSAddRule] -> ShowS
show :: PCSSAddRule -> String
$cshow :: PCSSAddRule -> String
showsPrec :: Int -> PCSSAddRule -> ShowS
$cshowsPrec :: Int -> PCSSAddRule -> ShowS
Show)
pCSSAddRule
  {-
  -- | The css style sheet identifier where a new rule should be inserted.
  -}
  :: CSSStyleSheetId
  {-
  -- | The text of a new rule.
  -}
  -> T.Text
  {-
  -- | Text position of a new rule in the target style sheet.
  -}
  -> CSSSourceRange
  -> PCSSAddRule
pCSSAddRule :: Text -> Text -> CSSSourceRange -> PCSSAddRule
pCSSAddRule
  Text
arg_pCSSAddRuleStyleSheetId
  Text
arg_pCSSAddRuleRuleText
  CSSSourceRange
arg_pCSSAddRuleLocation
  = Text -> Text -> CSSSourceRange -> PCSSAddRule
PCSSAddRule
    Text
arg_pCSSAddRuleStyleSheetId
    Text
arg_pCSSAddRuleRuleText
    CSSSourceRange
arg_pCSSAddRuleLocation
instance ToJSON PCSSAddRule where
  toJSON :: PCSSAddRule -> Value
toJSON PCSSAddRule
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
"styleSheetId" 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 (PCSSAddRule -> Text
pCSSAddRuleStyleSheetId PCSSAddRule
p),
    (Text
"ruleText" 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 (PCSSAddRule -> Text
pCSSAddRuleRuleText PCSSAddRule
p),
    (Text
"location" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSAddRule -> CSSSourceRange
pCSSAddRuleLocation PCSSAddRule
p)
    ]
data CSSAddRule = CSSAddRule
  {
    -- | The newly created rule.
    CSSAddRule -> CSSCSSRule
cSSAddRuleRule :: CSSCSSRule
  }
  deriving (CSSAddRule -> CSSAddRule -> Bool
(CSSAddRule -> CSSAddRule -> Bool)
-> (CSSAddRule -> CSSAddRule -> Bool) -> Eq CSSAddRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSAddRule -> CSSAddRule -> Bool
$c/= :: CSSAddRule -> CSSAddRule -> Bool
== :: CSSAddRule -> CSSAddRule -> Bool
$c== :: CSSAddRule -> CSSAddRule -> Bool
Eq, Int -> CSSAddRule -> ShowS
[CSSAddRule] -> ShowS
CSSAddRule -> String
(Int -> CSSAddRule -> ShowS)
-> (CSSAddRule -> String)
-> ([CSSAddRule] -> ShowS)
-> Show CSSAddRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSAddRule] -> ShowS
$cshowList :: [CSSAddRule] -> ShowS
show :: CSSAddRule -> String
$cshow :: CSSAddRule -> String
showsPrec :: Int -> CSSAddRule -> ShowS
$cshowsPrec :: Int -> CSSAddRule -> ShowS
Show)
instance FromJSON CSSAddRule where
  parseJSON :: Value -> Parser CSSAddRule
parseJSON = String
-> (Object -> Parser CSSAddRule) -> Value -> Parser CSSAddRule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSAddRule" ((Object -> Parser CSSAddRule) -> Value -> Parser CSSAddRule)
-> (Object -> Parser CSSAddRule) -> Value -> Parser CSSAddRule
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSRule -> CSSAddRule
CSSAddRule
    (CSSCSSRule -> CSSAddRule)
-> Parser CSSCSSRule -> Parser CSSAddRule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSRule
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"rule"
instance Command PCSSAddRule where
  type CommandResponse PCSSAddRule = CSSAddRule
  commandName :: Proxy PCSSAddRule -> String
commandName Proxy PCSSAddRule
_ = String
"CSS.addRule"

-- | Returns all class names from specified stylesheet.

-- | Parameters of the 'CSS.collectClassNames' command.
data PCSSCollectClassNames = PCSSCollectClassNames
  {
    PCSSCollectClassNames -> Text
pCSSCollectClassNamesStyleSheetId :: CSSStyleSheetId
  }
  deriving (PCSSCollectClassNames -> PCSSCollectClassNames -> Bool
(PCSSCollectClassNames -> PCSSCollectClassNames -> Bool)
-> (PCSSCollectClassNames -> PCSSCollectClassNames -> Bool)
-> Eq PCSSCollectClassNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSCollectClassNames -> PCSSCollectClassNames -> Bool
$c/= :: PCSSCollectClassNames -> PCSSCollectClassNames -> Bool
== :: PCSSCollectClassNames -> PCSSCollectClassNames -> Bool
$c== :: PCSSCollectClassNames -> PCSSCollectClassNames -> Bool
Eq, Int -> PCSSCollectClassNames -> ShowS
[PCSSCollectClassNames] -> ShowS
PCSSCollectClassNames -> String
(Int -> PCSSCollectClassNames -> ShowS)
-> (PCSSCollectClassNames -> String)
-> ([PCSSCollectClassNames] -> ShowS)
-> Show PCSSCollectClassNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSCollectClassNames] -> ShowS
$cshowList :: [PCSSCollectClassNames] -> ShowS
show :: PCSSCollectClassNames -> String
$cshow :: PCSSCollectClassNames -> String
showsPrec :: Int -> PCSSCollectClassNames -> ShowS
$cshowsPrec :: Int -> PCSSCollectClassNames -> ShowS
Show)
pCSSCollectClassNames
  :: CSSStyleSheetId
  -> PCSSCollectClassNames
pCSSCollectClassNames :: Text -> PCSSCollectClassNames
pCSSCollectClassNames
  Text
arg_pCSSCollectClassNamesStyleSheetId
  = Text -> PCSSCollectClassNames
PCSSCollectClassNames
    Text
arg_pCSSCollectClassNamesStyleSheetId
instance ToJSON PCSSCollectClassNames where
  toJSON :: PCSSCollectClassNames -> Value
toJSON PCSSCollectClassNames
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
"styleSheetId" 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 (PCSSCollectClassNames -> Text
pCSSCollectClassNamesStyleSheetId PCSSCollectClassNames
p)
    ]
data CSSCollectClassNames = CSSCollectClassNames
  {
    -- | Class name list.
    CSSCollectClassNames -> [Text]
cSSCollectClassNamesClassNames :: [T.Text]
  }
  deriving (CSSCollectClassNames -> CSSCollectClassNames -> Bool
(CSSCollectClassNames -> CSSCollectClassNames -> Bool)
-> (CSSCollectClassNames -> CSSCollectClassNames -> Bool)
-> Eq CSSCollectClassNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCollectClassNames -> CSSCollectClassNames -> Bool
$c/= :: CSSCollectClassNames -> CSSCollectClassNames -> Bool
== :: CSSCollectClassNames -> CSSCollectClassNames -> Bool
$c== :: CSSCollectClassNames -> CSSCollectClassNames -> Bool
Eq, Int -> CSSCollectClassNames -> ShowS
[CSSCollectClassNames] -> ShowS
CSSCollectClassNames -> String
(Int -> CSSCollectClassNames -> ShowS)
-> (CSSCollectClassNames -> String)
-> ([CSSCollectClassNames] -> ShowS)
-> Show CSSCollectClassNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCollectClassNames] -> ShowS
$cshowList :: [CSSCollectClassNames] -> ShowS
show :: CSSCollectClassNames -> String
$cshow :: CSSCollectClassNames -> String
showsPrec :: Int -> CSSCollectClassNames -> ShowS
$cshowsPrec :: Int -> CSSCollectClassNames -> ShowS
Show)
instance FromJSON CSSCollectClassNames where
  parseJSON :: Value -> Parser CSSCollectClassNames
parseJSON = String
-> (Object -> Parser CSSCollectClassNames)
-> Value
-> Parser CSSCollectClassNames
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCollectClassNames" ((Object -> Parser CSSCollectClassNames)
 -> Value -> Parser CSSCollectClassNames)
-> (Object -> Parser CSSCollectClassNames)
-> Value
-> Parser CSSCollectClassNames
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Text] -> CSSCollectClassNames
CSSCollectClassNames
    ([Text] -> CSSCollectClassNames)
-> Parser [Text] -> Parser CSSCollectClassNames
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
"classNames"
instance Command PCSSCollectClassNames where
  type CommandResponse PCSSCollectClassNames = CSSCollectClassNames
  commandName :: Proxy PCSSCollectClassNames -> String
commandName Proxy PCSSCollectClassNames
_ = String
"CSS.collectClassNames"

-- | Creates a new special "via-inspector" stylesheet in the frame with given `frameId`.

-- | Parameters of the 'CSS.createStyleSheet' command.
data PCSSCreateStyleSheet = PCSSCreateStyleSheet
  {
    -- | Identifier of the frame where "via-inspector" stylesheet should be created.
    PCSSCreateStyleSheet -> Text
pCSSCreateStyleSheetFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId
  }
  deriving (PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool
(PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool)
-> (PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool)
-> Eq PCSSCreateStyleSheet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool
$c/= :: PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool
== :: PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool
$c== :: PCSSCreateStyleSheet -> PCSSCreateStyleSheet -> Bool
Eq, Int -> PCSSCreateStyleSheet -> ShowS
[PCSSCreateStyleSheet] -> ShowS
PCSSCreateStyleSheet -> String
(Int -> PCSSCreateStyleSheet -> ShowS)
-> (PCSSCreateStyleSheet -> String)
-> ([PCSSCreateStyleSheet] -> ShowS)
-> Show PCSSCreateStyleSheet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSCreateStyleSheet] -> ShowS
$cshowList :: [PCSSCreateStyleSheet] -> ShowS
show :: PCSSCreateStyleSheet -> String
$cshow :: PCSSCreateStyleSheet -> String
showsPrec :: Int -> PCSSCreateStyleSheet -> ShowS
$cshowsPrec :: Int -> PCSSCreateStyleSheet -> ShowS
Show)
pCSSCreateStyleSheet
  {-
  -- | Identifier of the frame where "via-inspector" stylesheet should be created.
  -}
  :: DOMPageNetworkEmulationSecurity.PageFrameId
  -> PCSSCreateStyleSheet
pCSSCreateStyleSheet :: Text -> PCSSCreateStyleSheet
pCSSCreateStyleSheet
  Text
arg_pCSSCreateStyleSheetFrameId
  = Text -> PCSSCreateStyleSheet
PCSSCreateStyleSheet
    Text
arg_pCSSCreateStyleSheetFrameId
instance ToJSON PCSSCreateStyleSheet where
  toJSON :: PCSSCreateStyleSheet -> Value
toJSON PCSSCreateStyleSheet
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
"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
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PCSSCreateStyleSheet -> Text
pCSSCreateStyleSheetFrameId PCSSCreateStyleSheet
p)
    ]
data CSSCreateStyleSheet = CSSCreateStyleSheet
  {
    -- | Identifier of the created "via-inspector" stylesheet.
    CSSCreateStyleSheet -> Text
cSSCreateStyleSheetStyleSheetId :: CSSStyleSheetId
  }
  deriving (CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool
(CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool)
-> (CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool)
-> Eq CSSCreateStyleSheet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool
$c/= :: CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool
== :: CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool
$c== :: CSSCreateStyleSheet -> CSSCreateStyleSheet -> Bool
Eq, Int -> CSSCreateStyleSheet -> ShowS
[CSSCreateStyleSheet] -> ShowS
CSSCreateStyleSheet -> String
(Int -> CSSCreateStyleSheet -> ShowS)
-> (CSSCreateStyleSheet -> String)
-> ([CSSCreateStyleSheet] -> ShowS)
-> Show CSSCreateStyleSheet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSCreateStyleSheet] -> ShowS
$cshowList :: [CSSCreateStyleSheet] -> ShowS
show :: CSSCreateStyleSheet -> String
$cshow :: CSSCreateStyleSheet -> String
showsPrec :: Int -> CSSCreateStyleSheet -> ShowS
$cshowsPrec :: Int -> CSSCreateStyleSheet -> ShowS
Show)
instance FromJSON CSSCreateStyleSheet where
  parseJSON :: Value -> Parser CSSCreateStyleSheet
parseJSON = String
-> (Object -> Parser CSSCreateStyleSheet)
-> Value
-> Parser CSSCreateStyleSheet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSCreateStyleSheet" ((Object -> Parser CSSCreateStyleSheet)
 -> Value -> Parser CSSCreateStyleSheet)
-> (Object -> Parser CSSCreateStyleSheet)
-> Value
-> Parser CSSCreateStyleSheet
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CSSCreateStyleSheet
CSSCreateStyleSheet
    (Text -> CSSCreateStyleSheet)
-> Parser Text -> Parser CSSCreateStyleSheet
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
"styleSheetId"
instance Command PCSSCreateStyleSheet where
  type CommandResponse PCSSCreateStyleSheet = CSSCreateStyleSheet
  commandName :: Proxy PCSSCreateStyleSheet -> String
commandName Proxy PCSSCreateStyleSheet
_ = String
"CSS.createStyleSheet"

-- | Disables the CSS agent for the given page.

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

-- | Enables the CSS agent for the given page. Clients should not assume that the CSS agent has been
--   enabled until the result of this command is received.

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

-- | Ensures that the given node will have specified pseudo-classes whenever its style is computed by
--   the browser.

-- | Parameters of the 'CSS.forcePseudoState' command.
data PCSSForcePseudoState = PCSSForcePseudoState
  {
    -- | The element id for which to force the pseudo state.
    PCSSForcePseudoState -> Int
pCSSForcePseudoStateNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId,
    -- | Element pseudo classes to force when computing the element's style.
    PCSSForcePseudoState -> [Text]
pCSSForcePseudoStateForcedPseudoClasses :: [T.Text]
  }
  deriving (PCSSForcePseudoState -> PCSSForcePseudoState -> Bool
(PCSSForcePseudoState -> PCSSForcePseudoState -> Bool)
-> (PCSSForcePseudoState -> PCSSForcePseudoState -> Bool)
-> Eq PCSSForcePseudoState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSForcePseudoState -> PCSSForcePseudoState -> Bool
$c/= :: PCSSForcePseudoState -> PCSSForcePseudoState -> Bool
== :: PCSSForcePseudoState -> PCSSForcePseudoState -> Bool
$c== :: PCSSForcePseudoState -> PCSSForcePseudoState -> Bool
Eq, Int -> PCSSForcePseudoState -> ShowS
[PCSSForcePseudoState] -> ShowS
PCSSForcePseudoState -> String
(Int -> PCSSForcePseudoState -> ShowS)
-> (PCSSForcePseudoState -> String)
-> ([PCSSForcePseudoState] -> ShowS)
-> Show PCSSForcePseudoState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSForcePseudoState] -> ShowS
$cshowList :: [PCSSForcePseudoState] -> ShowS
show :: PCSSForcePseudoState -> String
$cshow :: PCSSForcePseudoState -> String
showsPrec :: Int -> PCSSForcePseudoState -> ShowS
$cshowsPrec :: Int -> PCSSForcePseudoState -> ShowS
Show)
pCSSForcePseudoState
  {-
  -- | The element id for which to force the pseudo state.
  -}
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  {-
  -- | Element pseudo classes to force when computing the element's style.
  -}
  -> [T.Text]
  -> PCSSForcePseudoState
pCSSForcePseudoState :: Int -> [Text] -> PCSSForcePseudoState
pCSSForcePseudoState
  Int
arg_pCSSForcePseudoStateNodeId
  [Text]
arg_pCSSForcePseudoStateForcedPseudoClasses
  = Int -> [Text] -> PCSSForcePseudoState
PCSSForcePseudoState
    Int
arg_pCSSForcePseudoStateNodeId
    [Text]
arg_pCSSForcePseudoStateForcedPseudoClasses
instance ToJSON PCSSForcePseudoState where
  toJSON :: PCSSForcePseudoState -> Value
toJSON PCSSForcePseudoState
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
"nodeId" 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 (PCSSForcePseudoState -> Int
pCSSForcePseudoStateNodeId PCSSForcePseudoState
p),
    (Text
"forcedPseudoClasses" 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 (PCSSForcePseudoState -> [Text]
pCSSForcePseudoStateForcedPseudoClasses PCSSForcePseudoState
p)
    ]
instance Command PCSSForcePseudoState where
  type CommandResponse PCSSForcePseudoState = ()
  commandName :: Proxy PCSSForcePseudoState -> String
commandName Proxy PCSSForcePseudoState
_ = String
"CSS.forcePseudoState"
  fromJSON :: Proxy PCSSForcePseudoState
-> Value -> Result (CommandResponse PCSSForcePseudoState)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCSSForcePseudoState -> Result ())
-> Proxy PCSSForcePseudoState
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCSSForcePseudoState -> ())
-> Proxy PCSSForcePseudoState
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCSSForcePseudoState -> ()
forall a b. a -> b -> a
const ()


-- | Parameters of the 'CSS.getBackgroundColors' command.
data PCSSGetBackgroundColors = PCSSGetBackgroundColors
  {
    -- | Id of the node to get background colors for.
    PCSSGetBackgroundColors -> Int
pCSSGetBackgroundColorsNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool
(PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool)
-> (PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool)
-> Eq PCSSGetBackgroundColors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool
$c/= :: PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool
== :: PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool
$c== :: PCSSGetBackgroundColors -> PCSSGetBackgroundColors -> Bool
Eq, Int -> PCSSGetBackgroundColors -> ShowS
[PCSSGetBackgroundColors] -> ShowS
PCSSGetBackgroundColors -> String
(Int -> PCSSGetBackgroundColors -> ShowS)
-> (PCSSGetBackgroundColors -> String)
-> ([PCSSGetBackgroundColors] -> ShowS)
-> Show PCSSGetBackgroundColors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetBackgroundColors] -> ShowS
$cshowList :: [PCSSGetBackgroundColors] -> ShowS
show :: PCSSGetBackgroundColors -> String
$cshow :: PCSSGetBackgroundColors -> String
showsPrec :: Int -> PCSSGetBackgroundColors -> ShowS
$cshowsPrec :: Int -> PCSSGetBackgroundColors -> ShowS
Show)
pCSSGetBackgroundColors
  {-
  -- | Id of the node to get background colors for.
  -}
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> PCSSGetBackgroundColors
pCSSGetBackgroundColors :: Int -> PCSSGetBackgroundColors
pCSSGetBackgroundColors
  Int
arg_pCSSGetBackgroundColorsNodeId
  = Int -> PCSSGetBackgroundColors
PCSSGetBackgroundColors
    Int
arg_pCSSGetBackgroundColorsNodeId
instance ToJSON PCSSGetBackgroundColors where
  toJSON :: PCSSGetBackgroundColors -> Value
toJSON PCSSGetBackgroundColors
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
"nodeId" 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 (PCSSGetBackgroundColors -> Int
pCSSGetBackgroundColorsNodeId PCSSGetBackgroundColors
p)
    ]
data CSSGetBackgroundColors = CSSGetBackgroundColors
  {
    -- | The range of background colors behind this element, if it contains any visible text. If no
    --   visible text is present, this will be undefined. In the case of a flat background color,
    --   this will consist of simply that color. In the case of a gradient, this will consist of each
    --   of the color stops. For anything more complicated, this will be an empty array. Images will
    --   be ignored (as if the image had failed to load).
    CSSGetBackgroundColors -> Maybe [Text]
cSSGetBackgroundColorsBackgroundColors :: Maybe [T.Text],
    -- | The computed font size for this node, as a CSS computed value string (e.g. '12px').
    CSSGetBackgroundColors -> Maybe Text
cSSGetBackgroundColorsComputedFontSize :: Maybe T.Text,
    -- | The computed font weight for this node, as a CSS computed value string (e.g. 'normal' or
    --   '100').
    CSSGetBackgroundColors -> Maybe Text
cSSGetBackgroundColorsComputedFontWeight :: Maybe T.Text
  }
  deriving (CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool
(CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool)
-> (CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool)
-> Eq CSSGetBackgroundColors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool
$c/= :: CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool
== :: CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool
$c== :: CSSGetBackgroundColors -> CSSGetBackgroundColors -> Bool
Eq, Int -> CSSGetBackgroundColors -> ShowS
[CSSGetBackgroundColors] -> ShowS
CSSGetBackgroundColors -> String
(Int -> CSSGetBackgroundColors -> ShowS)
-> (CSSGetBackgroundColors -> String)
-> ([CSSGetBackgroundColors] -> ShowS)
-> Show CSSGetBackgroundColors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetBackgroundColors] -> ShowS
$cshowList :: [CSSGetBackgroundColors] -> ShowS
show :: CSSGetBackgroundColors -> String
$cshow :: CSSGetBackgroundColors -> String
showsPrec :: Int -> CSSGetBackgroundColors -> ShowS
$cshowsPrec :: Int -> CSSGetBackgroundColors -> ShowS
Show)
instance FromJSON CSSGetBackgroundColors where
  parseJSON :: Value -> Parser CSSGetBackgroundColors
parseJSON = String
-> (Object -> Parser CSSGetBackgroundColors)
-> Value
-> Parser CSSGetBackgroundColors
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetBackgroundColors" ((Object -> Parser CSSGetBackgroundColors)
 -> Value -> Parser CSSGetBackgroundColors)
-> (Object -> Parser CSSGetBackgroundColors)
-> Value
-> Parser CSSGetBackgroundColors
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe [Text] -> Maybe Text -> Maybe Text -> CSSGetBackgroundColors
CSSGetBackgroundColors
    (Maybe [Text]
 -> Maybe Text -> Maybe Text -> CSSGetBackgroundColors)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> Maybe Text -> CSSGetBackgroundColors)
forall (f :: * -> *) a b. Functor 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
"backgroundColors"
    Parser (Maybe Text -> Maybe Text -> CSSGetBackgroundColors)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> CSSGetBackgroundColors)
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
"computedFontSize"
    Parser (Maybe Text -> CSSGetBackgroundColors)
-> Parser (Maybe Text) -> Parser CSSGetBackgroundColors
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
"computedFontWeight"
instance Command PCSSGetBackgroundColors where
  type CommandResponse PCSSGetBackgroundColors = CSSGetBackgroundColors
  commandName :: Proxy PCSSGetBackgroundColors -> String
commandName Proxy PCSSGetBackgroundColors
_ = String
"CSS.getBackgroundColors"

-- | Returns the computed style for a DOM node identified by `nodeId`.

-- | Parameters of the 'CSS.getComputedStyleForNode' command.
data PCSSGetComputedStyleForNode = PCSSGetComputedStyleForNode
  {
    PCSSGetComputedStyleForNode -> Int
pCSSGetComputedStyleForNodeNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (PCSSGetComputedStyleForNode -> PCSSGetComputedStyleForNode -> Bool
(PCSSGetComputedStyleForNode
 -> PCSSGetComputedStyleForNode -> Bool)
-> (PCSSGetComputedStyleForNode
    -> PCSSGetComputedStyleForNode -> Bool)
-> Eq PCSSGetComputedStyleForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetComputedStyleForNode -> PCSSGetComputedStyleForNode -> Bool
$c/= :: PCSSGetComputedStyleForNode -> PCSSGetComputedStyleForNode -> Bool
== :: PCSSGetComputedStyleForNode -> PCSSGetComputedStyleForNode -> Bool
$c== :: PCSSGetComputedStyleForNode -> PCSSGetComputedStyleForNode -> Bool
Eq, Int -> PCSSGetComputedStyleForNode -> ShowS
[PCSSGetComputedStyleForNode] -> ShowS
PCSSGetComputedStyleForNode -> String
(Int -> PCSSGetComputedStyleForNode -> ShowS)
-> (PCSSGetComputedStyleForNode -> String)
-> ([PCSSGetComputedStyleForNode] -> ShowS)
-> Show PCSSGetComputedStyleForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetComputedStyleForNode] -> ShowS
$cshowList :: [PCSSGetComputedStyleForNode] -> ShowS
show :: PCSSGetComputedStyleForNode -> String
$cshow :: PCSSGetComputedStyleForNode -> String
showsPrec :: Int -> PCSSGetComputedStyleForNode -> ShowS
$cshowsPrec :: Int -> PCSSGetComputedStyleForNode -> ShowS
Show)
pCSSGetComputedStyleForNode
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> PCSSGetComputedStyleForNode
pCSSGetComputedStyleForNode :: Int -> PCSSGetComputedStyleForNode
pCSSGetComputedStyleForNode
  Int
arg_pCSSGetComputedStyleForNodeNodeId
  = Int -> PCSSGetComputedStyleForNode
PCSSGetComputedStyleForNode
    Int
arg_pCSSGetComputedStyleForNodeNodeId
instance ToJSON PCSSGetComputedStyleForNode where
  toJSON :: PCSSGetComputedStyleForNode -> Value
toJSON PCSSGetComputedStyleForNode
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
"nodeId" 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 (PCSSGetComputedStyleForNode -> Int
pCSSGetComputedStyleForNodeNodeId PCSSGetComputedStyleForNode
p)
    ]
data CSSGetComputedStyleForNode = CSSGetComputedStyleForNode
  {
    -- | Computed style for the specified DOM node.
    CSSGetComputedStyleForNode -> [CSSCSSComputedStyleProperty]
cSSGetComputedStyleForNodeComputedStyle :: [CSSCSSComputedStyleProperty]
  }
  deriving (CSSGetComputedStyleForNode -> CSSGetComputedStyleForNode -> Bool
(CSSGetComputedStyleForNode -> CSSGetComputedStyleForNode -> Bool)
-> (CSSGetComputedStyleForNode
    -> CSSGetComputedStyleForNode -> Bool)
-> Eq CSSGetComputedStyleForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetComputedStyleForNode -> CSSGetComputedStyleForNode -> Bool
$c/= :: CSSGetComputedStyleForNode -> CSSGetComputedStyleForNode -> Bool
== :: CSSGetComputedStyleForNode -> CSSGetComputedStyleForNode -> Bool
$c== :: CSSGetComputedStyleForNode -> CSSGetComputedStyleForNode -> Bool
Eq, Int -> CSSGetComputedStyleForNode -> ShowS
[CSSGetComputedStyleForNode] -> ShowS
CSSGetComputedStyleForNode -> String
(Int -> CSSGetComputedStyleForNode -> ShowS)
-> (CSSGetComputedStyleForNode -> String)
-> ([CSSGetComputedStyleForNode] -> ShowS)
-> Show CSSGetComputedStyleForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetComputedStyleForNode] -> ShowS
$cshowList :: [CSSGetComputedStyleForNode] -> ShowS
show :: CSSGetComputedStyleForNode -> String
$cshow :: CSSGetComputedStyleForNode -> String
showsPrec :: Int -> CSSGetComputedStyleForNode -> ShowS
$cshowsPrec :: Int -> CSSGetComputedStyleForNode -> ShowS
Show)
instance FromJSON CSSGetComputedStyleForNode where
  parseJSON :: Value -> Parser CSSGetComputedStyleForNode
parseJSON = String
-> (Object -> Parser CSSGetComputedStyleForNode)
-> Value
-> Parser CSSGetComputedStyleForNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetComputedStyleForNode" ((Object -> Parser CSSGetComputedStyleForNode)
 -> Value -> Parser CSSGetComputedStyleForNode)
-> (Object -> Parser CSSGetComputedStyleForNode)
-> Value
-> Parser CSSGetComputedStyleForNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSCSSComputedStyleProperty] -> CSSGetComputedStyleForNode
CSSGetComputedStyleForNode
    ([CSSCSSComputedStyleProperty] -> CSSGetComputedStyleForNode)
-> Parser [CSSCSSComputedStyleProperty]
-> Parser CSSGetComputedStyleForNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSCSSComputedStyleProperty]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"computedStyle"
instance Command PCSSGetComputedStyleForNode where
  type CommandResponse PCSSGetComputedStyleForNode = CSSGetComputedStyleForNode
  commandName :: Proxy PCSSGetComputedStyleForNode -> String
commandName Proxy PCSSGetComputedStyleForNode
_ = String
"CSS.getComputedStyleForNode"

-- | Returns the styles defined inline (explicitly in the "style" attribute and implicitly, using DOM
--   attributes) for a DOM node identified by `nodeId`.

-- | Parameters of the 'CSS.getInlineStylesForNode' command.
data PCSSGetInlineStylesForNode = PCSSGetInlineStylesForNode
  {
    PCSSGetInlineStylesForNode -> Int
pCSSGetInlineStylesForNodeNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (PCSSGetInlineStylesForNode -> PCSSGetInlineStylesForNode -> Bool
(PCSSGetInlineStylesForNode -> PCSSGetInlineStylesForNode -> Bool)
-> (PCSSGetInlineStylesForNode
    -> PCSSGetInlineStylesForNode -> Bool)
-> Eq PCSSGetInlineStylesForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetInlineStylesForNode -> PCSSGetInlineStylesForNode -> Bool
$c/= :: PCSSGetInlineStylesForNode -> PCSSGetInlineStylesForNode -> Bool
== :: PCSSGetInlineStylesForNode -> PCSSGetInlineStylesForNode -> Bool
$c== :: PCSSGetInlineStylesForNode -> PCSSGetInlineStylesForNode -> Bool
Eq, Int -> PCSSGetInlineStylesForNode -> ShowS
[PCSSGetInlineStylesForNode] -> ShowS
PCSSGetInlineStylesForNode -> String
(Int -> PCSSGetInlineStylesForNode -> ShowS)
-> (PCSSGetInlineStylesForNode -> String)
-> ([PCSSGetInlineStylesForNode] -> ShowS)
-> Show PCSSGetInlineStylesForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetInlineStylesForNode] -> ShowS
$cshowList :: [PCSSGetInlineStylesForNode] -> ShowS
show :: PCSSGetInlineStylesForNode -> String
$cshow :: PCSSGetInlineStylesForNode -> String
showsPrec :: Int -> PCSSGetInlineStylesForNode -> ShowS
$cshowsPrec :: Int -> PCSSGetInlineStylesForNode -> ShowS
Show)
pCSSGetInlineStylesForNode
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> PCSSGetInlineStylesForNode
pCSSGetInlineStylesForNode :: Int -> PCSSGetInlineStylesForNode
pCSSGetInlineStylesForNode
  Int
arg_pCSSGetInlineStylesForNodeNodeId
  = Int -> PCSSGetInlineStylesForNode
PCSSGetInlineStylesForNode
    Int
arg_pCSSGetInlineStylesForNodeNodeId
instance ToJSON PCSSGetInlineStylesForNode where
  toJSON :: PCSSGetInlineStylesForNode -> Value
toJSON PCSSGetInlineStylesForNode
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
"nodeId" 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 (PCSSGetInlineStylesForNode -> Int
pCSSGetInlineStylesForNodeNodeId PCSSGetInlineStylesForNode
p)
    ]
data CSSGetInlineStylesForNode = CSSGetInlineStylesForNode
  {
    -- | Inline style for the specified DOM node.
    CSSGetInlineStylesForNode -> Maybe CSSCSSStyle
cSSGetInlineStylesForNodeInlineStyle :: Maybe CSSCSSStyle,
    -- | Attribute-defined element style (e.g. resulting from "width=20 height=100%").
    CSSGetInlineStylesForNode -> Maybe CSSCSSStyle
cSSGetInlineStylesForNodeAttributesStyle :: Maybe CSSCSSStyle
  }
  deriving (CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool
(CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool)
-> (CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool)
-> Eq CSSGetInlineStylesForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool
$c/= :: CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool
== :: CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool
$c== :: CSSGetInlineStylesForNode -> CSSGetInlineStylesForNode -> Bool
Eq, Int -> CSSGetInlineStylesForNode -> ShowS
[CSSGetInlineStylesForNode] -> ShowS
CSSGetInlineStylesForNode -> String
(Int -> CSSGetInlineStylesForNode -> ShowS)
-> (CSSGetInlineStylesForNode -> String)
-> ([CSSGetInlineStylesForNode] -> ShowS)
-> Show CSSGetInlineStylesForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetInlineStylesForNode] -> ShowS
$cshowList :: [CSSGetInlineStylesForNode] -> ShowS
show :: CSSGetInlineStylesForNode -> String
$cshow :: CSSGetInlineStylesForNode -> String
showsPrec :: Int -> CSSGetInlineStylesForNode -> ShowS
$cshowsPrec :: Int -> CSSGetInlineStylesForNode -> ShowS
Show)
instance FromJSON CSSGetInlineStylesForNode where
  parseJSON :: Value -> Parser CSSGetInlineStylesForNode
parseJSON = String
-> (Object -> Parser CSSGetInlineStylesForNode)
-> Value
-> Parser CSSGetInlineStylesForNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetInlineStylesForNode" ((Object -> Parser CSSGetInlineStylesForNode)
 -> Value -> Parser CSSGetInlineStylesForNode)
-> (Object -> Parser CSSGetInlineStylesForNode)
-> Value
-> Parser CSSGetInlineStylesForNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe CSSCSSStyle -> Maybe CSSCSSStyle -> CSSGetInlineStylesForNode
CSSGetInlineStylesForNode
    (Maybe CSSCSSStyle
 -> Maybe CSSCSSStyle -> CSSGetInlineStylesForNode)
-> Parser (Maybe CSSCSSStyle)
-> Parser (Maybe CSSCSSStyle -> CSSGetInlineStylesForNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe CSSCSSStyle)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inlineStyle"
    Parser (Maybe CSSCSSStyle -> CSSGetInlineStylesForNode)
-> Parser (Maybe CSSCSSStyle) -> Parser CSSGetInlineStylesForNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSCSSStyle)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"attributesStyle"
instance Command PCSSGetInlineStylesForNode where
  type CommandResponse PCSSGetInlineStylesForNode = CSSGetInlineStylesForNode
  commandName :: Proxy PCSSGetInlineStylesForNode -> String
commandName Proxy PCSSGetInlineStylesForNode
_ = String
"CSS.getInlineStylesForNode"

-- | Returns requested styles for a DOM node identified by `nodeId`.

-- | Parameters of the 'CSS.getMatchedStylesForNode' command.
data PCSSGetMatchedStylesForNode = PCSSGetMatchedStylesForNode
  {
    PCSSGetMatchedStylesForNode -> Int
pCSSGetMatchedStylesForNodeNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (PCSSGetMatchedStylesForNode -> PCSSGetMatchedStylesForNode -> Bool
(PCSSGetMatchedStylesForNode
 -> PCSSGetMatchedStylesForNode -> Bool)
-> (PCSSGetMatchedStylesForNode
    -> PCSSGetMatchedStylesForNode -> Bool)
-> Eq PCSSGetMatchedStylesForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetMatchedStylesForNode -> PCSSGetMatchedStylesForNode -> Bool
$c/= :: PCSSGetMatchedStylesForNode -> PCSSGetMatchedStylesForNode -> Bool
== :: PCSSGetMatchedStylesForNode -> PCSSGetMatchedStylesForNode -> Bool
$c== :: PCSSGetMatchedStylesForNode -> PCSSGetMatchedStylesForNode -> Bool
Eq, Int -> PCSSGetMatchedStylesForNode -> ShowS
[PCSSGetMatchedStylesForNode] -> ShowS
PCSSGetMatchedStylesForNode -> String
(Int -> PCSSGetMatchedStylesForNode -> ShowS)
-> (PCSSGetMatchedStylesForNode -> String)
-> ([PCSSGetMatchedStylesForNode] -> ShowS)
-> Show PCSSGetMatchedStylesForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetMatchedStylesForNode] -> ShowS
$cshowList :: [PCSSGetMatchedStylesForNode] -> ShowS
show :: PCSSGetMatchedStylesForNode -> String
$cshow :: PCSSGetMatchedStylesForNode -> String
showsPrec :: Int -> PCSSGetMatchedStylesForNode -> ShowS
$cshowsPrec :: Int -> PCSSGetMatchedStylesForNode -> ShowS
Show)
pCSSGetMatchedStylesForNode
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> PCSSGetMatchedStylesForNode
pCSSGetMatchedStylesForNode :: Int -> PCSSGetMatchedStylesForNode
pCSSGetMatchedStylesForNode
  Int
arg_pCSSGetMatchedStylesForNodeNodeId
  = Int -> PCSSGetMatchedStylesForNode
PCSSGetMatchedStylesForNode
    Int
arg_pCSSGetMatchedStylesForNodeNodeId
instance ToJSON PCSSGetMatchedStylesForNode where
  toJSON :: PCSSGetMatchedStylesForNode -> Value
toJSON PCSSGetMatchedStylesForNode
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
"nodeId" 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 (PCSSGetMatchedStylesForNode -> Int
pCSSGetMatchedStylesForNodeNodeId PCSSGetMatchedStylesForNode
p)
    ]
data CSSGetMatchedStylesForNode = CSSGetMatchedStylesForNode
  {
    -- | Inline style for the specified DOM node.
    CSSGetMatchedStylesForNode -> Maybe CSSCSSStyle
cSSGetMatchedStylesForNodeInlineStyle :: Maybe CSSCSSStyle,
    -- | Attribute-defined element style (e.g. resulting from "width=20 height=100%").
    CSSGetMatchedStylesForNode -> Maybe CSSCSSStyle
cSSGetMatchedStylesForNodeAttributesStyle :: Maybe CSSCSSStyle,
    -- | CSS rules matching this node, from all applicable stylesheets.
    CSSGetMatchedStylesForNode -> Maybe [CSSRuleMatch]
cSSGetMatchedStylesForNodeMatchedCSSRules :: Maybe [CSSRuleMatch],
    -- | Pseudo style matches for this node.
    CSSGetMatchedStylesForNode -> Maybe [CSSPseudoElementMatches]
cSSGetMatchedStylesForNodePseudoElements :: Maybe [CSSPseudoElementMatches],
    -- | A chain of inherited styles (from the immediate node parent up to the DOM tree root).
    CSSGetMatchedStylesForNode -> Maybe [CSSInheritedStyleEntry]
cSSGetMatchedStylesForNodeInherited :: Maybe [CSSInheritedStyleEntry],
    -- | A chain of inherited pseudo element styles (from the immediate node parent up to the DOM tree root).
    CSSGetMatchedStylesForNode
-> Maybe [CSSInheritedPseudoElementMatches]
cSSGetMatchedStylesForNodeInheritedPseudoElements :: Maybe [CSSInheritedPseudoElementMatches],
    -- | A list of CSS keyframed animations matching this node.
    CSSGetMatchedStylesForNode -> Maybe [CSSCSSKeyframesRule]
cSSGetMatchedStylesForNodeCssKeyframesRules :: Maybe [CSSCSSKeyframesRule],
    -- | Id of the first parent element that does not have display: contents.
    CSSGetMatchedStylesForNode -> Maybe Int
cSSGetMatchedStylesForNodeParentLayoutNodeId :: Maybe DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (CSSGetMatchedStylesForNode -> CSSGetMatchedStylesForNode -> Bool
(CSSGetMatchedStylesForNode -> CSSGetMatchedStylesForNode -> Bool)
-> (CSSGetMatchedStylesForNode
    -> CSSGetMatchedStylesForNode -> Bool)
-> Eq CSSGetMatchedStylesForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetMatchedStylesForNode -> CSSGetMatchedStylesForNode -> Bool
$c/= :: CSSGetMatchedStylesForNode -> CSSGetMatchedStylesForNode -> Bool
== :: CSSGetMatchedStylesForNode -> CSSGetMatchedStylesForNode -> Bool
$c== :: CSSGetMatchedStylesForNode -> CSSGetMatchedStylesForNode -> Bool
Eq, Int -> CSSGetMatchedStylesForNode -> ShowS
[CSSGetMatchedStylesForNode] -> ShowS
CSSGetMatchedStylesForNode -> String
(Int -> CSSGetMatchedStylesForNode -> ShowS)
-> (CSSGetMatchedStylesForNode -> String)
-> ([CSSGetMatchedStylesForNode] -> ShowS)
-> Show CSSGetMatchedStylesForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetMatchedStylesForNode] -> ShowS
$cshowList :: [CSSGetMatchedStylesForNode] -> ShowS
show :: CSSGetMatchedStylesForNode -> String
$cshow :: CSSGetMatchedStylesForNode -> String
showsPrec :: Int -> CSSGetMatchedStylesForNode -> ShowS
$cshowsPrec :: Int -> CSSGetMatchedStylesForNode -> ShowS
Show)
instance FromJSON CSSGetMatchedStylesForNode where
  parseJSON :: Value -> Parser CSSGetMatchedStylesForNode
parseJSON = String
-> (Object -> Parser CSSGetMatchedStylesForNode)
-> Value
-> Parser CSSGetMatchedStylesForNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetMatchedStylesForNode" ((Object -> Parser CSSGetMatchedStylesForNode)
 -> Value -> Parser CSSGetMatchedStylesForNode)
-> (Object -> Parser CSSGetMatchedStylesForNode)
-> Value
-> Parser CSSGetMatchedStylesForNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe CSSCSSStyle
-> Maybe CSSCSSStyle
-> Maybe [CSSRuleMatch]
-> Maybe [CSSPseudoElementMatches]
-> Maybe [CSSInheritedStyleEntry]
-> Maybe [CSSInheritedPseudoElementMatches]
-> Maybe [CSSCSSKeyframesRule]
-> Maybe Int
-> CSSGetMatchedStylesForNode
CSSGetMatchedStylesForNode
    (Maybe CSSCSSStyle
 -> Maybe CSSCSSStyle
 -> Maybe [CSSRuleMatch]
 -> Maybe [CSSPseudoElementMatches]
 -> Maybe [CSSInheritedStyleEntry]
 -> Maybe [CSSInheritedPseudoElementMatches]
 -> Maybe [CSSCSSKeyframesRule]
 -> Maybe Int
 -> CSSGetMatchedStylesForNode)
-> Parser (Maybe CSSCSSStyle)
-> Parser
     (Maybe CSSCSSStyle
      -> Maybe [CSSRuleMatch]
      -> Maybe [CSSPseudoElementMatches]
      -> Maybe [CSSInheritedStyleEntry]
      -> Maybe [CSSInheritedPseudoElementMatches]
      -> Maybe [CSSCSSKeyframesRule]
      -> Maybe Int
      -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe CSSCSSStyle)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inlineStyle"
    Parser
  (Maybe CSSCSSStyle
   -> Maybe [CSSRuleMatch]
   -> Maybe [CSSPseudoElementMatches]
   -> Maybe [CSSInheritedStyleEntry]
   -> Maybe [CSSInheritedPseudoElementMatches]
   -> Maybe [CSSCSSKeyframesRule]
   -> Maybe Int
   -> CSSGetMatchedStylesForNode)
-> Parser (Maybe CSSCSSStyle)
-> Parser
     (Maybe [CSSRuleMatch]
      -> Maybe [CSSPseudoElementMatches]
      -> Maybe [CSSInheritedStyleEntry]
      -> Maybe [CSSInheritedPseudoElementMatches]
      -> Maybe [CSSCSSKeyframesRule]
      -> Maybe Int
      -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe CSSCSSStyle)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"attributesStyle"
    Parser
  (Maybe [CSSRuleMatch]
   -> Maybe [CSSPseudoElementMatches]
   -> Maybe [CSSInheritedStyleEntry]
   -> Maybe [CSSInheritedPseudoElementMatches]
   -> Maybe [CSSCSSKeyframesRule]
   -> Maybe Int
   -> CSSGetMatchedStylesForNode)
-> Parser (Maybe [CSSRuleMatch])
-> Parser
     (Maybe [CSSPseudoElementMatches]
      -> Maybe [CSSInheritedStyleEntry]
      -> Maybe [CSSInheritedPseudoElementMatches]
      -> Maybe [CSSCSSKeyframesRule]
      -> Maybe Int
      -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSRuleMatch])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"matchedCSSRules"
    Parser
  (Maybe [CSSPseudoElementMatches]
   -> Maybe [CSSInheritedStyleEntry]
   -> Maybe [CSSInheritedPseudoElementMatches]
   -> Maybe [CSSCSSKeyframesRule]
   -> Maybe Int
   -> CSSGetMatchedStylesForNode)
-> Parser (Maybe [CSSPseudoElementMatches])
-> Parser
     (Maybe [CSSInheritedStyleEntry]
      -> Maybe [CSSInheritedPseudoElementMatches]
      -> Maybe [CSSCSSKeyframesRule]
      -> Maybe Int
      -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSPseudoElementMatches])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"pseudoElements"
    Parser
  (Maybe [CSSInheritedStyleEntry]
   -> Maybe [CSSInheritedPseudoElementMatches]
   -> Maybe [CSSCSSKeyframesRule]
   -> Maybe Int
   -> CSSGetMatchedStylesForNode)
-> Parser (Maybe [CSSInheritedStyleEntry])
-> Parser
     (Maybe [CSSInheritedPseudoElementMatches]
      -> Maybe [CSSCSSKeyframesRule]
      -> Maybe Int
      -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSInheritedStyleEntry])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inherited"
    Parser
  (Maybe [CSSInheritedPseudoElementMatches]
   -> Maybe [CSSCSSKeyframesRule]
   -> Maybe Int
   -> CSSGetMatchedStylesForNode)
-> Parser (Maybe [CSSInheritedPseudoElementMatches])
-> Parser
     (Maybe [CSSCSSKeyframesRule]
      -> Maybe Int -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSInheritedPseudoElementMatches])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"inheritedPseudoElements"
    Parser
  (Maybe [CSSCSSKeyframesRule]
   -> Maybe Int -> CSSGetMatchedStylesForNode)
-> Parser (Maybe [CSSCSSKeyframesRule])
-> Parser (Maybe Int -> CSSGetMatchedStylesForNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [CSSCSSKeyframesRule])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"cssKeyframesRules"
    Parser (Maybe Int -> CSSGetMatchedStylesForNode)
-> Parser (Maybe Int) -> Parser CSSGetMatchedStylesForNode
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
"parentLayoutNodeId"
instance Command PCSSGetMatchedStylesForNode where
  type CommandResponse PCSSGetMatchedStylesForNode = CSSGetMatchedStylesForNode
  commandName :: Proxy PCSSGetMatchedStylesForNode -> String
commandName Proxy PCSSGetMatchedStylesForNode
_ = String
"CSS.getMatchedStylesForNode"

-- | Returns all media queries parsed by the rendering engine.

-- | Parameters of the 'CSS.getMediaQueries' command.
data PCSSGetMediaQueries = PCSSGetMediaQueries
  deriving (PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool
(PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool)
-> (PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool)
-> Eq PCSSGetMediaQueries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool
$c/= :: PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool
== :: PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool
$c== :: PCSSGetMediaQueries -> PCSSGetMediaQueries -> Bool
Eq, Int -> PCSSGetMediaQueries -> ShowS
[PCSSGetMediaQueries] -> ShowS
PCSSGetMediaQueries -> String
(Int -> PCSSGetMediaQueries -> ShowS)
-> (PCSSGetMediaQueries -> String)
-> ([PCSSGetMediaQueries] -> ShowS)
-> Show PCSSGetMediaQueries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetMediaQueries] -> ShowS
$cshowList :: [PCSSGetMediaQueries] -> ShowS
show :: PCSSGetMediaQueries -> String
$cshow :: PCSSGetMediaQueries -> String
showsPrec :: Int -> PCSSGetMediaQueries -> ShowS
$cshowsPrec :: Int -> PCSSGetMediaQueries -> ShowS
Show)
pCSSGetMediaQueries
  :: PCSSGetMediaQueries
pCSSGetMediaQueries :: PCSSGetMediaQueries
pCSSGetMediaQueries
  = PCSSGetMediaQueries
PCSSGetMediaQueries
instance ToJSON PCSSGetMediaQueries where
  toJSON :: PCSSGetMediaQueries -> Value
toJSON PCSSGetMediaQueries
_ = Value
A.Null
data CSSGetMediaQueries = CSSGetMediaQueries
  {
    CSSGetMediaQueries -> [CSSCSSMedia]
cSSGetMediaQueriesMedias :: [CSSCSSMedia]
  }
  deriving (CSSGetMediaQueries -> CSSGetMediaQueries -> Bool
(CSSGetMediaQueries -> CSSGetMediaQueries -> Bool)
-> (CSSGetMediaQueries -> CSSGetMediaQueries -> Bool)
-> Eq CSSGetMediaQueries
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetMediaQueries -> CSSGetMediaQueries -> Bool
$c/= :: CSSGetMediaQueries -> CSSGetMediaQueries -> Bool
== :: CSSGetMediaQueries -> CSSGetMediaQueries -> Bool
$c== :: CSSGetMediaQueries -> CSSGetMediaQueries -> Bool
Eq, Int -> CSSGetMediaQueries -> ShowS
[CSSGetMediaQueries] -> ShowS
CSSGetMediaQueries -> String
(Int -> CSSGetMediaQueries -> ShowS)
-> (CSSGetMediaQueries -> String)
-> ([CSSGetMediaQueries] -> ShowS)
-> Show CSSGetMediaQueries
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetMediaQueries] -> ShowS
$cshowList :: [CSSGetMediaQueries] -> ShowS
show :: CSSGetMediaQueries -> String
$cshow :: CSSGetMediaQueries -> String
showsPrec :: Int -> CSSGetMediaQueries -> ShowS
$cshowsPrec :: Int -> CSSGetMediaQueries -> ShowS
Show)
instance FromJSON CSSGetMediaQueries where
  parseJSON :: Value -> Parser CSSGetMediaQueries
parseJSON = String
-> (Object -> Parser CSSGetMediaQueries)
-> Value
-> Parser CSSGetMediaQueries
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetMediaQueries" ((Object -> Parser CSSGetMediaQueries)
 -> Value -> Parser CSSGetMediaQueries)
-> (Object -> Parser CSSGetMediaQueries)
-> Value
-> Parser CSSGetMediaQueries
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSCSSMedia] -> CSSGetMediaQueries
CSSGetMediaQueries
    ([CSSCSSMedia] -> CSSGetMediaQueries)
-> Parser [CSSCSSMedia] -> Parser CSSGetMediaQueries
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSCSSMedia]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"medias"
instance Command PCSSGetMediaQueries where
  type CommandResponse PCSSGetMediaQueries = CSSGetMediaQueries
  commandName :: Proxy PCSSGetMediaQueries -> String
commandName Proxy PCSSGetMediaQueries
_ = String
"CSS.getMediaQueries"

-- | Requests information about platform fonts which we used to render child TextNodes in the given
--   node.

-- | Parameters of the 'CSS.getPlatformFontsForNode' command.
data PCSSGetPlatformFontsForNode = PCSSGetPlatformFontsForNode
  {
    PCSSGetPlatformFontsForNode -> Int
pCSSGetPlatformFontsForNodeNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (PCSSGetPlatformFontsForNode -> PCSSGetPlatformFontsForNode -> Bool
(PCSSGetPlatformFontsForNode
 -> PCSSGetPlatformFontsForNode -> Bool)
-> (PCSSGetPlatformFontsForNode
    -> PCSSGetPlatformFontsForNode -> Bool)
-> Eq PCSSGetPlatformFontsForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetPlatformFontsForNode -> PCSSGetPlatformFontsForNode -> Bool
$c/= :: PCSSGetPlatformFontsForNode -> PCSSGetPlatformFontsForNode -> Bool
== :: PCSSGetPlatformFontsForNode -> PCSSGetPlatformFontsForNode -> Bool
$c== :: PCSSGetPlatformFontsForNode -> PCSSGetPlatformFontsForNode -> Bool
Eq, Int -> PCSSGetPlatformFontsForNode -> ShowS
[PCSSGetPlatformFontsForNode] -> ShowS
PCSSGetPlatformFontsForNode -> String
(Int -> PCSSGetPlatformFontsForNode -> ShowS)
-> (PCSSGetPlatformFontsForNode -> String)
-> ([PCSSGetPlatformFontsForNode] -> ShowS)
-> Show PCSSGetPlatformFontsForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetPlatformFontsForNode] -> ShowS
$cshowList :: [PCSSGetPlatformFontsForNode] -> ShowS
show :: PCSSGetPlatformFontsForNode -> String
$cshow :: PCSSGetPlatformFontsForNode -> String
showsPrec :: Int -> PCSSGetPlatformFontsForNode -> ShowS
$cshowsPrec :: Int -> PCSSGetPlatformFontsForNode -> ShowS
Show)
pCSSGetPlatformFontsForNode
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> PCSSGetPlatformFontsForNode
pCSSGetPlatformFontsForNode :: Int -> PCSSGetPlatformFontsForNode
pCSSGetPlatformFontsForNode
  Int
arg_pCSSGetPlatformFontsForNodeNodeId
  = Int -> PCSSGetPlatformFontsForNode
PCSSGetPlatformFontsForNode
    Int
arg_pCSSGetPlatformFontsForNodeNodeId
instance ToJSON PCSSGetPlatformFontsForNode where
  toJSON :: PCSSGetPlatformFontsForNode -> Value
toJSON PCSSGetPlatformFontsForNode
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
"nodeId" 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 (PCSSGetPlatformFontsForNode -> Int
pCSSGetPlatformFontsForNodeNodeId PCSSGetPlatformFontsForNode
p)
    ]
data CSSGetPlatformFontsForNode = CSSGetPlatformFontsForNode
  {
    -- | Usage statistics for every employed platform font.
    CSSGetPlatformFontsForNode -> [CSSPlatformFontUsage]
cSSGetPlatformFontsForNodeFonts :: [CSSPlatformFontUsage]
  }
  deriving (CSSGetPlatformFontsForNode -> CSSGetPlatformFontsForNode -> Bool
(CSSGetPlatformFontsForNode -> CSSGetPlatformFontsForNode -> Bool)
-> (CSSGetPlatformFontsForNode
    -> CSSGetPlatformFontsForNode -> Bool)
-> Eq CSSGetPlatformFontsForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetPlatformFontsForNode -> CSSGetPlatformFontsForNode -> Bool
$c/= :: CSSGetPlatformFontsForNode -> CSSGetPlatformFontsForNode -> Bool
== :: CSSGetPlatformFontsForNode -> CSSGetPlatformFontsForNode -> Bool
$c== :: CSSGetPlatformFontsForNode -> CSSGetPlatformFontsForNode -> Bool
Eq, Int -> CSSGetPlatformFontsForNode -> ShowS
[CSSGetPlatformFontsForNode] -> ShowS
CSSGetPlatformFontsForNode -> String
(Int -> CSSGetPlatformFontsForNode -> ShowS)
-> (CSSGetPlatformFontsForNode -> String)
-> ([CSSGetPlatformFontsForNode] -> ShowS)
-> Show CSSGetPlatformFontsForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetPlatformFontsForNode] -> ShowS
$cshowList :: [CSSGetPlatformFontsForNode] -> ShowS
show :: CSSGetPlatformFontsForNode -> String
$cshow :: CSSGetPlatformFontsForNode -> String
showsPrec :: Int -> CSSGetPlatformFontsForNode -> ShowS
$cshowsPrec :: Int -> CSSGetPlatformFontsForNode -> ShowS
Show)
instance FromJSON CSSGetPlatformFontsForNode where
  parseJSON :: Value -> Parser CSSGetPlatformFontsForNode
parseJSON = String
-> (Object -> Parser CSSGetPlatformFontsForNode)
-> Value
-> Parser CSSGetPlatformFontsForNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetPlatformFontsForNode" ((Object -> Parser CSSGetPlatformFontsForNode)
 -> Value -> Parser CSSGetPlatformFontsForNode)
-> (Object -> Parser CSSGetPlatformFontsForNode)
-> Value
-> Parser CSSGetPlatformFontsForNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSPlatformFontUsage] -> CSSGetPlatformFontsForNode
CSSGetPlatformFontsForNode
    ([CSSPlatformFontUsage] -> CSSGetPlatformFontsForNode)
-> Parser [CSSPlatformFontUsage]
-> Parser CSSGetPlatformFontsForNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSPlatformFontUsage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"fonts"
instance Command PCSSGetPlatformFontsForNode where
  type CommandResponse PCSSGetPlatformFontsForNode = CSSGetPlatformFontsForNode
  commandName :: Proxy PCSSGetPlatformFontsForNode -> String
commandName Proxy PCSSGetPlatformFontsForNode
_ = String
"CSS.getPlatformFontsForNode"

-- | Returns the current textual content for a stylesheet.

-- | Parameters of the 'CSS.getStyleSheetText' command.
data PCSSGetStyleSheetText = PCSSGetStyleSheetText
  {
    PCSSGetStyleSheetText -> Text
pCSSGetStyleSheetTextStyleSheetId :: CSSStyleSheetId
  }
  deriving (PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool
(PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool)
-> (PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool)
-> Eq PCSSGetStyleSheetText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool
$c/= :: PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool
== :: PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool
$c== :: PCSSGetStyleSheetText -> PCSSGetStyleSheetText -> Bool
Eq, Int -> PCSSGetStyleSheetText -> ShowS
[PCSSGetStyleSheetText] -> ShowS
PCSSGetStyleSheetText -> String
(Int -> PCSSGetStyleSheetText -> ShowS)
-> (PCSSGetStyleSheetText -> String)
-> ([PCSSGetStyleSheetText] -> ShowS)
-> Show PCSSGetStyleSheetText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetStyleSheetText] -> ShowS
$cshowList :: [PCSSGetStyleSheetText] -> ShowS
show :: PCSSGetStyleSheetText -> String
$cshow :: PCSSGetStyleSheetText -> String
showsPrec :: Int -> PCSSGetStyleSheetText -> ShowS
$cshowsPrec :: Int -> PCSSGetStyleSheetText -> ShowS
Show)
pCSSGetStyleSheetText
  :: CSSStyleSheetId
  -> PCSSGetStyleSheetText
pCSSGetStyleSheetText :: Text -> PCSSGetStyleSheetText
pCSSGetStyleSheetText
  Text
arg_pCSSGetStyleSheetTextStyleSheetId
  = Text -> PCSSGetStyleSheetText
PCSSGetStyleSheetText
    Text
arg_pCSSGetStyleSheetTextStyleSheetId
instance ToJSON PCSSGetStyleSheetText where
  toJSON :: PCSSGetStyleSheetText -> Value
toJSON PCSSGetStyleSheetText
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
"styleSheetId" 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 (PCSSGetStyleSheetText -> Text
pCSSGetStyleSheetTextStyleSheetId PCSSGetStyleSheetText
p)
    ]
data CSSGetStyleSheetText = CSSGetStyleSheetText
  {
    -- | The stylesheet text.
    CSSGetStyleSheetText -> Text
cSSGetStyleSheetTextText :: T.Text
  }
  deriving (CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool
(CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool)
-> (CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool)
-> Eq CSSGetStyleSheetText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool
$c/= :: CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool
== :: CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool
$c== :: CSSGetStyleSheetText -> CSSGetStyleSheetText -> Bool
Eq, Int -> CSSGetStyleSheetText -> ShowS
[CSSGetStyleSheetText] -> ShowS
CSSGetStyleSheetText -> String
(Int -> CSSGetStyleSheetText -> ShowS)
-> (CSSGetStyleSheetText -> String)
-> ([CSSGetStyleSheetText] -> ShowS)
-> Show CSSGetStyleSheetText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetStyleSheetText] -> ShowS
$cshowList :: [CSSGetStyleSheetText] -> ShowS
show :: CSSGetStyleSheetText -> String
$cshow :: CSSGetStyleSheetText -> String
showsPrec :: Int -> CSSGetStyleSheetText -> ShowS
$cshowsPrec :: Int -> CSSGetStyleSheetText -> ShowS
Show)
instance FromJSON CSSGetStyleSheetText where
  parseJSON :: Value -> Parser CSSGetStyleSheetText
parseJSON = String
-> (Object -> Parser CSSGetStyleSheetText)
-> Value
-> Parser CSSGetStyleSheetText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetStyleSheetText" ((Object -> Parser CSSGetStyleSheetText)
 -> Value -> Parser CSSGetStyleSheetText)
-> (Object -> Parser CSSGetStyleSheetText)
-> Value
-> Parser CSSGetStyleSheetText
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> CSSGetStyleSheetText
CSSGetStyleSheetText
    (Text -> CSSGetStyleSheetText)
-> Parser Text -> Parser CSSGetStyleSheetText
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
"text"
instance Command PCSSGetStyleSheetText where
  type CommandResponse PCSSGetStyleSheetText = CSSGetStyleSheetText
  commandName :: Proxy PCSSGetStyleSheetText -> String
commandName Proxy PCSSGetStyleSheetText
_ = String
"CSS.getStyleSheetText"

-- | Returns all layers parsed by the rendering engine for the tree scope of a node.
--   Given a DOM element identified by nodeId, getLayersForNode returns the root
--   layer for the nearest ancestor document or shadow root. The layer root contains
--   the full layer tree for the tree scope and their ordering.

-- | Parameters of the 'CSS.getLayersForNode' command.
data PCSSGetLayersForNode = PCSSGetLayersForNode
  {
    PCSSGetLayersForNode -> Int
pCSSGetLayersForNodeNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId
  }
  deriving (PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool
(PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool)
-> (PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool)
-> Eq PCSSGetLayersForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool
$c/= :: PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool
== :: PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool
$c== :: PCSSGetLayersForNode -> PCSSGetLayersForNode -> Bool
Eq, Int -> PCSSGetLayersForNode -> ShowS
[PCSSGetLayersForNode] -> ShowS
PCSSGetLayersForNode -> String
(Int -> PCSSGetLayersForNode -> ShowS)
-> (PCSSGetLayersForNode -> String)
-> ([PCSSGetLayersForNode] -> ShowS)
-> Show PCSSGetLayersForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSGetLayersForNode] -> ShowS
$cshowList :: [PCSSGetLayersForNode] -> ShowS
show :: PCSSGetLayersForNode -> String
$cshow :: PCSSGetLayersForNode -> String
showsPrec :: Int -> PCSSGetLayersForNode -> ShowS
$cshowsPrec :: Int -> PCSSGetLayersForNode -> ShowS
Show)
pCSSGetLayersForNode
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> PCSSGetLayersForNode
pCSSGetLayersForNode :: Int -> PCSSGetLayersForNode
pCSSGetLayersForNode
  Int
arg_pCSSGetLayersForNodeNodeId
  = Int -> PCSSGetLayersForNode
PCSSGetLayersForNode
    Int
arg_pCSSGetLayersForNodeNodeId
instance ToJSON PCSSGetLayersForNode where
  toJSON :: PCSSGetLayersForNode -> Value
toJSON PCSSGetLayersForNode
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
"nodeId" 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 (PCSSGetLayersForNode -> Int
pCSSGetLayersForNodeNodeId PCSSGetLayersForNode
p)
    ]
data CSSGetLayersForNode = CSSGetLayersForNode
  {
    CSSGetLayersForNode -> CSSCSSLayerData
cSSGetLayersForNodeRootLayer :: CSSCSSLayerData
  }
  deriving (CSSGetLayersForNode -> CSSGetLayersForNode -> Bool
(CSSGetLayersForNode -> CSSGetLayersForNode -> Bool)
-> (CSSGetLayersForNode -> CSSGetLayersForNode -> Bool)
-> Eq CSSGetLayersForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSGetLayersForNode -> CSSGetLayersForNode -> Bool
$c/= :: CSSGetLayersForNode -> CSSGetLayersForNode -> Bool
== :: CSSGetLayersForNode -> CSSGetLayersForNode -> Bool
$c== :: CSSGetLayersForNode -> CSSGetLayersForNode -> Bool
Eq, Int -> CSSGetLayersForNode -> ShowS
[CSSGetLayersForNode] -> ShowS
CSSGetLayersForNode -> String
(Int -> CSSGetLayersForNode -> ShowS)
-> (CSSGetLayersForNode -> String)
-> ([CSSGetLayersForNode] -> ShowS)
-> Show CSSGetLayersForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSGetLayersForNode] -> ShowS
$cshowList :: [CSSGetLayersForNode] -> ShowS
show :: CSSGetLayersForNode -> String
$cshow :: CSSGetLayersForNode -> String
showsPrec :: Int -> CSSGetLayersForNode -> ShowS
$cshowsPrec :: Int -> CSSGetLayersForNode -> ShowS
Show)
instance FromJSON CSSGetLayersForNode where
  parseJSON :: Value -> Parser CSSGetLayersForNode
parseJSON = String
-> (Object -> Parser CSSGetLayersForNode)
-> Value
-> Parser CSSGetLayersForNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSGetLayersForNode" ((Object -> Parser CSSGetLayersForNode)
 -> Value -> Parser CSSGetLayersForNode)
-> (Object -> Parser CSSGetLayersForNode)
-> Value
-> Parser CSSGetLayersForNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSLayerData -> CSSGetLayersForNode
CSSGetLayersForNode
    (CSSCSSLayerData -> CSSGetLayersForNode)
-> Parser CSSCSSLayerData -> Parser CSSGetLayersForNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSLayerData
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"rootLayer"
instance Command PCSSGetLayersForNode where
  type CommandResponse PCSSGetLayersForNode = CSSGetLayersForNode
  commandName :: Proxy PCSSGetLayersForNode -> String
commandName Proxy PCSSGetLayersForNode
_ = String
"CSS.getLayersForNode"

-- | Starts tracking the given computed styles for updates. The specified array of properties
--   replaces the one previously specified. Pass empty array to disable tracking.
--   Use takeComputedStyleUpdates to retrieve the list of nodes that had properties modified.
--   The changes to computed style properties are only tracked for nodes pushed to the front-end
--   by the DOM agent. If no changes to the tracked properties occur after the node has been pushed
--   to the front-end, no updates will be issued for the node.

-- | Parameters of the 'CSS.trackComputedStyleUpdates' command.
data PCSSTrackComputedStyleUpdates = PCSSTrackComputedStyleUpdates
  {
    PCSSTrackComputedStyleUpdates -> [CSSCSSComputedStyleProperty]
pCSSTrackComputedStyleUpdatesPropertiesToTrack :: [CSSCSSComputedStyleProperty]
  }
  deriving (PCSSTrackComputedStyleUpdates
-> PCSSTrackComputedStyleUpdates -> Bool
(PCSSTrackComputedStyleUpdates
 -> PCSSTrackComputedStyleUpdates -> Bool)
-> (PCSSTrackComputedStyleUpdates
    -> PCSSTrackComputedStyleUpdates -> Bool)
-> Eq PCSSTrackComputedStyleUpdates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSTrackComputedStyleUpdates
-> PCSSTrackComputedStyleUpdates -> Bool
$c/= :: PCSSTrackComputedStyleUpdates
-> PCSSTrackComputedStyleUpdates -> Bool
== :: PCSSTrackComputedStyleUpdates
-> PCSSTrackComputedStyleUpdates -> Bool
$c== :: PCSSTrackComputedStyleUpdates
-> PCSSTrackComputedStyleUpdates -> Bool
Eq, Int -> PCSSTrackComputedStyleUpdates -> ShowS
[PCSSTrackComputedStyleUpdates] -> ShowS
PCSSTrackComputedStyleUpdates -> String
(Int -> PCSSTrackComputedStyleUpdates -> ShowS)
-> (PCSSTrackComputedStyleUpdates -> String)
-> ([PCSSTrackComputedStyleUpdates] -> ShowS)
-> Show PCSSTrackComputedStyleUpdates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSTrackComputedStyleUpdates] -> ShowS
$cshowList :: [PCSSTrackComputedStyleUpdates] -> ShowS
show :: PCSSTrackComputedStyleUpdates -> String
$cshow :: PCSSTrackComputedStyleUpdates -> String
showsPrec :: Int -> PCSSTrackComputedStyleUpdates -> ShowS
$cshowsPrec :: Int -> PCSSTrackComputedStyleUpdates -> ShowS
Show)
pCSSTrackComputedStyleUpdates
  :: [CSSCSSComputedStyleProperty]
  -> PCSSTrackComputedStyleUpdates
pCSSTrackComputedStyleUpdates :: [CSSCSSComputedStyleProperty] -> PCSSTrackComputedStyleUpdates
pCSSTrackComputedStyleUpdates
  [CSSCSSComputedStyleProperty]
arg_pCSSTrackComputedStyleUpdatesPropertiesToTrack
  = [CSSCSSComputedStyleProperty] -> PCSSTrackComputedStyleUpdates
PCSSTrackComputedStyleUpdates
    [CSSCSSComputedStyleProperty]
arg_pCSSTrackComputedStyleUpdatesPropertiesToTrack
instance ToJSON PCSSTrackComputedStyleUpdates where
  toJSON :: PCSSTrackComputedStyleUpdates -> Value
toJSON PCSSTrackComputedStyleUpdates
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
"propertiesToTrack" Text -> [CSSCSSComputedStyleProperty] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSCSSComputedStyleProperty] -> Pair)
-> Maybe [CSSCSSComputedStyleProperty] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSCSSComputedStyleProperty]
-> Maybe [CSSCSSComputedStyleProperty]
forall a. a -> Maybe a
Just (PCSSTrackComputedStyleUpdates -> [CSSCSSComputedStyleProperty]
pCSSTrackComputedStyleUpdatesPropertiesToTrack PCSSTrackComputedStyleUpdates
p)
    ]
instance Command PCSSTrackComputedStyleUpdates where
  type CommandResponse PCSSTrackComputedStyleUpdates = ()
  commandName :: Proxy PCSSTrackComputedStyleUpdates -> String
commandName Proxy PCSSTrackComputedStyleUpdates
_ = String
"CSS.trackComputedStyleUpdates"
  fromJSON :: Proxy PCSSTrackComputedStyleUpdates
-> Value -> Result (CommandResponse PCSSTrackComputedStyleUpdates)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCSSTrackComputedStyleUpdates -> Result ())
-> Proxy PCSSTrackComputedStyleUpdates
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCSSTrackComputedStyleUpdates -> ())
-> Proxy PCSSTrackComputedStyleUpdates
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCSSTrackComputedStyleUpdates -> ()
forall a b. a -> b -> a
const ()

-- | Polls the next batch of computed style updates.

-- | Parameters of the 'CSS.takeComputedStyleUpdates' command.
data PCSSTakeComputedStyleUpdates = PCSSTakeComputedStyleUpdates
  deriving (PCSSTakeComputedStyleUpdates
-> PCSSTakeComputedStyleUpdates -> Bool
(PCSSTakeComputedStyleUpdates
 -> PCSSTakeComputedStyleUpdates -> Bool)
-> (PCSSTakeComputedStyleUpdates
    -> PCSSTakeComputedStyleUpdates -> Bool)
-> Eq PCSSTakeComputedStyleUpdates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSTakeComputedStyleUpdates
-> PCSSTakeComputedStyleUpdates -> Bool
$c/= :: PCSSTakeComputedStyleUpdates
-> PCSSTakeComputedStyleUpdates -> Bool
== :: PCSSTakeComputedStyleUpdates
-> PCSSTakeComputedStyleUpdates -> Bool
$c== :: PCSSTakeComputedStyleUpdates
-> PCSSTakeComputedStyleUpdates -> Bool
Eq, Int -> PCSSTakeComputedStyleUpdates -> ShowS
[PCSSTakeComputedStyleUpdates] -> ShowS
PCSSTakeComputedStyleUpdates -> String
(Int -> PCSSTakeComputedStyleUpdates -> ShowS)
-> (PCSSTakeComputedStyleUpdates -> String)
-> ([PCSSTakeComputedStyleUpdates] -> ShowS)
-> Show PCSSTakeComputedStyleUpdates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSTakeComputedStyleUpdates] -> ShowS
$cshowList :: [PCSSTakeComputedStyleUpdates] -> ShowS
show :: PCSSTakeComputedStyleUpdates -> String
$cshow :: PCSSTakeComputedStyleUpdates -> String
showsPrec :: Int -> PCSSTakeComputedStyleUpdates -> ShowS
$cshowsPrec :: Int -> PCSSTakeComputedStyleUpdates -> ShowS
Show)
pCSSTakeComputedStyleUpdates
  :: PCSSTakeComputedStyleUpdates
pCSSTakeComputedStyleUpdates :: PCSSTakeComputedStyleUpdates
pCSSTakeComputedStyleUpdates
  = PCSSTakeComputedStyleUpdates
PCSSTakeComputedStyleUpdates
instance ToJSON PCSSTakeComputedStyleUpdates where
  toJSON :: PCSSTakeComputedStyleUpdates -> Value
toJSON PCSSTakeComputedStyleUpdates
_ = Value
A.Null
data CSSTakeComputedStyleUpdates = CSSTakeComputedStyleUpdates
  {
    -- | The list of node Ids that have their tracked computed styles updated
    CSSTakeComputedStyleUpdates -> [Int]
cSSTakeComputedStyleUpdatesNodeIds :: [DOMPageNetworkEmulationSecurity.DOMNodeId]
  }
  deriving (CSSTakeComputedStyleUpdates -> CSSTakeComputedStyleUpdates -> Bool
(CSSTakeComputedStyleUpdates
 -> CSSTakeComputedStyleUpdates -> Bool)
-> (CSSTakeComputedStyleUpdates
    -> CSSTakeComputedStyleUpdates -> Bool)
-> Eq CSSTakeComputedStyleUpdates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSTakeComputedStyleUpdates -> CSSTakeComputedStyleUpdates -> Bool
$c/= :: CSSTakeComputedStyleUpdates -> CSSTakeComputedStyleUpdates -> Bool
== :: CSSTakeComputedStyleUpdates -> CSSTakeComputedStyleUpdates -> Bool
$c== :: CSSTakeComputedStyleUpdates -> CSSTakeComputedStyleUpdates -> Bool
Eq, Int -> CSSTakeComputedStyleUpdates -> ShowS
[CSSTakeComputedStyleUpdates] -> ShowS
CSSTakeComputedStyleUpdates -> String
(Int -> CSSTakeComputedStyleUpdates -> ShowS)
-> (CSSTakeComputedStyleUpdates -> String)
-> ([CSSTakeComputedStyleUpdates] -> ShowS)
-> Show CSSTakeComputedStyleUpdates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSTakeComputedStyleUpdates] -> ShowS
$cshowList :: [CSSTakeComputedStyleUpdates] -> ShowS
show :: CSSTakeComputedStyleUpdates -> String
$cshow :: CSSTakeComputedStyleUpdates -> String
showsPrec :: Int -> CSSTakeComputedStyleUpdates -> ShowS
$cshowsPrec :: Int -> CSSTakeComputedStyleUpdates -> ShowS
Show)
instance FromJSON CSSTakeComputedStyleUpdates where
  parseJSON :: Value -> Parser CSSTakeComputedStyleUpdates
parseJSON = String
-> (Object -> Parser CSSTakeComputedStyleUpdates)
-> Value
-> Parser CSSTakeComputedStyleUpdates
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSTakeComputedStyleUpdates" ((Object -> Parser CSSTakeComputedStyleUpdates)
 -> Value -> Parser CSSTakeComputedStyleUpdates)
-> (Object -> Parser CSSTakeComputedStyleUpdates)
-> Value
-> Parser CSSTakeComputedStyleUpdates
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int] -> CSSTakeComputedStyleUpdates
CSSTakeComputedStyleUpdates
    ([Int] -> CSSTakeComputedStyleUpdates)
-> Parser [Int] -> Parser CSSTakeComputedStyleUpdates
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
"nodeIds"
instance Command PCSSTakeComputedStyleUpdates where
  type CommandResponse PCSSTakeComputedStyleUpdates = CSSTakeComputedStyleUpdates
  commandName :: Proxy PCSSTakeComputedStyleUpdates -> String
commandName Proxy PCSSTakeComputedStyleUpdates
_ = String
"CSS.takeComputedStyleUpdates"

-- | Find a rule with the given active property for the given node and set the new value for this
--   property

-- | Parameters of the 'CSS.setEffectivePropertyValueForNode' command.
data PCSSSetEffectivePropertyValueForNode = PCSSSetEffectivePropertyValueForNode
  {
    -- | The element id for which to set property.
    PCSSSetEffectivePropertyValueForNode -> Int
pCSSSetEffectivePropertyValueForNodeNodeId :: DOMPageNetworkEmulationSecurity.DOMNodeId,
    PCSSSetEffectivePropertyValueForNode -> Text
pCSSSetEffectivePropertyValueForNodePropertyName :: T.Text,
    PCSSSetEffectivePropertyValueForNode -> Text
pCSSSetEffectivePropertyValueForNodeValue :: T.Text
  }
  deriving (PCSSSetEffectivePropertyValueForNode
-> PCSSSetEffectivePropertyValueForNode -> Bool
(PCSSSetEffectivePropertyValueForNode
 -> PCSSSetEffectivePropertyValueForNode -> Bool)
-> (PCSSSetEffectivePropertyValueForNode
    -> PCSSSetEffectivePropertyValueForNode -> Bool)
-> Eq PCSSSetEffectivePropertyValueForNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetEffectivePropertyValueForNode
-> PCSSSetEffectivePropertyValueForNode -> Bool
$c/= :: PCSSSetEffectivePropertyValueForNode
-> PCSSSetEffectivePropertyValueForNode -> Bool
== :: PCSSSetEffectivePropertyValueForNode
-> PCSSSetEffectivePropertyValueForNode -> Bool
$c== :: PCSSSetEffectivePropertyValueForNode
-> PCSSSetEffectivePropertyValueForNode -> Bool
Eq, Int -> PCSSSetEffectivePropertyValueForNode -> ShowS
[PCSSSetEffectivePropertyValueForNode] -> ShowS
PCSSSetEffectivePropertyValueForNode -> String
(Int -> PCSSSetEffectivePropertyValueForNode -> ShowS)
-> (PCSSSetEffectivePropertyValueForNode -> String)
-> ([PCSSSetEffectivePropertyValueForNode] -> ShowS)
-> Show PCSSSetEffectivePropertyValueForNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetEffectivePropertyValueForNode] -> ShowS
$cshowList :: [PCSSSetEffectivePropertyValueForNode] -> ShowS
show :: PCSSSetEffectivePropertyValueForNode -> String
$cshow :: PCSSSetEffectivePropertyValueForNode -> String
showsPrec :: Int -> PCSSSetEffectivePropertyValueForNode -> ShowS
$cshowsPrec :: Int -> PCSSSetEffectivePropertyValueForNode -> ShowS
Show)
pCSSSetEffectivePropertyValueForNode
  {-
  -- | The element id for which to set property.
  -}
  :: DOMPageNetworkEmulationSecurity.DOMNodeId
  -> T.Text
  -> T.Text
  -> PCSSSetEffectivePropertyValueForNode
pCSSSetEffectivePropertyValueForNode :: Int -> Text -> Text -> PCSSSetEffectivePropertyValueForNode
pCSSSetEffectivePropertyValueForNode
  Int
arg_pCSSSetEffectivePropertyValueForNodeNodeId
  Text
arg_pCSSSetEffectivePropertyValueForNodePropertyName
  Text
arg_pCSSSetEffectivePropertyValueForNodeValue
  = Int -> Text -> Text -> PCSSSetEffectivePropertyValueForNode
PCSSSetEffectivePropertyValueForNode
    Int
arg_pCSSSetEffectivePropertyValueForNodeNodeId
    Text
arg_pCSSSetEffectivePropertyValueForNodePropertyName
    Text
arg_pCSSSetEffectivePropertyValueForNodeValue
instance ToJSON PCSSSetEffectivePropertyValueForNode where
  toJSON :: PCSSSetEffectivePropertyValueForNode -> Value
toJSON PCSSSetEffectivePropertyValueForNode
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
"nodeId" 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 (PCSSSetEffectivePropertyValueForNode -> Int
pCSSSetEffectivePropertyValueForNodeNodeId PCSSSetEffectivePropertyValueForNode
p),
    (Text
"propertyName" 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 (PCSSSetEffectivePropertyValueForNode -> Text
pCSSSetEffectivePropertyValueForNodePropertyName PCSSSetEffectivePropertyValueForNode
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 (PCSSSetEffectivePropertyValueForNode -> Text
pCSSSetEffectivePropertyValueForNodeValue PCSSSetEffectivePropertyValueForNode
p)
    ]
instance Command PCSSSetEffectivePropertyValueForNode where
  type CommandResponse PCSSSetEffectivePropertyValueForNode = ()
  commandName :: Proxy PCSSSetEffectivePropertyValueForNode -> String
commandName Proxy PCSSSetEffectivePropertyValueForNode
_ = String
"CSS.setEffectivePropertyValueForNode"
  fromJSON :: Proxy PCSSSetEffectivePropertyValueForNode
-> Value
-> Result (CommandResponse PCSSSetEffectivePropertyValueForNode)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCSSSetEffectivePropertyValueForNode -> Result ())
-> Proxy PCSSSetEffectivePropertyValueForNode
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCSSSetEffectivePropertyValueForNode -> ())
-> Proxy PCSSSetEffectivePropertyValueForNode
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCSSSetEffectivePropertyValueForNode -> ()
forall a b. a -> b -> a
const ()

-- | Modifies the keyframe rule key text.

-- | Parameters of the 'CSS.setKeyframeKey' command.
data PCSSSetKeyframeKey = PCSSSetKeyframeKey
  {
    PCSSSetKeyframeKey -> Text
pCSSSetKeyframeKeyStyleSheetId :: CSSStyleSheetId,
    PCSSSetKeyframeKey -> CSSSourceRange
pCSSSetKeyframeKeyRange :: CSSSourceRange,
    PCSSSetKeyframeKey -> Text
pCSSSetKeyframeKeyKeyText :: T.Text
  }
  deriving (PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool
(PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool)
-> (PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool)
-> Eq PCSSSetKeyframeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool
$c/= :: PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool
== :: PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool
$c== :: PCSSSetKeyframeKey -> PCSSSetKeyframeKey -> Bool
Eq, Int -> PCSSSetKeyframeKey -> ShowS
[PCSSSetKeyframeKey] -> ShowS
PCSSSetKeyframeKey -> String
(Int -> PCSSSetKeyframeKey -> ShowS)
-> (PCSSSetKeyframeKey -> String)
-> ([PCSSSetKeyframeKey] -> ShowS)
-> Show PCSSSetKeyframeKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetKeyframeKey] -> ShowS
$cshowList :: [PCSSSetKeyframeKey] -> ShowS
show :: PCSSSetKeyframeKey -> String
$cshow :: PCSSSetKeyframeKey -> String
showsPrec :: Int -> PCSSSetKeyframeKey -> ShowS
$cshowsPrec :: Int -> PCSSSetKeyframeKey -> ShowS
Show)
pCSSSetKeyframeKey
  :: CSSStyleSheetId
  -> CSSSourceRange
  -> T.Text
  -> PCSSSetKeyframeKey
pCSSSetKeyframeKey :: Text -> CSSSourceRange -> Text -> PCSSSetKeyframeKey
pCSSSetKeyframeKey
  Text
arg_pCSSSetKeyframeKeyStyleSheetId
  CSSSourceRange
arg_pCSSSetKeyframeKeyRange
  Text
arg_pCSSSetKeyframeKeyKeyText
  = Text -> CSSSourceRange -> Text -> PCSSSetKeyframeKey
PCSSSetKeyframeKey
    Text
arg_pCSSSetKeyframeKeyStyleSheetId
    CSSSourceRange
arg_pCSSSetKeyframeKeyRange
    Text
arg_pCSSSetKeyframeKeyKeyText
instance ToJSON PCSSSetKeyframeKey where
  toJSON :: PCSSSetKeyframeKey -> Value
toJSON PCSSSetKeyframeKey
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
"styleSheetId" 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 (PCSSSetKeyframeKey -> Text
pCSSSetKeyframeKeyStyleSheetId PCSSSetKeyframeKey
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSSetKeyframeKey -> CSSSourceRange
pCSSSetKeyframeKeyRange PCSSSetKeyframeKey
p),
    (Text
"keyText" 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 (PCSSSetKeyframeKey -> Text
pCSSSetKeyframeKeyKeyText PCSSSetKeyframeKey
p)
    ]
data CSSSetKeyframeKey = CSSSetKeyframeKey
  {
    -- | The resulting key text after modification.
    CSSSetKeyframeKey -> CSSValue
cSSSetKeyframeKeyKeyText :: CSSValue
  }
  deriving (CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool
(CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool)
-> (CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool)
-> Eq CSSSetKeyframeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool
$c/= :: CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool
== :: CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool
$c== :: CSSSetKeyframeKey -> CSSSetKeyframeKey -> Bool
Eq, Int -> CSSSetKeyframeKey -> ShowS
[CSSSetKeyframeKey] -> ShowS
CSSSetKeyframeKey -> String
(Int -> CSSSetKeyframeKey -> ShowS)
-> (CSSSetKeyframeKey -> String)
-> ([CSSSetKeyframeKey] -> ShowS)
-> Show CSSSetKeyframeKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetKeyframeKey] -> ShowS
$cshowList :: [CSSSetKeyframeKey] -> ShowS
show :: CSSSetKeyframeKey -> String
$cshow :: CSSSetKeyframeKey -> String
showsPrec :: Int -> CSSSetKeyframeKey -> ShowS
$cshowsPrec :: Int -> CSSSetKeyframeKey -> ShowS
Show)
instance FromJSON CSSSetKeyframeKey where
  parseJSON :: Value -> Parser CSSSetKeyframeKey
parseJSON = String
-> (Object -> Parser CSSSetKeyframeKey)
-> Value
-> Parser CSSSetKeyframeKey
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetKeyframeKey" ((Object -> Parser CSSSetKeyframeKey)
 -> Value -> Parser CSSSetKeyframeKey)
-> (Object -> Parser CSSSetKeyframeKey)
-> Value
-> Parser CSSSetKeyframeKey
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSValue -> CSSSetKeyframeKey
CSSSetKeyframeKey
    (CSSValue -> CSSSetKeyframeKey)
-> Parser CSSValue -> Parser CSSSetKeyframeKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSValue
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"keyText"
instance Command PCSSSetKeyframeKey where
  type CommandResponse PCSSSetKeyframeKey = CSSSetKeyframeKey
  commandName :: Proxy PCSSSetKeyframeKey -> String
commandName Proxy PCSSSetKeyframeKey
_ = String
"CSS.setKeyframeKey"

-- | Modifies the rule selector.

-- | Parameters of the 'CSS.setMediaText' command.
data PCSSSetMediaText = PCSSSetMediaText
  {
    PCSSSetMediaText -> Text
pCSSSetMediaTextStyleSheetId :: CSSStyleSheetId,
    PCSSSetMediaText -> CSSSourceRange
pCSSSetMediaTextRange :: CSSSourceRange,
    PCSSSetMediaText -> Text
pCSSSetMediaTextText :: T.Text
  }
  deriving (PCSSSetMediaText -> PCSSSetMediaText -> Bool
(PCSSSetMediaText -> PCSSSetMediaText -> Bool)
-> (PCSSSetMediaText -> PCSSSetMediaText -> Bool)
-> Eq PCSSSetMediaText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetMediaText -> PCSSSetMediaText -> Bool
$c/= :: PCSSSetMediaText -> PCSSSetMediaText -> Bool
== :: PCSSSetMediaText -> PCSSSetMediaText -> Bool
$c== :: PCSSSetMediaText -> PCSSSetMediaText -> Bool
Eq, Int -> PCSSSetMediaText -> ShowS
[PCSSSetMediaText] -> ShowS
PCSSSetMediaText -> String
(Int -> PCSSSetMediaText -> ShowS)
-> (PCSSSetMediaText -> String)
-> ([PCSSSetMediaText] -> ShowS)
-> Show PCSSSetMediaText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetMediaText] -> ShowS
$cshowList :: [PCSSSetMediaText] -> ShowS
show :: PCSSSetMediaText -> String
$cshow :: PCSSSetMediaText -> String
showsPrec :: Int -> PCSSSetMediaText -> ShowS
$cshowsPrec :: Int -> PCSSSetMediaText -> ShowS
Show)
pCSSSetMediaText
  :: CSSStyleSheetId
  -> CSSSourceRange
  -> T.Text
  -> PCSSSetMediaText
pCSSSetMediaText :: Text -> CSSSourceRange -> Text -> PCSSSetMediaText
pCSSSetMediaText
  Text
arg_pCSSSetMediaTextStyleSheetId
  CSSSourceRange
arg_pCSSSetMediaTextRange
  Text
arg_pCSSSetMediaTextText
  = Text -> CSSSourceRange -> Text -> PCSSSetMediaText
PCSSSetMediaText
    Text
arg_pCSSSetMediaTextStyleSheetId
    CSSSourceRange
arg_pCSSSetMediaTextRange
    Text
arg_pCSSSetMediaTextText
instance ToJSON PCSSSetMediaText where
  toJSON :: PCSSSetMediaText -> Value
toJSON PCSSSetMediaText
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
"styleSheetId" 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 (PCSSSetMediaText -> Text
pCSSSetMediaTextStyleSheetId PCSSSetMediaText
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSSetMediaText -> CSSSourceRange
pCSSSetMediaTextRange PCSSSetMediaText
p),
    (Text
"text" 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 (PCSSSetMediaText -> Text
pCSSSetMediaTextText PCSSSetMediaText
p)
    ]
data CSSSetMediaText = CSSSetMediaText
  {
    -- | The resulting CSS media rule after modification.
    CSSSetMediaText -> CSSCSSMedia
cSSSetMediaTextMedia :: CSSCSSMedia
  }
  deriving (CSSSetMediaText -> CSSSetMediaText -> Bool
(CSSSetMediaText -> CSSSetMediaText -> Bool)
-> (CSSSetMediaText -> CSSSetMediaText -> Bool)
-> Eq CSSSetMediaText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetMediaText -> CSSSetMediaText -> Bool
$c/= :: CSSSetMediaText -> CSSSetMediaText -> Bool
== :: CSSSetMediaText -> CSSSetMediaText -> Bool
$c== :: CSSSetMediaText -> CSSSetMediaText -> Bool
Eq, Int -> CSSSetMediaText -> ShowS
[CSSSetMediaText] -> ShowS
CSSSetMediaText -> String
(Int -> CSSSetMediaText -> ShowS)
-> (CSSSetMediaText -> String)
-> ([CSSSetMediaText] -> ShowS)
-> Show CSSSetMediaText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetMediaText] -> ShowS
$cshowList :: [CSSSetMediaText] -> ShowS
show :: CSSSetMediaText -> String
$cshow :: CSSSetMediaText -> String
showsPrec :: Int -> CSSSetMediaText -> ShowS
$cshowsPrec :: Int -> CSSSetMediaText -> ShowS
Show)
instance FromJSON CSSSetMediaText where
  parseJSON :: Value -> Parser CSSSetMediaText
parseJSON = String
-> (Object -> Parser CSSSetMediaText)
-> Value
-> Parser CSSSetMediaText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetMediaText" ((Object -> Parser CSSSetMediaText)
 -> Value -> Parser CSSSetMediaText)
-> (Object -> Parser CSSSetMediaText)
-> Value
-> Parser CSSSetMediaText
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSMedia -> CSSSetMediaText
CSSSetMediaText
    (CSSCSSMedia -> CSSSetMediaText)
-> Parser CSSCSSMedia -> Parser CSSSetMediaText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSMedia
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"media"
instance Command PCSSSetMediaText where
  type CommandResponse PCSSSetMediaText = CSSSetMediaText
  commandName :: Proxy PCSSSetMediaText -> String
commandName Proxy PCSSSetMediaText
_ = String
"CSS.setMediaText"

-- | Modifies the expression of a container query.

-- | Parameters of the 'CSS.setContainerQueryText' command.
data PCSSSetContainerQueryText = PCSSSetContainerQueryText
  {
    PCSSSetContainerQueryText -> Text
pCSSSetContainerQueryTextStyleSheetId :: CSSStyleSheetId,
    PCSSSetContainerQueryText -> CSSSourceRange
pCSSSetContainerQueryTextRange :: CSSSourceRange,
    PCSSSetContainerQueryText -> Text
pCSSSetContainerQueryTextText :: T.Text
  }
  deriving (PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool
(PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool)
-> (PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool)
-> Eq PCSSSetContainerQueryText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool
$c/= :: PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool
== :: PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool
$c== :: PCSSSetContainerQueryText -> PCSSSetContainerQueryText -> Bool
Eq, Int -> PCSSSetContainerQueryText -> ShowS
[PCSSSetContainerQueryText] -> ShowS
PCSSSetContainerQueryText -> String
(Int -> PCSSSetContainerQueryText -> ShowS)
-> (PCSSSetContainerQueryText -> String)
-> ([PCSSSetContainerQueryText] -> ShowS)
-> Show PCSSSetContainerQueryText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetContainerQueryText] -> ShowS
$cshowList :: [PCSSSetContainerQueryText] -> ShowS
show :: PCSSSetContainerQueryText -> String
$cshow :: PCSSSetContainerQueryText -> String
showsPrec :: Int -> PCSSSetContainerQueryText -> ShowS
$cshowsPrec :: Int -> PCSSSetContainerQueryText -> ShowS
Show)
pCSSSetContainerQueryText
  :: CSSStyleSheetId
  -> CSSSourceRange
  -> T.Text
  -> PCSSSetContainerQueryText
pCSSSetContainerQueryText :: Text -> CSSSourceRange -> Text -> PCSSSetContainerQueryText
pCSSSetContainerQueryText
  Text
arg_pCSSSetContainerQueryTextStyleSheetId
  CSSSourceRange
arg_pCSSSetContainerQueryTextRange
  Text
arg_pCSSSetContainerQueryTextText
  = Text -> CSSSourceRange -> Text -> PCSSSetContainerQueryText
PCSSSetContainerQueryText
    Text
arg_pCSSSetContainerQueryTextStyleSheetId
    CSSSourceRange
arg_pCSSSetContainerQueryTextRange
    Text
arg_pCSSSetContainerQueryTextText
instance ToJSON PCSSSetContainerQueryText where
  toJSON :: PCSSSetContainerQueryText -> Value
toJSON PCSSSetContainerQueryText
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
"styleSheetId" 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 (PCSSSetContainerQueryText -> Text
pCSSSetContainerQueryTextStyleSheetId PCSSSetContainerQueryText
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSSetContainerQueryText -> CSSSourceRange
pCSSSetContainerQueryTextRange PCSSSetContainerQueryText
p),
    (Text
"text" 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 (PCSSSetContainerQueryText -> Text
pCSSSetContainerQueryTextText PCSSSetContainerQueryText
p)
    ]
data CSSSetContainerQueryText = CSSSetContainerQueryText
  {
    -- | The resulting CSS container query rule after modification.
    CSSSetContainerQueryText -> CSSCSSContainerQuery
cSSSetContainerQueryTextContainerQuery :: CSSCSSContainerQuery
  }
  deriving (CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool
(CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool)
-> (CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool)
-> Eq CSSSetContainerQueryText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool
$c/= :: CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool
== :: CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool
$c== :: CSSSetContainerQueryText -> CSSSetContainerQueryText -> Bool
Eq, Int -> CSSSetContainerQueryText -> ShowS
[CSSSetContainerQueryText] -> ShowS
CSSSetContainerQueryText -> String
(Int -> CSSSetContainerQueryText -> ShowS)
-> (CSSSetContainerQueryText -> String)
-> ([CSSSetContainerQueryText] -> ShowS)
-> Show CSSSetContainerQueryText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetContainerQueryText] -> ShowS
$cshowList :: [CSSSetContainerQueryText] -> ShowS
show :: CSSSetContainerQueryText -> String
$cshow :: CSSSetContainerQueryText -> String
showsPrec :: Int -> CSSSetContainerQueryText -> ShowS
$cshowsPrec :: Int -> CSSSetContainerQueryText -> ShowS
Show)
instance FromJSON CSSSetContainerQueryText where
  parseJSON :: Value -> Parser CSSSetContainerQueryText
parseJSON = String
-> (Object -> Parser CSSSetContainerQueryText)
-> Value
-> Parser CSSSetContainerQueryText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetContainerQueryText" ((Object -> Parser CSSSetContainerQueryText)
 -> Value -> Parser CSSSetContainerQueryText)
-> (Object -> Parser CSSSetContainerQueryText)
-> Value
-> Parser CSSSetContainerQueryText
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSContainerQuery -> CSSSetContainerQueryText
CSSSetContainerQueryText
    (CSSCSSContainerQuery -> CSSSetContainerQueryText)
-> Parser CSSCSSContainerQuery -> Parser CSSSetContainerQueryText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSContainerQuery
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"containerQuery"
instance Command PCSSSetContainerQueryText where
  type CommandResponse PCSSSetContainerQueryText = CSSSetContainerQueryText
  commandName :: Proxy PCSSSetContainerQueryText -> String
commandName Proxy PCSSSetContainerQueryText
_ = String
"CSS.setContainerQueryText"

-- | Modifies the expression of a supports at-rule.

-- | Parameters of the 'CSS.setSupportsText' command.
data PCSSSetSupportsText = PCSSSetSupportsText
  {
    PCSSSetSupportsText -> Text
pCSSSetSupportsTextStyleSheetId :: CSSStyleSheetId,
    PCSSSetSupportsText -> CSSSourceRange
pCSSSetSupportsTextRange :: CSSSourceRange,
    PCSSSetSupportsText -> Text
pCSSSetSupportsTextText :: T.Text
  }
  deriving (PCSSSetSupportsText -> PCSSSetSupportsText -> Bool
(PCSSSetSupportsText -> PCSSSetSupportsText -> Bool)
-> (PCSSSetSupportsText -> PCSSSetSupportsText -> Bool)
-> Eq PCSSSetSupportsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetSupportsText -> PCSSSetSupportsText -> Bool
$c/= :: PCSSSetSupportsText -> PCSSSetSupportsText -> Bool
== :: PCSSSetSupportsText -> PCSSSetSupportsText -> Bool
$c== :: PCSSSetSupportsText -> PCSSSetSupportsText -> Bool
Eq, Int -> PCSSSetSupportsText -> ShowS
[PCSSSetSupportsText] -> ShowS
PCSSSetSupportsText -> String
(Int -> PCSSSetSupportsText -> ShowS)
-> (PCSSSetSupportsText -> String)
-> ([PCSSSetSupportsText] -> ShowS)
-> Show PCSSSetSupportsText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetSupportsText] -> ShowS
$cshowList :: [PCSSSetSupportsText] -> ShowS
show :: PCSSSetSupportsText -> String
$cshow :: PCSSSetSupportsText -> String
showsPrec :: Int -> PCSSSetSupportsText -> ShowS
$cshowsPrec :: Int -> PCSSSetSupportsText -> ShowS
Show)
pCSSSetSupportsText
  :: CSSStyleSheetId
  -> CSSSourceRange
  -> T.Text
  -> PCSSSetSupportsText
pCSSSetSupportsText :: Text -> CSSSourceRange -> Text -> PCSSSetSupportsText
pCSSSetSupportsText
  Text
arg_pCSSSetSupportsTextStyleSheetId
  CSSSourceRange
arg_pCSSSetSupportsTextRange
  Text
arg_pCSSSetSupportsTextText
  = Text -> CSSSourceRange -> Text -> PCSSSetSupportsText
PCSSSetSupportsText
    Text
arg_pCSSSetSupportsTextStyleSheetId
    CSSSourceRange
arg_pCSSSetSupportsTextRange
    Text
arg_pCSSSetSupportsTextText
instance ToJSON PCSSSetSupportsText where
  toJSON :: PCSSSetSupportsText -> Value
toJSON PCSSSetSupportsText
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
"styleSheetId" 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 (PCSSSetSupportsText -> Text
pCSSSetSupportsTextStyleSheetId PCSSSetSupportsText
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSSetSupportsText -> CSSSourceRange
pCSSSetSupportsTextRange PCSSSetSupportsText
p),
    (Text
"text" 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 (PCSSSetSupportsText -> Text
pCSSSetSupportsTextText PCSSSetSupportsText
p)
    ]
data CSSSetSupportsText = CSSSetSupportsText
  {
    -- | The resulting CSS Supports rule after modification.
    CSSSetSupportsText -> CSSCSSSupports
cSSSetSupportsTextSupports :: CSSCSSSupports
  }
  deriving (CSSSetSupportsText -> CSSSetSupportsText -> Bool
(CSSSetSupportsText -> CSSSetSupportsText -> Bool)
-> (CSSSetSupportsText -> CSSSetSupportsText -> Bool)
-> Eq CSSSetSupportsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetSupportsText -> CSSSetSupportsText -> Bool
$c/= :: CSSSetSupportsText -> CSSSetSupportsText -> Bool
== :: CSSSetSupportsText -> CSSSetSupportsText -> Bool
$c== :: CSSSetSupportsText -> CSSSetSupportsText -> Bool
Eq, Int -> CSSSetSupportsText -> ShowS
[CSSSetSupportsText] -> ShowS
CSSSetSupportsText -> String
(Int -> CSSSetSupportsText -> ShowS)
-> (CSSSetSupportsText -> String)
-> ([CSSSetSupportsText] -> ShowS)
-> Show CSSSetSupportsText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetSupportsText] -> ShowS
$cshowList :: [CSSSetSupportsText] -> ShowS
show :: CSSSetSupportsText -> String
$cshow :: CSSSetSupportsText -> String
showsPrec :: Int -> CSSSetSupportsText -> ShowS
$cshowsPrec :: Int -> CSSSetSupportsText -> ShowS
Show)
instance FromJSON CSSSetSupportsText where
  parseJSON :: Value -> Parser CSSSetSupportsText
parseJSON = String
-> (Object -> Parser CSSSetSupportsText)
-> Value
-> Parser CSSSetSupportsText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetSupportsText" ((Object -> Parser CSSSetSupportsText)
 -> Value -> Parser CSSSetSupportsText)
-> (Object -> Parser CSSSetSupportsText)
-> Value
-> Parser CSSSetSupportsText
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSSupports -> CSSSetSupportsText
CSSSetSupportsText
    (CSSCSSSupports -> CSSSetSupportsText)
-> Parser CSSCSSSupports -> Parser CSSSetSupportsText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSSupports
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"supports"
instance Command PCSSSetSupportsText where
  type CommandResponse PCSSSetSupportsText = CSSSetSupportsText
  commandName :: Proxy PCSSSetSupportsText -> String
commandName Proxy PCSSSetSupportsText
_ = String
"CSS.setSupportsText"

-- | Modifies the expression of a scope at-rule.

-- | Parameters of the 'CSS.setScopeText' command.
data PCSSSetScopeText = PCSSSetScopeText
  {
    PCSSSetScopeText -> Text
pCSSSetScopeTextStyleSheetId :: CSSStyleSheetId,
    PCSSSetScopeText -> CSSSourceRange
pCSSSetScopeTextRange :: CSSSourceRange,
    PCSSSetScopeText -> Text
pCSSSetScopeTextText :: T.Text
  }
  deriving (PCSSSetScopeText -> PCSSSetScopeText -> Bool
(PCSSSetScopeText -> PCSSSetScopeText -> Bool)
-> (PCSSSetScopeText -> PCSSSetScopeText -> Bool)
-> Eq PCSSSetScopeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetScopeText -> PCSSSetScopeText -> Bool
$c/= :: PCSSSetScopeText -> PCSSSetScopeText -> Bool
== :: PCSSSetScopeText -> PCSSSetScopeText -> Bool
$c== :: PCSSSetScopeText -> PCSSSetScopeText -> Bool
Eq, Int -> PCSSSetScopeText -> ShowS
[PCSSSetScopeText] -> ShowS
PCSSSetScopeText -> String
(Int -> PCSSSetScopeText -> ShowS)
-> (PCSSSetScopeText -> String)
-> ([PCSSSetScopeText] -> ShowS)
-> Show PCSSSetScopeText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetScopeText] -> ShowS
$cshowList :: [PCSSSetScopeText] -> ShowS
show :: PCSSSetScopeText -> String
$cshow :: PCSSSetScopeText -> String
showsPrec :: Int -> PCSSSetScopeText -> ShowS
$cshowsPrec :: Int -> PCSSSetScopeText -> ShowS
Show)
pCSSSetScopeText
  :: CSSStyleSheetId
  -> CSSSourceRange
  -> T.Text
  -> PCSSSetScopeText
pCSSSetScopeText :: Text -> CSSSourceRange -> Text -> PCSSSetScopeText
pCSSSetScopeText
  Text
arg_pCSSSetScopeTextStyleSheetId
  CSSSourceRange
arg_pCSSSetScopeTextRange
  Text
arg_pCSSSetScopeTextText
  = Text -> CSSSourceRange -> Text -> PCSSSetScopeText
PCSSSetScopeText
    Text
arg_pCSSSetScopeTextStyleSheetId
    CSSSourceRange
arg_pCSSSetScopeTextRange
    Text
arg_pCSSSetScopeTextText
instance ToJSON PCSSSetScopeText where
  toJSON :: PCSSSetScopeText -> Value
toJSON PCSSSetScopeText
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
"styleSheetId" 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 (PCSSSetScopeText -> Text
pCSSSetScopeTextStyleSheetId PCSSSetScopeText
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSSetScopeText -> CSSSourceRange
pCSSSetScopeTextRange PCSSSetScopeText
p),
    (Text
"text" 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 (PCSSSetScopeText -> Text
pCSSSetScopeTextText PCSSSetScopeText
p)
    ]
data CSSSetScopeText = CSSSetScopeText
  {
    -- | The resulting CSS Scope rule after modification.
    CSSSetScopeText -> CSSCSSScope
cSSSetScopeTextScope :: CSSCSSScope
  }
  deriving (CSSSetScopeText -> CSSSetScopeText -> Bool
(CSSSetScopeText -> CSSSetScopeText -> Bool)
-> (CSSSetScopeText -> CSSSetScopeText -> Bool)
-> Eq CSSSetScopeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetScopeText -> CSSSetScopeText -> Bool
$c/= :: CSSSetScopeText -> CSSSetScopeText -> Bool
== :: CSSSetScopeText -> CSSSetScopeText -> Bool
$c== :: CSSSetScopeText -> CSSSetScopeText -> Bool
Eq, Int -> CSSSetScopeText -> ShowS
[CSSSetScopeText] -> ShowS
CSSSetScopeText -> String
(Int -> CSSSetScopeText -> ShowS)
-> (CSSSetScopeText -> String)
-> ([CSSSetScopeText] -> ShowS)
-> Show CSSSetScopeText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetScopeText] -> ShowS
$cshowList :: [CSSSetScopeText] -> ShowS
show :: CSSSetScopeText -> String
$cshow :: CSSSetScopeText -> String
showsPrec :: Int -> CSSSetScopeText -> ShowS
$cshowsPrec :: Int -> CSSSetScopeText -> ShowS
Show)
instance FromJSON CSSSetScopeText where
  parseJSON :: Value -> Parser CSSSetScopeText
parseJSON = String
-> (Object -> Parser CSSSetScopeText)
-> Value
-> Parser CSSSetScopeText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetScopeText" ((Object -> Parser CSSSetScopeText)
 -> Value -> Parser CSSSetScopeText)
-> (Object -> Parser CSSSetScopeText)
-> Value
-> Parser CSSSetScopeText
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSCSSScope -> CSSSetScopeText
CSSSetScopeText
    (CSSCSSScope -> CSSSetScopeText)
-> Parser CSSCSSScope -> Parser CSSSetScopeText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSCSSScope
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"scope"
instance Command PCSSSetScopeText where
  type CommandResponse PCSSSetScopeText = CSSSetScopeText
  commandName :: Proxy PCSSSetScopeText -> String
commandName Proxy PCSSSetScopeText
_ = String
"CSS.setScopeText"

-- | Modifies the rule selector.

-- | Parameters of the 'CSS.setRuleSelector' command.
data PCSSSetRuleSelector = PCSSSetRuleSelector
  {
    PCSSSetRuleSelector -> Text
pCSSSetRuleSelectorStyleSheetId :: CSSStyleSheetId,
    PCSSSetRuleSelector -> CSSSourceRange
pCSSSetRuleSelectorRange :: CSSSourceRange,
    PCSSSetRuleSelector -> Text
pCSSSetRuleSelectorSelector :: T.Text
  }
  deriving (PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool
(PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool)
-> (PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool)
-> Eq PCSSSetRuleSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool
$c/= :: PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool
== :: PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool
$c== :: PCSSSetRuleSelector -> PCSSSetRuleSelector -> Bool
Eq, Int -> PCSSSetRuleSelector -> ShowS
[PCSSSetRuleSelector] -> ShowS
PCSSSetRuleSelector -> String
(Int -> PCSSSetRuleSelector -> ShowS)
-> (PCSSSetRuleSelector -> String)
-> ([PCSSSetRuleSelector] -> ShowS)
-> Show PCSSSetRuleSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetRuleSelector] -> ShowS
$cshowList :: [PCSSSetRuleSelector] -> ShowS
show :: PCSSSetRuleSelector -> String
$cshow :: PCSSSetRuleSelector -> String
showsPrec :: Int -> PCSSSetRuleSelector -> ShowS
$cshowsPrec :: Int -> PCSSSetRuleSelector -> ShowS
Show)
pCSSSetRuleSelector
  :: CSSStyleSheetId
  -> CSSSourceRange
  -> T.Text
  -> PCSSSetRuleSelector
pCSSSetRuleSelector :: Text -> CSSSourceRange -> Text -> PCSSSetRuleSelector
pCSSSetRuleSelector
  Text
arg_pCSSSetRuleSelectorStyleSheetId
  CSSSourceRange
arg_pCSSSetRuleSelectorRange
  Text
arg_pCSSSetRuleSelectorSelector
  = Text -> CSSSourceRange -> Text -> PCSSSetRuleSelector
PCSSSetRuleSelector
    Text
arg_pCSSSetRuleSelectorStyleSheetId
    CSSSourceRange
arg_pCSSSetRuleSelectorRange
    Text
arg_pCSSSetRuleSelectorSelector
instance ToJSON PCSSSetRuleSelector where
  toJSON :: PCSSSetRuleSelector -> Value
toJSON PCSSSetRuleSelector
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
"styleSheetId" 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 (PCSSSetRuleSelector -> Text
pCSSSetRuleSelectorStyleSheetId PCSSSetRuleSelector
p),
    (Text
"range" Text -> CSSSourceRange -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (CSSSourceRange -> Pair) -> Maybe CSSSourceRange -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CSSSourceRange -> Maybe CSSSourceRange
forall a. a -> Maybe a
Just (PCSSSetRuleSelector -> CSSSourceRange
pCSSSetRuleSelectorRange PCSSSetRuleSelector
p),
    (Text
"selector" 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 (PCSSSetRuleSelector -> Text
pCSSSetRuleSelectorSelector PCSSSetRuleSelector
p)
    ]
data CSSSetRuleSelector = CSSSetRuleSelector
  {
    -- | The resulting selector list after modification.
    CSSSetRuleSelector -> CSSSelectorList
cSSSetRuleSelectorSelectorList :: CSSSelectorList
  }
  deriving (CSSSetRuleSelector -> CSSSetRuleSelector -> Bool
(CSSSetRuleSelector -> CSSSetRuleSelector -> Bool)
-> (CSSSetRuleSelector -> CSSSetRuleSelector -> Bool)
-> Eq CSSSetRuleSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetRuleSelector -> CSSSetRuleSelector -> Bool
$c/= :: CSSSetRuleSelector -> CSSSetRuleSelector -> Bool
== :: CSSSetRuleSelector -> CSSSetRuleSelector -> Bool
$c== :: CSSSetRuleSelector -> CSSSetRuleSelector -> Bool
Eq, Int -> CSSSetRuleSelector -> ShowS
[CSSSetRuleSelector] -> ShowS
CSSSetRuleSelector -> String
(Int -> CSSSetRuleSelector -> ShowS)
-> (CSSSetRuleSelector -> String)
-> ([CSSSetRuleSelector] -> ShowS)
-> Show CSSSetRuleSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetRuleSelector] -> ShowS
$cshowList :: [CSSSetRuleSelector] -> ShowS
show :: CSSSetRuleSelector -> String
$cshow :: CSSSetRuleSelector -> String
showsPrec :: Int -> CSSSetRuleSelector -> ShowS
$cshowsPrec :: Int -> CSSSetRuleSelector -> ShowS
Show)
instance FromJSON CSSSetRuleSelector where
  parseJSON :: Value -> Parser CSSSetRuleSelector
parseJSON = String
-> (Object -> Parser CSSSetRuleSelector)
-> Value
-> Parser CSSSetRuleSelector
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetRuleSelector" ((Object -> Parser CSSSetRuleSelector)
 -> Value -> Parser CSSSetRuleSelector)
-> (Object -> Parser CSSSetRuleSelector)
-> Value
-> Parser CSSSetRuleSelector
forall a b. (a -> b) -> a -> b
$ \Object
o -> CSSSelectorList -> CSSSetRuleSelector
CSSSetRuleSelector
    (CSSSelectorList -> CSSSetRuleSelector)
-> Parser CSSSelectorList -> Parser CSSSetRuleSelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser CSSSelectorList
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"selectorList"
instance Command PCSSSetRuleSelector where
  type CommandResponse PCSSSetRuleSelector = CSSSetRuleSelector
  commandName :: Proxy PCSSSetRuleSelector -> String
commandName Proxy PCSSSetRuleSelector
_ = String
"CSS.setRuleSelector"

-- | Sets the new stylesheet text.

-- | Parameters of the 'CSS.setStyleSheetText' command.
data PCSSSetStyleSheetText = PCSSSetStyleSheetText
  {
    PCSSSetStyleSheetText -> Text
pCSSSetStyleSheetTextStyleSheetId :: CSSStyleSheetId,
    PCSSSetStyleSheetText -> Text
pCSSSetStyleSheetTextText :: T.Text
  }
  deriving (PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool
(PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool)
-> (PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool)
-> Eq PCSSSetStyleSheetText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool
$c/= :: PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool
== :: PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool
$c== :: PCSSSetStyleSheetText -> PCSSSetStyleSheetText -> Bool
Eq, Int -> PCSSSetStyleSheetText -> ShowS
[PCSSSetStyleSheetText] -> ShowS
PCSSSetStyleSheetText -> String
(Int -> PCSSSetStyleSheetText -> ShowS)
-> (PCSSSetStyleSheetText -> String)
-> ([PCSSSetStyleSheetText] -> ShowS)
-> Show PCSSSetStyleSheetText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetStyleSheetText] -> ShowS
$cshowList :: [PCSSSetStyleSheetText] -> ShowS
show :: PCSSSetStyleSheetText -> String
$cshow :: PCSSSetStyleSheetText -> String
showsPrec :: Int -> PCSSSetStyleSheetText -> ShowS
$cshowsPrec :: Int -> PCSSSetStyleSheetText -> ShowS
Show)
pCSSSetStyleSheetText
  :: CSSStyleSheetId
  -> T.Text
  -> PCSSSetStyleSheetText
pCSSSetStyleSheetText :: Text -> Text -> PCSSSetStyleSheetText
pCSSSetStyleSheetText
  Text
arg_pCSSSetStyleSheetTextStyleSheetId
  Text
arg_pCSSSetStyleSheetTextText
  = Text -> Text -> PCSSSetStyleSheetText
PCSSSetStyleSheetText
    Text
arg_pCSSSetStyleSheetTextStyleSheetId
    Text
arg_pCSSSetStyleSheetTextText
instance ToJSON PCSSSetStyleSheetText where
  toJSON :: PCSSSetStyleSheetText -> Value
toJSON PCSSSetStyleSheetText
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
"styleSheetId" 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 (PCSSSetStyleSheetText -> Text
pCSSSetStyleSheetTextStyleSheetId PCSSSetStyleSheetText
p),
    (Text
"text" 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 (PCSSSetStyleSheetText -> Text
pCSSSetStyleSheetTextText PCSSSetStyleSheetText
p)
    ]
data CSSSetStyleSheetText = CSSSetStyleSheetText
  {
    -- | URL of source map associated with script (if any).
    CSSSetStyleSheetText -> Maybe Text
cSSSetStyleSheetTextSourceMapURL :: Maybe T.Text
  }
  deriving (CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool
(CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool)
-> (CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool)
-> Eq CSSSetStyleSheetText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool
$c/= :: CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool
== :: CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool
$c== :: CSSSetStyleSheetText -> CSSSetStyleSheetText -> Bool
Eq, Int -> CSSSetStyleSheetText -> ShowS
[CSSSetStyleSheetText] -> ShowS
CSSSetStyleSheetText -> String
(Int -> CSSSetStyleSheetText -> ShowS)
-> (CSSSetStyleSheetText -> String)
-> ([CSSSetStyleSheetText] -> ShowS)
-> Show CSSSetStyleSheetText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetStyleSheetText] -> ShowS
$cshowList :: [CSSSetStyleSheetText] -> ShowS
show :: CSSSetStyleSheetText -> String
$cshow :: CSSSetStyleSheetText -> String
showsPrec :: Int -> CSSSetStyleSheetText -> ShowS
$cshowsPrec :: Int -> CSSSetStyleSheetText -> ShowS
Show)
instance FromJSON CSSSetStyleSheetText where
  parseJSON :: Value -> Parser CSSSetStyleSheetText
parseJSON = String
-> (Object -> Parser CSSSetStyleSheetText)
-> Value
-> Parser CSSSetStyleSheetText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetStyleSheetText" ((Object -> Parser CSSSetStyleSheetText)
 -> Value -> Parser CSSSetStyleSheetText)
-> (Object -> Parser CSSSetStyleSheetText)
-> Value
-> Parser CSSSetStyleSheetText
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text -> CSSSetStyleSheetText
CSSSetStyleSheetText
    (Maybe Text -> CSSSetStyleSheetText)
-> Parser (Maybe Text) -> Parser CSSSetStyleSheetText
forall (f :: * -> *) a b. Functor 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
"sourceMapURL"
instance Command PCSSSetStyleSheetText where
  type CommandResponse PCSSSetStyleSheetText = CSSSetStyleSheetText
  commandName :: Proxy PCSSSetStyleSheetText -> String
commandName Proxy PCSSSetStyleSheetText
_ = String
"CSS.setStyleSheetText"

-- | Applies specified style edits one after another in the given order.

-- | Parameters of the 'CSS.setStyleTexts' command.
data PCSSSetStyleTexts = PCSSSetStyleTexts
  {
    PCSSSetStyleTexts -> [CSSStyleDeclarationEdit]
pCSSSetStyleTextsEdits :: [CSSStyleDeclarationEdit]
  }
  deriving (PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool
(PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool)
-> (PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool)
-> Eq PCSSSetStyleTexts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool
$c/= :: PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool
== :: PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool
$c== :: PCSSSetStyleTexts -> PCSSSetStyleTexts -> Bool
Eq, Int -> PCSSSetStyleTexts -> ShowS
[PCSSSetStyleTexts] -> ShowS
PCSSSetStyleTexts -> String
(Int -> PCSSSetStyleTexts -> ShowS)
-> (PCSSSetStyleTexts -> String)
-> ([PCSSSetStyleTexts] -> ShowS)
-> Show PCSSSetStyleTexts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetStyleTexts] -> ShowS
$cshowList :: [PCSSSetStyleTexts] -> ShowS
show :: PCSSSetStyleTexts -> String
$cshow :: PCSSSetStyleTexts -> String
showsPrec :: Int -> PCSSSetStyleTexts -> ShowS
$cshowsPrec :: Int -> PCSSSetStyleTexts -> ShowS
Show)
pCSSSetStyleTexts
  :: [CSSStyleDeclarationEdit]
  -> PCSSSetStyleTexts
pCSSSetStyleTexts :: [CSSStyleDeclarationEdit] -> PCSSSetStyleTexts
pCSSSetStyleTexts
  [CSSStyleDeclarationEdit]
arg_pCSSSetStyleTextsEdits
  = [CSSStyleDeclarationEdit] -> PCSSSetStyleTexts
PCSSSetStyleTexts
    [CSSStyleDeclarationEdit]
arg_pCSSSetStyleTextsEdits
instance ToJSON PCSSSetStyleTexts where
  toJSON :: PCSSSetStyleTexts -> Value
toJSON PCSSSetStyleTexts
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
"edits" Text -> [CSSStyleDeclarationEdit] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([CSSStyleDeclarationEdit] -> Pair)
-> Maybe [CSSStyleDeclarationEdit] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CSSStyleDeclarationEdit] -> Maybe [CSSStyleDeclarationEdit]
forall a. a -> Maybe a
Just (PCSSSetStyleTexts -> [CSSStyleDeclarationEdit]
pCSSSetStyleTextsEdits PCSSSetStyleTexts
p)
    ]
data CSSSetStyleTexts = CSSSetStyleTexts
  {
    -- | The resulting styles after modification.
    CSSSetStyleTexts -> [CSSCSSStyle]
cSSSetStyleTextsStyles :: [CSSCSSStyle]
  }
  deriving (CSSSetStyleTexts -> CSSSetStyleTexts -> Bool
(CSSSetStyleTexts -> CSSSetStyleTexts -> Bool)
-> (CSSSetStyleTexts -> CSSSetStyleTexts -> Bool)
-> Eq CSSSetStyleTexts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSSetStyleTexts -> CSSSetStyleTexts -> Bool
$c/= :: CSSSetStyleTexts -> CSSSetStyleTexts -> Bool
== :: CSSSetStyleTexts -> CSSSetStyleTexts -> Bool
$c== :: CSSSetStyleTexts -> CSSSetStyleTexts -> Bool
Eq, Int -> CSSSetStyleTexts -> ShowS
[CSSSetStyleTexts] -> ShowS
CSSSetStyleTexts -> String
(Int -> CSSSetStyleTexts -> ShowS)
-> (CSSSetStyleTexts -> String)
-> ([CSSSetStyleTexts] -> ShowS)
-> Show CSSSetStyleTexts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSSetStyleTexts] -> ShowS
$cshowList :: [CSSSetStyleTexts] -> ShowS
show :: CSSSetStyleTexts -> String
$cshow :: CSSSetStyleTexts -> String
showsPrec :: Int -> CSSSetStyleTexts -> ShowS
$cshowsPrec :: Int -> CSSSetStyleTexts -> ShowS
Show)
instance FromJSON CSSSetStyleTexts where
  parseJSON :: Value -> Parser CSSSetStyleTexts
parseJSON = String
-> (Object -> Parser CSSSetStyleTexts)
-> Value
-> Parser CSSSetStyleTexts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSSetStyleTexts" ((Object -> Parser CSSSetStyleTexts)
 -> Value -> Parser CSSSetStyleTexts)
-> (Object -> Parser CSSSetStyleTexts)
-> Value
-> Parser CSSSetStyleTexts
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSCSSStyle] -> CSSSetStyleTexts
CSSSetStyleTexts
    ([CSSCSSStyle] -> CSSSetStyleTexts)
-> Parser [CSSCSSStyle] -> Parser CSSSetStyleTexts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSCSSStyle]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"styles"
instance Command PCSSSetStyleTexts where
  type CommandResponse PCSSSetStyleTexts = CSSSetStyleTexts
  commandName :: Proxy PCSSSetStyleTexts -> String
commandName Proxy PCSSSetStyleTexts
_ = String
"CSS.setStyleTexts"

-- | Enables the selector recording.

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

-- | Stop tracking rule usage and return the list of rules that were used since last call to
--   `takeCoverageDelta` (or since start of coverage instrumentation)

-- | Parameters of the 'CSS.stopRuleUsageTracking' command.
data PCSSStopRuleUsageTracking = PCSSStopRuleUsageTracking
  deriving (PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool
(PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool)
-> (PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool)
-> Eq PCSSStopRuleUsageTracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool
$c/= :: PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool
== :: PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool
$c== :: PCSSStopRuleUsageTracking -> PCSSStopRuleUsageTracking -> Bool
Eq, Int -> PCSSStopRuleUsageTracking -> ShowS
[PCSSStopRuleUsageTracking] -> ShowS
PCSSStopRuleUsageTracking -> String
(Int -> PCSSStopRuleUsageTracking -> ShowS)
-> (PCSSStopRuleUsageTracking -> String)
-> ([PCSSStopRuleUsageTracking] -> ShowS)
-> Show PCSSStopRuleUsageTracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSStopRuleUsageTracking] -> ShowS
$cshowList :: [PCSSStopRuleUsageTracking] -> ShowS
show :: PCSSStopRuleUsageTracking -> String
$cshow :: PCSSStopRuleUsageTracking -> String
showsPrec :: Int -> PCSSStopRuleUsageTracking -> ShowS
$cshowsPrec :: Int -> PCSSStopRuleUsageTracking -> ShowS
Show)
pCSSStopRuleUsageTracking
  :: PCSSStopRuleUsageTracking
pCSSStopRuleUsageTracking :: PCSSStopRuleUsageTracking
pCSSStopRuleUsageTracking
  = PCSSStopRuleUsageTracking
PCSSStopRuleUsageTracking
instance ToJSON PCSSStopRuleUsageTracking where
  toJSON :: PCSSStopRuleUsageTracking -> Value
toJSON PCSSStopRuleUsageTracking
_ = Value
A.Null
data CSSStopRuleUsageTracking = CSSStopRuleUsageTracking
  {
    CSSStopRuleUsageTracking -> [CSSRuleUsage]
cSSStopRuleUsageTrackingRuleUsage :: [CSSRuleUsage]
  }
  deriving (CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool
(CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool)
-> (CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool)
-> Eq CSSStopRuleUsageTracking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool
$c/= :: CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool
== :: CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool
$c== :: CSSStopRuleUsageTracking -> CSSStopRuleUsageTracking -> Bool
Eq, Int -> CSSStopRuleUsageTracking -> ShowS
[CSSStopRuleUsageTracking] -> ShowS
CSSStopRuleUsageTracking -> String
(Int -> CSSStopRuleUsageTracking -> ShowS)
-> (CSSStopRuleUsageTracking -> String)
-> ([CSSStopRuleUsageTracking] -> ShowS)
-> Show CSSStopRuleUsageTracking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSStopRuleUsageTracking] -> ShowS
$cshowList :: [CSSStopRuleUsageTracking] -> ShowS
show :: CSSStopRuleUsageTracking -> String
$cshow :: CSSStopRuleUsageTracking -> String
showsPrec :: Int -> CSSStopRuleUsageTracking -> ShowS
$cshowsPrec :: Int -> CSSStopRuleUsageTracking -> ShowS
Show)
instance FromJSON CSSStopRuleUsageTracking where
  parseJSON :: Value -> Parser CSSStopRuleUsageTracking
parseJSON = String
-> (Object -> Parser CSSStopRuleUsageTracking)
-> Value
-> Parser CSSStopRuleUsageTracking
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSStopRuleUsageTracking" ((Object -> Parser CSSStopRuleUsageTracking)
 -> Value -> Parser CSSStopRuleUsageTracking)
-> (Object -> Parser CSSStopRuleUsageTracking)
-> Value
-> Parser CSSStopRuleUsageTracking
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSRuleUsage] -> CSSStopRuleUsageTracking
CSSStopRuleUsageTracking
    ([CSSRuleUsage] -> CSSStopRuleUsageTracking)
-> Parser [CSSRuleUsage] -> Parser CSSStopRuleUsageTracking
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSRuleUsage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"ruleUsage"
instance Command PCSSStopRuleUsageTracking where
  type CommandResponse PCSSStopRuleUsageTracking = CSSStopRuleUsageTracking
  commandName :: Proxy PCSSStopRuleUsageTracking -> String
commandName Proxy PCSSStopRuleUsageTracking
_ = String
"CSS.stopRuleUsageTracking"

-- | Obtain list of rules that became used since last call to this method (or since start of coverage
--   instrumentation)

-- | Parameters of the 'CSS.takeCoverageDelta' command.
data PCSSTakeCoverageDelta = PCSSTakeCoverageDelta
  deriving (PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool
(PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool)
-> (PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool)
-> Eq PCSSTakeCoverageDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool
$c/= :: PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool
== :: PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool
$c== :: PCSSTakeCoverageDelta -> PCSSTakeCoverageDelta -> Bool
Eq, Int -> PCSSTakeCoverageDelta -> ShowS
[PCSSTakeCoverageDelta] -> ShowS
PCSSTakeCoverageDelta -> String
(Int -> PCSSTakeCoverageDelta -> ShowS)
-> (PCSSTakeCoverageDelta -> String)
-> ([PCSSTakeCoverageDelta] -> ShowS)
-> Show PCSSTakeCoverageDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSTakeCoverageDelta] -> ShowS
$cshowList :: [PCSSTakeCoverageDelta] -> ShowS
show :: PCSSTakeCoverageDelta -> String
$cshow :: PCSSTakeCoverageDelta -> String
showsPrec :: Int -> PCSSTakeCoverageDelta -> ShowS
$cshowsPrec :: Int -> PCSSTakeCoverageDelta -> ShowS
Show)
pCSSTakeCoverageDelta
  :: PCSSTakeCoverageDelta
pCSSTakeCoverageDelta :: PCSSTakeCoverageDelta
pCSSTakeCoverageDelta
  = PCSSTakeCoverageDelta
PCSSTakeCoverageDelta
instance ToJSON PCSSTakeCoverageDelta where
  toJSON :: PCSSTakeCoverageDelta -> Value
toJSON PCSSTakeCoverageDelta
_ = Value
A.Null
data CSSTakeCoverageDelta = CSSTakeCoverageDelta
  {
    CSSTakeCoverageDelta -> [CSSRuleUsage]
cSSTakeCoverageDeltaCoverage :: [CSSRuleUsage],
    -- | Monotonically increasing time, in seconds.
    CSSTakeCoverageDelta -> Double
cSSTakeCoverageDeltaTimestamp :: Double
  }
  deriving (CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool
(CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool)
-> (CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool)
-> Eq CSSTakeCoverageDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool
$c/= :: CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool
== :: CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool
$c== :: CSSTakeCoverageDelta -> CSSTakeCoverageDelta -> Bool
Eq, Int -> CSSTakeCoverageDelta -> ShowS
[CSSTakeCoverageDelta] -> ShowS
CSSTakeCoverageDelta -> String
(Int -> CSSTakeCoverageDelta -> ShowS)
-> (CSSTakeCoverageDelta -> String)
-> ([CSSTakeCoverageDelta] -> ShowS)
-> Show CSSTakeCoverageDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CSSTakeCoverageDelta] -> ShowS
$cshowList :: [CSSTakeCoverageDelta] -> ShowS
show :: CSSTakeCoverageDelta -> String
$cshow :: CSSTakeCoverageDelta -> String
showsPrec :: Int -> CSSTakeCoverageDelta -> ShowS
$cshowsPrec :: Int -> CSSTakeCoverageDelta -> ShowS
Show)
instance FromJSON CSSTakeCoverageDelta where
  parseJSON :: Value -> Parser CSSTakeCoverageDelta
parseJSON = String
-> (Object -> Parser CSSTakeCoverageDelta)
-> Value
-> Parser CSSTakeCoverageDelta
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CSSTakeCoverageDelta" ((Object -> Parser CSSTakeCoverageDelta)
 -> Value -> Parser CSSTakeCoverageDelta)
-> (Object -> Parser CSSTakeCoverageDelta)
-> Value
-> Parser CSSTakeCoverageDelta
forall a b. (a -> b) -> a -> b
$ \Object
o -> [CSSRuleUsage] -> Double -> CSSTakeCoverageDelta
CSSTakeCoverageDelta
    ([CSSRuleUsage] -> Double -> CSSTakeCoverageDelta)
-> Parser [CSSRuleUsage] -> Parser (Double -> CSSTakeCoverageDelta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [CSSRuleUsage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"coverage"
    Parser (Double -> CSSTakeCoverageDelta)
-> Parser Double -> Parser CSSTakeCoverageDelta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"timestamp"
instance Command PCSSTakeCoverageDelta where
  type CommandResponse PCSSTakeCoverageDelta = CSSTakeCoverageDelta
  commandName :: Proxy PCSSTakeCoverageDelta -> String
commandName Proxy PCSSTakeCoverageDelta
_ = String
"CSS.takeCoverageDelta"

-- | Enables/disables rendering of local CSS fonts (enabled by default).

-- | Parameters of the 'CSS.setLocalFontsEnabled' command.
data PCSSSetLocalFontsEnabled = PCSSSetLocalFontsEnabled
  {
    -- | Whether rendering of local fonts is enabled.
    PCSSSetLocalFontsEnabled -> Bool
pCSSSetLocalFontsEnabledEnabled :: Bool
  }
  deriving (PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool
(PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool)
-> (PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool)
-> Eq PCSSSetLocalFontsEnabled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool
$c/= :: PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool
== :: PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool
$c== :: PCSSSetLocalFontsEnabled -> PCSSSetLocalFontsEnabled -> Bool
Eq, Int -> PCSSSetLocalFontsEnabled -> ShowS
[PCSSSetLocalFontsEnabled] -> ShowS
PCSSSetLocalFontsEnabled -> String
(Int -> PCSSSetLocalFontsEnabled -> ShowS)
-> (PCSSSetLocalFontsEnabled -> String)
-> ([PCSSSetLocalFontsEnabled] -> ShowS)
-> Show PCSSSetLocalFontsEnabled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCSSSetLocalFontsEnabled] -> ShowS
$cshowList :: [PCSSSetLocalFontsEnabled] -> ShowS
show :: PCSSSetLocalFontsEnabled -> String
$cshow :: PCSSSetLocalFontsEnabled -> String
showsPrec :: Int -> PCSSSetLocalFontsEnabled -> ShowS
$cshowsPrec :: Int -> PCSSSetLocalFontsEnabled -> ShowS
Show)
pCSSSetLocalFontsEnabled
  {-
  -- | Whether rendering of local fonts is enabled.
  -}
  :: Bool
  -> PCSSSetLocalFontsEnabled
pCSSSetLocalFontsEnabled :: Bool -> PCSSSetLocalFontsEnabled
pCSSSetLocalFontsEnabled
  Bool
arg_pCSSSetLocalFontsEnabledEnabled
  = Bool -> PCSSSetLocalFontsEnabled
PCSSSetLocalFontsEnabled
    Bool
arg_pCSSSetLocalFontsEnabledEnabled
instance ToJSON PCSSSetLocalFontsEnabled where
  toJSON :: PCSSSetLocalFontsEnabled -> Value
toJSON PCSSSetLocalFontsEnabled
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
"enabled" 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
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PCSSSetLocalFontsEnabled -> Bool
pCSSSetLocalFontsEnabledEnabled PCSSSetLocalFontsEnabled
p)
    ]
instance Command PCSSSetLocalFontsEnabled where
  type CommandResponse PCSSSetLocalFontsEnabled = ()
  commandName :: Proxy PCSSSetLocalFontsEnabled -> String
commandName Proxy PCSSSetLocalFontsEnabled
_ = String
"CSS.setLocalFontsEnabled"
  fromJSON :: Proxy PCSSSetLocalFontsEnabled
-> Value -> Result (CommandResponse PCSSSetLocalFontsEnabled)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PCSSSetLocalFontsEnabled -> Result ())
-> Proxy PCSSSetLocalFontsEnabled
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PCSSSetLocalFontsEnabled -> ())
-> Proxy PCSSSetLocalFontsEnabled
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PCSSSetLocalFontsEnabled -> ()
forall a b. a -> b -> a
const ()