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


{- |
= LayerTree

-}


module CDP.Domains.LayerTree (module CDP.Domains.LayerTree) 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 'LayerTree.LayerId'.
--   Unique Layer identifier.
type LayerTreeLayerId = T.Text

-- | Type 'LayerTree.SnapshotId'.
--   Unique snapshot identifier.
type LayerTreeSnapshotId = T.Text

-- | Type 'LayerTree.ScrollRect'.
--   Rectangle where scrolling happens on the main thread.
data LayerTreeScrollRectType = LayerTreeScrollRectTypeRepaintsOnScroll | LayerTreeScrollRectTypeTouchEventHandler | LayerTreeScrollRectTypeWheelEventHandler
  deriving (Eq LayerTreeScrollRectType
Eq LayerTreeScrollRectType
-> (LayerTreeScrollRectType -> LayerTreeScrollRectType -> Ordering)
-> (LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool)
-> (LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool)
-> (LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool)
-> (LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool)
-> (LayerTreeScrollRectType
    -> LayerTreeScrollRectType -> LayerTreeScrollRectType)
-> (LayerTreeScrollRectType
    -> LayerTreeScrollRectType -> LayerTreeScrollRectType)
-> Ord LayerTreeScrollRectType
LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
LayerTreeScrollRectType -> LayerTreeScrollRectType -> Ordering
LayerTreeScrollRectType
-> LayerTreeScrollRectType -> LayerTreeScrollRectType
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 :: LayerTreeScrollRectType
-> LayerTreeScrollRectType -> LayerTreeScrollRectType
$cmin :: LayerTreeScrollRectType
-> LayerTreeScrollRectType -> LayerTreeScrollRectType
max :: LayerTreeScrollRectType
-> LayerTreeScrollRectType -> LayerTreeScrollRectType
$cmax :: LayerTreeScrollRectType
-> LayerTreeScrollRectType -> LayerTreeScrollRectType
>= :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
$c>= :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
> :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
$c> :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
<= :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
$c<= :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
< :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
$c< :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
compare :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Ordering
$ccompare :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Ordering
$cp1Ord :: Eq LayerTreeScrollRectType
Ord, LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
(LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool)
-> (LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool)
-> Eq LayerTreeScrollRectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
$c/= :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
== :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
$c== :: LayerTreeScrollRectType -> LayerTreeScrollRectType -> Bool
Eq, Int -> LayerTreeScrollRectType -> ShowS
[LayerTreeScrollRectType] -> ShowS
LayerTreeScrollRectType -> String
(Int -> LayerTreeScrollRectType -> ShowS)
-> (LayerTreeScrollRectType -> String)
-> ([LayerTreeScrollRectType] -> ShowS)
-> Show LayerTreeScrollRectType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeScrollRectType] -> ShowS
$cshowList :: [LayerTreeScrollRectType] -> ShowS
show :: LayerTreeScrollRectType -> String
$cshow :: LayerTreeScrollRectType -> String
showsPrec :: Int -> LayerTreeScrollRectType -> ShowS
$cshowsPrec :: Int -> LayerTreeScrollRectType -> ShowS
Show, ReadPrec [LayerTreeScrollRectType]
ReadPrec LayerTreeScrollRectType
Int -> ReadS LayerTreeScrollRectType
ReadS [LayerTreeScrollRectType]
(Int -> ReadS LayerTreeScrollRectType)
-> ReadS [LayerTreeScrollRectType]
-> ReadPrec LayerTreeScrollRectType
-> ReadPrec [LayerTreeScrollRectType]
-> Read LayerTreeScrollRectType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerTreeScrollRectType]
$creadListPrec :: ReadPrec [LayerTreeScrollRectType]
readPrec :: ReadPrec LayerTreeScrollRectType
$creadPrec :: ReadPrec LayerTreeScrollRectType
readList :: ReadS [LayerTreeScrollRectType]
$creadList :: ReadS [LayerTreeScrollRectType]
readsPrec :: Int -> ReadS LayerTreeScrollRectType
$creadsPrec :: Int -> ReadS LayerTreeScrollRectType
Read)
instance FromJSON LayerTreeScrollRectType where
  parseJSON :: Value -> Parser LayerTreeScrollRectType
parseJSON = String
-> (Text -> Parser LayerTreeScrollRectType)
-> Value
-> Parser LayerTreeScrollRectType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"LayerTreeScrollRectType" ((Text -> Parser LayerTreeScrollRectType)
 -> Value -> Parser LayerTreeScrollRectType)
-> (Text -> Parser LayerTreeScrollRectType)
-> Value
-> Parser LayerTreeScrollRectType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"RepaintsOnScroll" -> LayerTreeScrollRectType -> Parser LayerTreeScrollRectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure LayerTreeScrollRectType
LayerTreeScrollRectTypeRepaintsOnScroll
    Text
"TouchEventHandler" -> LayerTreeScrollRectType -> Parser LayerTreeScrollRectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure LayerTreeScrollRectType
LayerTreeScrollRectTypeTouchEventHandler
    Text
"WheelEventHandler" -> LayerTreeScrollRectType -> Parser LayerTreeScrollRectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure LayerTreeScrollRectType
LayerTreeScrollRectTypeWheelEventHandler
    Text
"_" -> String -> Parser LayerTreeScrollRectType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse LayerTreeScrollRectType"
instance ToJSON LayerTreeScrollRectType where
  toJSON :: LayerTreeScrollRectType -> Value
toJSON LayerTreeScrollRectType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case LayerTreeScrollRectType
v of
    LayerTreeScrollRectType
LayerTreeScrollRectTypeRepaintsOnScroll -> Text
"RepaintsOnScroll"
    LayerTreeScrollRectType
LayerTreeScrollRectTypeTouchEventHandler -> Text
"TouchEventHandler"
    LayerTreeScrollRectType
LayerTreeScrollRectTypeWheelEventHandler -> Text
"WheelEventHandler"
data LayerTreeScrollRect = LayerTreeScrollRect
  {
    -- | Rectangle itself.
    LayerTreeScrollRect -> DOMRect
layerTreeScrollRectRect :: DOMPageNetworkEmulationSecurity.DOMRect,
    -- | Reason for rectangle to force scrolling on the main thread
    LayerTreeScrollRect -> LayerTreeScrollRectType
layerTreeScrollRectType :: LayerTreeScrollRectType
  }
  deriving (LayerTreeScrollRect -> LayerTreeScrollRect -> Bool
(LayerTreeScrollRect -> LayerTreeScrollRect -> Bool)
-> (LayerTreeScrollRect -> LayerTreeScrollRect -> Bool)
-> Eq LayerTreeScrollRect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeScrollRect -> LayerTreeScrollRect -> Bool
$c/= :: LayerTreeScrollRect -> LayerTreeScrollRect -> Bool
== :: LayerTreeScrollRect -> LayerTreeScrollRect -> Bool
$c== :: LayerTreeScrollRect -> LayerTreeScrollRect -> Bool
Eq, Int -> LayerTreeScrollRect -> ShowS
[LayerTreeScrollRect] -> ShowS
LayerTreeScrollRect -> String
(Int -> LayerTreeScrollRect -> ShowS)
-> (LayerTreeScrollRect -> String)
-> ([LayerTreeScrollRect] -> ShowS)
-> Show LayerTreeScrollRect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeScrollRect] -> ShowS
$cshowList :: [LayerTreeScrollRect] -> ShowS
show :: LayerTreeScrollRect -> String
$cshow :: LayerTreeScrollRect -> String
showsPrec :: Int -> LayerTreeScrollRect -> ShowS
$cshowsPrec :: Int -> LayerTreeScrollRect -> ShowS
Show)
instance FromJSON LayerTreeScrollRect where
  parseJSON :: Value -> Parser LayerTreeScrollRect
parseJSON = String
-> (Object -> Parser LayerTreeScrollRect)
-> Value
-> Parser LayerTreeScrollRect
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeScrollRect" ((Object -> Parser LayerTreeScrollRect)
 -> Value -> Parser LayerTreeScrollRect)
-> (Object -> Parser LayerTreeScrollRect)
-> Value
-> Parser LayerTreeScrollRect
forall a b. (a -> b) -> a -> b
$ \Object
o -> DOMRect -> LayerTreeScrollRectType -> LayerTreeScrollRect
LayerTreeScrollRect
    (DOMRect -> LayerTreeScrollRectType -> LayerTreeScrollRect)
-> Parser DOMRect
-> Parser (LayerTreeScrollRectType -> LayerTreeScrollRect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser DOMRect
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"rect"
    Parser (LayerTreeScrollRectType -> LayerTreeScrollRect)
-> Parser LayerTreeScrollRectType -> Parser LayerTreeScrollRect
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser LayerTreeScrollRectType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
instance ToJSON LayerTreeScrollRect where
  toJSON :: LayerTreeScrollRect -> Value
toJSON LayerTreeScrollRect
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
"rect" Text -> DOMRect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMRect -> Pair) -> Maybe DOMRect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMRect -> Maybe DOMRect
forall a. a -> Maybe a
Just (LayerTreeScrollRect -> DOMRect
layerTreeScrollRectRect LayerTreeScrollRect
p),
    (Text
"type" Text -> LayerTreeScrollRectType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (LayerTreeScrollRectType -> Pair)
-> Maybe LayerTreeScrollRectType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LayerTreeScrollRectType -> Maybe LayerTreeScrollRectType
forall a. a -> Maybe a
Just (LayerTreeScrollRect -> LayerTreeScrollRectType
layerTreeScrollRectType LayerTreeScrollRect
p)
    ]

-- | Type 'LayerTree.StickyPositionConstraint'.
--   Sticky position constraints.
data LayerTreeStickyPositionConstraint = LayerTreeStickyPositionConstraint
  {
    -- | Layout rectangle of the sticky element before being shifted
    LayerTreeStickyPositionConstraint -> DOMRect
layerTreeStickyPositionConstraintStickyBoxRect :: DOMPageNetworkEmulationSecurity.DOMRect,
    -- | Layout rectangle of the containing block of the sticky element
    LayerTreeStickyPositionConstraint -> DOMRect
layerTreeStickyPositionConstraintContainingBlockRect :: DOMPageNetworkEmulationSecurity.DOMRect,
    -- | The nearest sticky layer that shifts the sticky box
    LayerTreeStickyPositionConstraint -> Maybe Text
layerTreeStickyPositionConstraintNearestLayerShiftingStickyBox :: Maybe LayerTreeLayerId,
    -- | The nearest sticky layer that shifts the containing block
    LayerTreeStickyPositionConstraint -> Maybe Text
layerTreeStickyPositionConstraintNearestLayerShiftingContainingBlock :: Maybe LayerTreeLayerId
  }
  deriving (LayerTreeStickyPositionConstraint
-> LayerTreeStickyPositionConstraint -> Bool
(LayerTreeStickyPositionConstraint
 -> LayerTreeStickyPositionConstraint -> Bool)
-> (LayerTreeStickyPositionConstraint
    -> LayerTreeStickyPositionConstraint -> Bool)
-> Eq LayerTreeStickyPositionConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeStickyPositionConstraint
-> LayerTreeStickyPositionConstraint -> Bool
$c/= :: LayerTreeStickyPositionConstraint
-> LayerTreeStickyPositionConstraint -> Bool
== :: LayerTreeStickyPositionConstraint
-> LayerTreeStickyPositionConstraint -> Bool
$c== :: LayerTreeStickyPositionConstraint
-> LayerTreeStickyPositionConstraint -> Bool
Eq, Int -> LayerTreeStickyPositionConstraint -> ShowS
[LayerTreeStickyPositionConstraint] -> ShowS
LayerTreeStickyPositionConstraint -> String
(Int -> LayerTreeStickyPositionConstraint -> ShowS)
-> (LayerTreeStickyPositionConstraint -> String)
-> ([LayerTreeStickyPositionConstraint] -> ShowS)
-> Show LayerTreeStickyPositionConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeStickyPositionConstraint] -> ShowS
$cshowList :: [LayerTreeStickyPositionConstraint] -> ShowS
show :: LayerTreeStickyPositionConstraint -> String
$cshow :: LayerTreeStickyPositionConstraint -> String
showsPrec :: Int -> LayerTreeStickyPositionConstraint -> ShowS
$cshowsPrec :: Int -> LayerTreeStickyPositionConstraint -> ShowS
Show)
instance FromJSON LayerTreeStickyPositionConstraint where
  parseJSON :: Value -> Parser LayerTreeStickyPositionConstraint
parseJSON = String
-> (Object -> Parser LayerTreeStickyPositionConstraint)
-> Value
-> Parser LayerTreeStickyPositionConstraint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeStickyPositionConstraint" ((Object -> Parser LayerTreeStickyPositionConstraint)
 -> Value -> Parser LayerTreeStickyPositionConstraint)
-> (Object -> Parser LayerTreeStickyPositionConstraint)
-> Value
-> Parser LayerTreeStickyPositionConstraint
forall a b. (a -> b) -> a -> b
$ \Object
o -> DOMRect
-> DOMRect
-> Maybe Text
-> Maybe Text
-> LayerTreeStickyPositionConstraint
LayerTreeStickyPositionConstraint
    (DOMRect
 -> DOMRect
 -> Maybe Text
 -> Maybe Text
 -> LayerTreeStickyPositionConstraint)
-> Parser DOMRect
-> Parser
     (DOMRect
      -> Maybe Text -> Maybe Text -> LayerTreeStickyPositionConstraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser DOMRect
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"stickyBoxRect"
    Parser
  (DOMRect
   -> Maybe Text -> Maybe Text -> LayerTreeStickyPositionConstraint)
-> Parser DOMRect
-> Parser
     (Maybe Text -> Maybe Text -> LayerTreeStickyPositionConstraint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMRect
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"containingBlockRect"
    Parser
  (Maybe Text -> Maybe Text -> LayerTreeStickyPositionConstraint)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> LayerTreeStickyPositionConstraint)
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
"nearestLayerShiftingStickyBox"
    Parser (Maybe Text -> LayerTreeStickyPositionConstraint)
-> Parser (Maybe Text) -> Parser LayerTreeStickyPositionConstraint
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
"nearestLayerShiftingContainingBlock"
instance ToJSON LayerTreeStickyPositionConstraint where
  toJSON :: LayerTreeStickyPositionConstraint -> Value
toJSON LayerTreeStickyPositionConstraint
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
"stickyBoxRect" Text -> DOMRect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMRect -> Pair) -> Maybe DOMRect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMRect -> Maybe DOMRect
forall a. a -> Maybe a
Just (LayerTreeStickyPositionConstraint -> DOMRect
layerTreeStickyPositionConstraintStickyBoxRect LayerTreeStickyPositionConstraint
p),
    (Text
"containingBlockRect" Text -> DOMRect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMRect -> Pair) -> Maybe DOMRect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMRect -> Maybe DOMRect
forall a. a -> Maybe a
Just (LayerTreeStickyPositionConstraint -> DOMRect
layerTreeStickyPositionConstraintContainingBlockRect LayerTreeStickyPositionConstraint
p),
    (Text
"nearestLayerShiftingStickyBox" 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
<$> (LayerTreeStickyPositionConstraint -> Maybe Text
layerTreeStickyPositionConstraintNearestLayerShiftingStickyBox LayerTreeStickyPositionConstraint
p),
    (Text
"nearestLayerShiftingContainingBlock" 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
<$> (LayerTreeStickyPositionConstraint -> Maybe Text
layerTreeStickyPositionConstraintNearestLayerShiftingContainingBlock LayerTreeStickyPositionConstraint
p)
    ]

-- | Type 'LayerTree.PictureTile'.
--   Serialized fragment of layer picture along with its offset within the layer.
data LayerTreePictureTile = LayerTreePictureTile
  {
    -- | Offset from owning layer left boundary
    LayerTreePictureTile -> Double
layerTreePictureTileX :: Double,
    -- | Offset from owning layer top boundary
    LayerTreePictureTile -> Double
layerTreePictureTileY :: Double,
    -- | Base64-encoded snapshot data. (Encoded as a base64 string when passed over JSON)
    LayerTreePictureTile -> Text
layerTreePictureTilePicture :: T.Text
  }
  deriving (LayerTreePictureTile -> LayerTreePictureTile -> Bool
(LayerTreePictureTile -> LayerTreePictureTile -> Bool)
-> (LayerTreePictureTile -> LayerTreePictureTile -> Bool)
-> Eq LayerTreePictureTile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreePictureTile -> LayerTreePictureTile -> Bool
$c/= :: LayerTreePictureTile -> LayerTreePictureTile -> Bool
== :: LayerTreePictureTile -> LayerTreePictureTile -> Bool
$c== :: LayerTreePictureTile -> LayerTreePictureTile -> Bool
Eq, Int -> LayerTreePictureTile -> ShowS
[LayerTreePictureTile] -> ShowS
LayerTreePictureTile -> String
(Int -> LayerTreePictureTile -> ShowS)
-> (LayerTreePictureTile -> String)
-> ([LayerTreePictureTile] -> ShowS)
-> Show LayerTreePictureTile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreePictureTile] -> ShowS
$cshowList :: [LayerTreePictureTile] -> ShowS
show :: LayerTreePictureTile -> String
$cshow :: LayerTreePictureTile -> String
showsPrec :: Int -> LayerTreePictureTile -> ShowS
$cshowsPrec :: Int -> LayerTreePictureTile -> ShowS
Show)
instance FromJSON LayerTreePictureTile where
  parseJSON :: Value -> Parser LayerTreePictureTile
parseJSON = String
-> (Object -> Parser LayerTreePictureTile)
-> Value
-> Parser LayerTreePictureTile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreePictureTile" ((Object -> Parser LayerTreePictureTile)
 -> Value -> Parser LayerTreePictureTile)
-> (Object -> Parser LayerTreePictureTile)
-> Value
-> Parser LayerTreePictureTile
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> Double -> Text -> LayerTreePictureTile
LayerTreePictureTile
    (Double -> Double -> Text -> LayerTreePictureTile)
-> Parser Double -> Parser (Double -> Text -> LayerTreePictureTile)
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
"x"
    Parser (Double -> Text -> LayerTreePictureTile)
-> Parser Double -> Parser (Text -> LayerTreePictureTile)
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
"y"
    Parser (Text -> LayerTreePictureTile)
-> Parser Text -> Parser LayerTreePictureTile
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
"picture"
instance ToJSON LayerTreePictureTile where
  toJSON :: LayerTreePictureTile -> Value
toJSON LayerTreePictureTile
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
"x" 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 (LayerTreePictureTile -> Double
layerTreePictureTileX LayerTreePictureTile
p),
    (Text
"y" 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 (LayerTreePictureTile -> Double
layerTreePictureTileY LayerTreePictureTile
p),
    (Text
"picture" 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 (LayerTreePictureTile -> Text
layerTreePictureTilePicture LayerTreePictureTile
p)
    ]

-- | Type 'LayerTree.Layer'.
--   Information about a compositing layer.
data LayerTreeLayer = LayerTreeLayer
  {
    -- | The unique id for this layer.
    LayerTreeLayer -> Text
layerTreeLayerLayerId :: LayerTreeLayerId,
    -- | The id of parent (not present for root).
    LayerTreeLayer -> Maybe Text
layerTreeLayerParentLayerId :: Maybe LayerTreeLayerId,
    -- | The backend id for the node associated with this layer.
    LayerTreeLayer -> Maybe Int
layerTreeLayerBackendNodeId :: Maybe DOMPageNetworkEmulationSecurity.DOMBackendNodeId,
    -- | Offset from parent layer, X coordinate.
    LayerTreeLayer -> Double
layerTreeLayerOffsetX :: Double,
    -- | Offset from parent layer, Y coordinate.
    LayerTreeLayer -> Double
layerTreeLayerOffsetY :: Double,
    -- | Layer width.
    LayerTreeLayer -> Double
layerTreeLayerWidth :: Double,
    -- | Layer height.
    LayerTreeLayer -> Double
layerTreeLayerHeight :: Double,
    -- | Transformation matrix for layer, default is identity matrix
    LayerTreeLayer -> Maybe [Double]
layerTreeLayerTransform :: Maybe [Double],
    -- | Transform anchor point X, absent if no transform specified
    LayerTreeLayer -> Maybe Double
layerTreeLayerAnchorX :: Maybe Double,
    -- | Transform anchor point Y, absent if no transform specified
    LayerTreeLayer -> Maybe Double
layerTreeLayerAnchorY :: Maybe Double,
    -- | Transform anchor point Z, absent if no transform specified
    LayerTreeLayer -> Maybe Double
layerTreeLayerAnchorZ :: Maybe Double,
    -- | Indicates how many time this layer has painted.
    LayerTreeLayer -> Int
layerTreeLayerPaintCount :: Int,
    -- | Indicates whether this layer hosts any content, rather than being used for
    --   transform/scrolling purposes only.
    LayerTreeLayer -> Bool
layerTreeLayerDrawsContent :: Bool,
    -- | Set if layer is not visible.
    LayerTreeLayer -> Maybe Bool
layerTreeLayerInvisible :: Maybe Bool,
    -- | Rectangles scrolling on main thread only.
    LayerTreeLayer -> Maybe [LayerTreeScrollRect]
layerTreeLayerScrollRects :: Maybe [LayerTreeScrollRect],
    -- | Sticky position constraint information
    LayerTreeLayer -> Maybe LayerTreeStickyPositionConstraint
layerTreeLayerStickyPositionConstraint :: Maybe LayerTreeStickyPositionConstraint
  }
  deriving (LayerTreeLayer -> LayerTreeLayer -> Bool
(LayerTreeLayer -> LayerTreeLayer -> Bool)
-> (LayerTreeLayer -> LayerTreeLayer -> Bool) -> Eq LayerTreeLayer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeLayer -> LayerTreeLayer -> Bool
$c/= :: LayerTreeLayer -> LayerTreeLayer -> Bool
== :: LayerTreeLayer -> LayerTreeLayer -> Bool
$c== :: LayerTreeLayer -> LayerTreeLayer -> Bool
Eq, Int -> LayerTreeLayer -> ShowS
[LayerTreeLayer] -> ShowS
LayerTreeLayer -> String
(Int -> LayerTreeLayer -> ShowS)
-> (LayerTreeLayer -> String)
-> ([LayerTreeLayer] -> ShowS)
-> Show LayerTreeLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeLayer] -> ShowS
$cshowList :: [LayerTreeLayer] -> ShowS
show :: LayerTreeLayer -> String
$cshow :: LayerTreeLayer -> String
showsPrec :: Int -> LayerTreeLayer -> ShowS
$cshowsPrec :: Int -> LayerTreeLayer -> ShowS
Show)
instance FromJSON LayerTreeLayer where
  parseJSON :: Value -> Parser LayerTreeLayer
parseJSON = String
-> (Object -> Parser LayerTreeLayer)
-> Value
-> Parser LayerTreeLayer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeLayer" ((Object -> Parser LayerTreeLayer)
 -> Value -> Parser LayerTreeLayer)
-> (Object -> Parser LayerTreeLayer)
-> Value
-> Parser LayerTreeLayer
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe Text
-> Maybe Int
-> Double
-> Double
-> Double
-> Double
-> Maybe [Double]
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Int
-> Bool
-> Maybe Bool
-> Maybe [LayerTreeScrollRect]
-> Maybe LayerTreeStickyPositionConstraint
-> LayerTreeLayer
LayerTreeLayer
    (Text
 -> Maybe Text
 -> Maybe Int
 -> Double
 -> Double
 -> Double
 -> Double
 -> Maybe [Double]
 -> Maybe Double
 -> Maybe Double
 -> Maybe Double
 -> Int
 -> Bool
 -> Maybe Bool
 -> Maybe [LayerTreeScrollRect]
 -> Maybe LayerTreeStickyPositionConstraint
 -> LayerTreeLayer)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Double
      -> Double
      -> Double
      -> Double
      -> Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"layerId"
    Parser
  (Maybe Text
   -> Maybe Int
   -> Double
   -> Double
   -> Double
   -> Double
   -> Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Double
      -> Double
      -> Double
      -> Double
      -> Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"parentLayerId"
    Parser
  (Maybe Int
   -> Double
   -> Double
   -> Double
   -> Double
   -> Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe Int)
-> Parser
     (Double
      -> Double
      -> Double
      -> Double
      -> Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"backendNodeId"
    Parser
  (Double
   -> Double
   -> Double
   -> Double
   -> Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Double
      -> Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"offsetX"
    Parser
  (Double
   -> Double
   -> Double
   -> Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"offsetY"
    Parser
  (Double
   -> Double
   -> Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser Double
-> Parser
     (Double
      -> Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"width"
    Parser
  (Double
   -> Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser Double
-> Parser
     (Maybe [Double]
      -> Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"height"
    Parser
  (Maybe [Double]
   -> Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe [Double])
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"transform"
    Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"anchorX"
    Parser
  (Maybe Double
   -> Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"anchorY"
    Parser
  (Maybe Double
   -> Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe Double)
-> Parser
     (Int
      -> Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"anchorZ"
    Parser
  (Int
   -> Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser Int
-> Parser
     (Bool
      -> Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"paintCount"
    Parser
  (Bool
   -> Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser Bool
-> Parser
     (Maybe Bool
      -> Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint
      -> LayerTreeLayer)
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
"drawsContent"
    Parser
  (Maybe Bool
   -> Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint
   -> LayerTreeLayer)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [LayerTreeScrollRect]
      -> Maybe LayerTreeStickyPositionConstraint -> LayerTreeLayer)
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
"invisible"
    Parser
  (Maybe [LayerTreeScrollRect]
   -> Maybe LayerTreeStickyPositionConstraint -> LayerTreeLayer)
-> Parser (Maybe [LayerTreeScrollRect])
-> Parser
     (Maybe LayerTreeStickyPositionConstraint -> LayerTreeLayer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [LayerTreeScrollRect])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scrollRects"
    Parser (Maybe LayerTreeStickyPositionConstraint -> LayerTreeLayer)
-> Parser (Maybe LayerTreeStickyPositionConstraint)
-> Parser LayerTreeLayer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe LayerTreeStickyPositionConstraint)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"stickyPositionConstraint"
instance ToJSON LayerTreeLayer where
  toJSON :: LayerTreeLayer -> Value
toJSON LayerTreeLayer
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
"layerId" 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 (LayerTreeLayer -> Text
layerTreeLayerLayerId LayerTreeLayer
p),
    (Text
"parentLayerId" 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
<$> (LayerTreeLayer -> Maybe Text
layerTreeLayerParentLayerId LayerTreeLayer
p),
    (Text
"backendNodeId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LayerTreeLayer -> Maybe Int
layerTreeLayerBackendNodeId LayerTreeLayer
p),
    (Text
"offsetX" 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 (LayerTreeLayer -> Double
layerTreeLayerOffsetX LayerTreeLayer
p),
    (Text
"offsetY" 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 (LayerTreeLayer -> Double
layerTreeLayerOffsetY LayerTreeLayer
p),
    (Text
"width" 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 (LayerTreeLayer -> Double
layerTreeLayerWidth LayerTreeLayer
p),
    (Text
"height" 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 (LayerTreeLayer -> Double
layerTreeLayerHeight LayerTreeLayer
p),
    (Text
"transform" 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
<$> (LayerTreeLayer -> Maybe [Double]
layerTreeLayerTransform LayerTreeLayer
p),
    (Text
"anchorX" 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
<$> (LayerTreeLayer -> Maybe Double
layerTreeLayerAnchorX LayerTreeLayer
p),
    (Text
"anchorY" 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
<$> (LayerTreeLayer -> Maybe Double
layerTreeLayerAnchorY LayerTreeLayer
p),
    (Text
"anchorZ" 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
<$> (LayerTreeLayer -> Maybe Double
layerTreeLayerAnchorZ LayerTreeLayer
p),
    (Text
"paintCount" 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 (LayerTreeLayer -> Int
layerTreeLayerPaintCount LayerTreeLayer
p),
    (Text
"drawsContent" 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 (LayerTreeLayer -> Bool
layerTreeLayerDrawsContent LayerTreeLayer
p),
    (Text
"invisible" 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
<$> (LayerTreeLayer -> Maybe Bool
layerTreeLayerInvisible LayerTreeLayer
p),
    (Text
"scrollRects" Text -> [LayerTreeScrollRect] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([LayerTreeScrollRect] -> Pair)
-> Maybe [LayerTreeScrollRect] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LayerTreeLayer -> Maybe [LayerTreeScrollRect]
layerTreeLayerScrollRects LayerTreeLayer
p),
    (Text
"stickyPositionConstraint" Text -> LayerTreeStickyPositionConstraint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (LayerTreeStickyPositionConstraint -> Pair)
-> Maybe LayerTreeStickyPositionConstraint -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LayerTreeLayer -> Maybe LayerTreeStickyPositionConstraint
layerTreeLayerStickyPositionConstraint LayerTreeLayer
p)
    ]

-- | Type 'LayerTree.PaintProfile'.
--   Array of timings, one per paint step.
type LayerTreePaintProfile = [Double]

-- | Type of the 'LayerTree.layerPainted' event.
data LayerTreeLayerPainted = LayerTreeLayerPainted
  {
    -- | The id of the painted layer.
    LayerTreeLayerPainted -> Text
layerTreeLayerPaintedLayerId :: LayerTreeLayerId,
    -- | Clip rectangle.
    LayerTreeLayerPainted -> DOMRect
layerTreeLayerPaintedClip :: DOMPageNetworkEmulationSecurity.DOMRect
  }
  deriving (LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool
(LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool)
-> (LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool)
-> Eq LayerTreeLayerPainted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool
$c/= :: LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool
== :: LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool
$c== :: LayerTreeLayerPainted -> LayerTreeLayerPainted -> Bool
Eq, Int -> LayerTreeLayerPainted -> ShowS
[LayerTreeLayerPainted] -> ShowS
LayerTreeLayerPainted -> String
(Int -> LayerTreeLayerPainted -> ShowS)
-> (LayerTreeLayerPainted -> String)
-> ([LayerTreeLayerPainted] -> ShowS)
-> Show LayerTreeLayerPainted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeLayerPainted] -> ShowS
$cshowList :: [LayerTreeLayerPainted] -> ShowS
show :: LayerTreeLayerPainted -> String
$cshow :: LayerTreeLayerPainted -> String
showsPrec :: Int -> LayerTreeLayerPainted -> ShowS
$cshowsPrec :: Int -> LayerTreeLayerPainted -> ShowS
Show)
instance FromJSON LayerTreeLayerPainted where
  parseJSON :: Value -> Parser LayerTreeLayerPainted
parseJSON = String
-> (Object -> Parser LayerTreeLayerPainted)
-> Value
-> Parser LayerTreeLayerPainted
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeLayerPainted" ((Object -> Parser LayerTreeLayerPainted)
 -> Value -> Parser LayerTreeLayerPainted)
-> (Object -> Parser LayerTreeLayerPainted)
-> Value
-> Parser LayerTreeLayerPainted
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> DOMRect -> LayerTreeLayerPainted
LayerTreeLayerPainted
    (Text -> DOMRect -> LayerTreeLayerPainted)
-> Parser Text -> Parser (DOMRect -> LayerTreeLayerPainted)
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
"layerId"
    Parser (DOMRect -> LayerTreeLayerPainted)
-> Parser DOMRect -> Parser LayerTreeLayerPainted
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DOMRect
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"clip"
instance Event LayerTreeLayerPainted where
  eventName :: Proxy LayerTreeLayerPainted -> String
eventName Proxy LayerTreeLayerPainted
_ = String
"LayerTree.layerPainted"

-- | Type of the 'LayerTree.layerTreeDidChange' event.
data LayerTreeLayerTreeDidChange = LayerTreeLayerTreeDidChange
  {
    -- | Layer tree, absent if not in the comspositing mode.
    LayerTreeLayerTreeDidChange -> Maybe [LayerTreeLayer]
layerTreeLayerTreeDidChangeLayers :: Maybe [LayerTreeLayer]
  }
  deriving (LayerTreeLayerTreeDidChange -> LayerTreeLayerTreeDidChange -> Bool
(LayerTreeLayerTreeDidChange
 -> LayerTreeLayerTreeDidChange -> Bool)
-> (LayerTreeLayerTreeDidChange
    -> LayerTreeLayerTreeDidChange -> Bool)
-> Eq LayerTreeLayerTreeDidChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeLayerTreeDidChange -> LayerTreeLayerTreeDidChange -> Bool
$c/= :: LayerTreeLayerTreeDidChange -> LayerTreeLayerTreeDidChange -> Bool
== :: LayerTreeLayerTreeDidChange -> LayerTreeLayerTreeDidChange -> Bool
$c== :: LayerTreeLayerTreeDidChange -> LayerTreeLayerTreeDidChange -> Bool
Eq, Int -> LayerTreeLayerTreeDidChange -> ShowS
[LayerTreeLayerTreeDidChange] -> ShowS
LayerTreeLayerTreeDidChange -> String
(Int -> LayerTreeLayerTreeDidChange -> ShowS)
-> (LayerTreeLayerTreeDidChange -> String)
-> ([LayerTreeLayerTreeDidChange] -> ShowS)
-> Show LayerTreeLayerTreeDidChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeLayerTreeDidChange] -> ShowS
$cshowList :: [LayerTreeLayerTreeDidChange] -> ShowS
show :: LayerTreeLayerTreeDidChange -> String
$cshow :: LayerTreeLayerTreeDidChange -> String
showsPrec :: Int -> LayerTreeLayerTreeDidChange -> ShowS
$cshowsPrec :: Int -> LayerTreeLayerTreeDidChange -> ShowS
Show)
instance FromJSON LayerTreeLayerTreeDidChange where
  parseJSON :: Value -> Parser LayerTreeLayerTreeDidChange
parseJSON = String
-> (Object -> Parser LayerTreeLayerTreeDidChange)
-> Value
-> Parser LayerTreeLayerTreeDidChange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeLayerTreeDidChange" ((Object -> Parser LayerTreeLayerTreeDidChange)
 -> Value -> Parser LayerTreeLayerTreeDidChange)
-> (Object -> Parser LayerTreeLayerTreeDidChange)
-> Value
-> Parser LayerTreeLayerTreeDidChange
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe [LayerTreeLayer] -> LayerTreeLayerTreeDidChange
LayerTreeLayerTreeDidChange
    (Maybe [LayerTreeLayer] -> LayerTreeLayerTreeDidChange)
-> Parser (Maybe [LayerTreeLayer])
-> Parser LayerTreeLayerTreeDidChange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe [LayerTreeLayer])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"layers"
instance Event LayerTreeLayerTreeDidChange where
  eventName :: Proxy LayerTreeLayerTreeDidChange -> String
eventName Proxy LayerTreeLayerTreeDidChange
_ = String
"LayerTree.layerTreeDidChange"

-- | Provides the reasons why the given layer was composited.

-- | Parameters of the 'LayerTree.compositingReasons' command.
data PLayerTreeCompositingReasons = PLayerTreeCompositingReasons
  {
    -- | The id of the layer for which we want to get the reasons it was composited.
    PLayerTreeCompositingReasons -> Text
pLayerTreeCompositingReasonsLayerId :: LayerTreeLayerId
  }
  deriving (PLayerTreeCompositingReasons
-> PLayerTreeCompositingReasons -> Bool
(PLayerTreeCompositingReasons
 -> PLayerTreeCompositingReasons -> Bool)
-> (PLayerTreeCompositingReasons
    -> PLayerTreeCompositingReasons -> Bool)
-> Eq PLayerTreeCompositingReasons
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeCompositingReasons
-> PLayerTreeCompositingReasons -> Bool
$c/= :: PLayerTreeCompositingReasons
-> PLayerTreeCompositingReasons -> Bool
== :: PLayerTreeCompositingReasons
-> PLayerTreeCompositingReasons -> Bool
$c== :: PLayerTreeCompositingReasons
-> PLayerTreeCompositingReasons -> Bool
Eq, Int -> PLayerTreeCompositingReasons -> ShowS
[PLayerTreeCompositingReasons] -> ShowS
PLayerTreeCompositingReasons -> String
(Int -> PLayerTreeCompositingReasons -> ShowS)
-> (PLayerTreeCompositingReasons -> String)
-> ([PLayerTreeCompositingReasons] -> ShowS)
-> Show PLayerTreeCompositingReasons
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeCompositingReasons] -> ShowS
$cshowList :: [PLayerTreeCompositingReasons] -> ShowS
show :: PLayerTreeCompositingReasons -> String
$cshow :: PLayerTreeCompositingReasons -> String
showsPrec :: Int -> PLayerTreeCompositingReasons -> ShowS
$cshowsPrec :: Int -> PLayerTreeCompositingReasons -> ShowS
Show)
pLayerTreeCompositingReasons
  {-
  -- | The id of the layer for which we want to get the reasons it was composited.
  -}
  :: LayerTreeLayerId
  -> PLayerTreeCompositingReasons
pLayerTreeCompositingReasons :: Text -> PLayerTreeCompositingReasons
pLayerTreeCompositingReasons
  Text
arg_pLayerTreeCompositingReasonsLayerId
  = Text -> PLayerTreeCompositingReasons
PLayerTreeCompositingReasons
    Text
arg_pLayerTreeCompositingReasonsLayerId
instance ToJSON PLayerTreeCompositingReasons where
  toJSON :: PLayerTreeCompositingReasons -> Value
toJSON PLayerTreeCompositingReasons
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
"layerId" 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 (PLayerTreeCompositingReasons -> Text
pLayerTreeCompositingReasonsLayerId PLayerTreeCompositingReasons
p)
    ]
data LayerTreeCompositingReasons = LayerTreeCompositingReasons
  {
    -- | A list of strings specifying reason IDs for the given layer to become composited.
    LayerTreeCompositingReasons -> [Text]
layerTreeCompositingReasonsCompositingReasonIds :: [T.Text]
  }
  deriving (LayerTreeCompositingReasons -> LayerTreeCompositingReasons -> Bool
(LayerTreeCompositingReasons
 -> LayerTreeCompositingReasons -> Bool)
-> (LayerTreeCompositingReasons
    -> LayerTreeCompositingReasons -> Bool)
-> Eq LayerTreeCompositingReasons
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeCompositingReasons -> LayerTreeCompositingReasons -> Bool
$c/= :: LayerTreeCompositingReasons -> LayerTreeCompositingReasons -> Bool
== :: LayerTreeCompositingReasons -> LayerTreeCompositingReasons -> Bool
$c== :: LayerTreeCompositingReasons -> LayerTreeCompositingReasons -> Bool
Eq, Int -> LayerTreeCompositingReasons -> ShowS
[LayerTreeCompositingReasons] -> ShowS
LayerTreeCompositingReasons -> String
(Int -> LayerTreeCompositingReasons -> ShowS)
-> (LayerTreeCompositingReasons -> String)
-> ([LayerTreeCompositingReasons] -> ShowS)
-> Show LayerTreeCompositingReasons
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeCompositingReasons] -> ShowS
$cshowList :: [LayerTreeCompositingReasons] -> ShowS
show :: LayerTreeCompositingReasons -> String
$cshow :: LayerTreeCompositingReasons -> String
showsPrec :: Int -> LayerTreeCompositingReasons -> ShowS
$cshowsPrec :: Int -> LayerTreeCompositingReasons -> ShowS
Show)
instance FromJSON LayerTreeCompositingReasons where
  parseJSON :: Value -> Parser LayerTreeCompositingReasons
parseJSON = String
-> (Object -> Parser LayerTreeCompositingReasons)
-> Value
-> Parser LayerTreeCompositingReasons
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeCompositingReasons" ((Object -> Parser LayerTreeCompositingReasons)
 -> Value -> Parser LayerTreeCompositingReasons)
-> (Object -> Parser LayerTreeCompositingReasons)
-> Value
-> Parser LayerTreeCompositingReasons
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Text] -> LayerTreeCompositingReasons
LayerTreeCompositingReasons
    ([Text] -> LayerTreeCompositingReasons)
-> Parser [Text] -> Parser LayerTreeCompositingReasons
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
"compositingReasonIds"
instance Command PLayerTreeCompositingReasons where
  type CommandResponse PLayerTreeCompositingReasons = LayerTreeCompositingReasons
  commandName :: Proxy PLayerTreeCompositingReasons -> String
commandName Proxy PLayerTreeCompositingReasons
_ = String
"LayerTree.compositingReasons"

-- | Disables compositing tree inspection.

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

-- | Enables compositing tree inspection.

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

-- | Returns the snapshot identifier.

-- | Parameters of the 'LayerTree.loadSnapshot' command.
data PLayerTreeLoadSnapshot = PLayerTreeLoadSnapshot
  {
    -- | An array of tiles composing the snapshot.
    PLayerTreeLoadSnapshot -> [LayerTreePictureTile]
pLayerTreeLoadSnapshotTiles :: [LayerTreePictureTile]
  }
  deriving (PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool
(PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool)
-> (PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool)
-> Eq PLayerTreeLoadSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool
$c/= :: PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool
== :: PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool
$c== :: PLayerTreeLoadSnapshot -> PLayerTreeLoadSnapshot -> Bool
Eq, Int -> PLayerTreeLoadSnapshot -> ShowS
[PLayerTreeLoadSnapshot] -> ShowS
PLayerTreeLoadSnapshot -> String
(Int -> PLayerTreeLoadSnapshot -> ShowS)
-> (PLayerTreeLoadSnapshot -> String)
-> ([PLayerTreeLoadSnapshot] -> ShowS)
-> Show PLayerTreeLoadSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeLoadSnapshot] -> ShowS
$cshowList :: [PLayerTreeLoadSnapshot] -> ShowS
show :: PLayerTreeLoadSnapshot -> String
$cshow :: PLayerTreeLoadSnapshot -> String
showsPrec :: Int -> PLayerTreeLoadSnapshot -> ShowS
$cshowsPrec :: Int -> PLayerTreeLoadSnapshot -> ShowS
Show)
pLayerTreeLoadSnapshot
  {-
  -- | An array of tiles composing the snapshot.
  -}
  :: [LayerTreePictureTile]
  -> PLayerTreeLoadSnapshot
pLayerTreeLoadSnapshot :: [LayerTreePictureTile] -> PLayerTreeLoadSnapshot
pLayerTreeLoadSnapshot
  [LayerTreePictureTile]
arg_pLayerTreeLoadSnapshotTiles
  = [LayerTreePictureTile] -> PLayerTreeLoadSnapshot
PLayerTreeLoadSnapshot
    [LayerTreePictureTile]
arg_pLayerTreeLoadSnapshotTiles
instance ToJSON PLayerTreeLoadSnapshot where
  toJSON :: PLayerTreeLoadSnapshot -> Value
toJSON PLayerTreeLoadSnapshot
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
"tiles" Text -> [LayerTreePictureTile] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([LayerTreePictureTile] -> Pair)
-> Maybe [LayerTreePictureTile] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LayerTreePictureTile] -> Maybe [LayerTreePictureTile]
forall a. a -> Maybe a
Just (PLayerTreeLoadSnapshot -> [LayerTreePictureTile]
pLayerTreeLoadSnapshotTiles PLayerTreeLoadSnapshot
p)
    ]
data LayerTreeLoadSnapshot = LayerTreeLoadSnapshot
  {
    -- | The id of the snapshot.
    LayerTreeLoadSnapshot -> Text
layerTreeLoadSnapshotSnapshotId :: LayerTreeSnapshotId
  }
  deriving (LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool
(LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool)
-> (LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool)
-> Eq LayerTreeLoadSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool
$c/= :: LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool
== :: LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool
$c== :: LayerTreeLoadSnapshot -> LayerTreeLoadSnapshot -> Bool
Eq, Int -> LayerTreeLoadSnapshot -> ShowS
[LayerTreeLoadSnapshot] -> ShowS
LayerTreeLoadSnapshot -> String
(Int -> LayerTreeLoadSnapshot -> ShowS)
-> (LayerTreeLoadSnapshot -> String)
-> ([LayerTreeLoadSnapshot] -> ShowS)
-> Show LayerTreeLoadSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeLoadSnapshot] -> ShowS
$cshowList :: [LayerTreeLoadSnapshot] -> ShowS
show :: LayerTreeLoadSnapshot -> String
$cshow :: LayerTreeLoadSnapshot -> String
showsPrec :: Int -> LayerTreeLoadSnapshot -> ShowS
$cshowsPrec :: Int -> LayerTreeLoadSnapshot -> ShowS
Show)
instance FromJSON LayerTreeLoadSnapshot where
  parseJSON :: Value -> Parser LayerTreeLoadSnapshot
parseJSON = String
-> (Object -> Parser LayerTreeLoadSnapshot)
-> Value
-> Parser LayerTreeLoadSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeLoadSnapshot" ((Object -> Parser LayerTreeLoadSnapshot)
 -> Value -> Parser LayerTreeLoadSnapshot)
-> (Object -> Parser LayerTreeLoadSnapshot)
-> Value
-> Parser LayerTreeLoadSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> LayerTreeLoadSnapshot
LayerTreeLoadSnapshot
    (Text -> LayerTreeLoadSnapshot)
-> Parser Text -> Parser LayerTreeLoadSnapshot
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
"snapshotId"
instance Command PLayerTreeLoadSnapshot where
  type CommandResponse PLayerTreeLoadSnapshot = LayerTreeLoadSnapshot
  commandName :: Proxy PLayerTreeLoadSnapshot -> String
commandName Proxy PLayerTreeLoadSnapshot
_ = String
"LayerTree.loadSnapshot"

-- | Returns the layer snapshot identifier.

-- | Parameters of the 'LayerTree.makeSnapshot' command.
data PLayerTreeMakeSnapshot = PLayerTreeMakeSnapshot
  {
    -- | The id of the layer.
    PLayerTreeMakeSnapshot -> Text
pLayerTreeMakeSnapshotLayerId :: LayerTreeLayerId
  }
  deriving (PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool
(PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool)
-> (PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool)
-> Eq PLayerTreeMakeSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool
$c/= :: PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool
== :: PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool
$c== :: PLayerTreeMakeSnapshot -> PLayerTreeMakeSnapshot -> Bool
Eq, Int -> PLayerTreeMakeSnapshot -> ShowS
[PLayerTreeMakeSnapshot] -> ShowS
PLayerTreeMakeSnapshot -> String
(Int -> PLayerTreeMakeSnapshot -> ShowS)
-> (PLayerTreeMakeSnapshot -> String)
-> ([PLayerTreeMakeSnapshot] -> ShowS)
-> Show PLayerTreeMakeSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeMakeSnapshot] -> ShowS
$cshowList :: [PLayerTreeMakeSnapshot] -> ShowS
show :: PLayerTreeMakeSnapshot -> String
$cshow :: PLayerTreeMakeSnapshot -> String
showsPrec :: Int -> PLayerTreeMakeSnapshot -> ShowS
$cshowsPrec :: Int -> PLayerTreeMakeSnapshot -> ShowS
Show)
pLayerTreeMakeSnapshot
  {-
  -- | The id of the layer.
  -}
  :: LayerTreeLayerId
  -> PLayerTreeMakeSnapshot
pLayerTreeMakeSnapshot :: Text -> PLayerTreeMakeSnapshot
pLayerTreeMakeSnapshot
  Text
arg_pLayerTreeMakeSnapshotLayerId
  = Text -> PLayerTreeMakeSnapshot
PLayerTreeMakeSnapshot
    Text
arg_pLayerTreeMakeSnapshotLayerId
instance ToJSON PLayerTreeMakeSnapshot where
  toJSON :: PLayerTreeMakeSnapshot -> Value
toJSON PLayerTreeMakeSnapshot
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
"layerId" 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 (PLayerTreeMakeSnapshot -> Text
pLayerTreeMakeSnapshotLayerId PLayerTreeMakeSnapshot
p)
    ]
data LayerTreeMakeSnapshot = LayerTreeMakeSnapshot
  {
    -- | The id of the layer snapshot.
    LayerTreeMakeSnapshot -> Text
layerTreeMakeSnapshotSnapshotId :: LayerTreeSnapshotId
  }
  deriving (LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool
(LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool)
-> (LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool)
-> Eq LayerTreeMakeSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool
$c/= :: LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool
== :: LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool
$c== :: LayerTreeMakeSnapshot -> LayerTreeMakeSnapshot -> Bool
Eq, Int -> LayerTreeMakeSnapshot -> ShowS
[LayerTreeMakeSnapshot] -> ShowS
LayerTreeMakeSnapshot -> String
(Int -> LayerTreeMakeSnapshot -> ShowS)
-> (LayerTreeMakeSnapshot -> String)
-> ([LayerTreeMakeSnapshot] -> ShowS)
-> Show LayerTreeMakeSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeMakeSnapshot] -> ShowS
$cshowList :: [LayerTreeMakeSnapshot] -> ShowS
show :: LayerTreeMakeSnapshot -> String
$cshow :: LayerTreeMakeSnapshot -> String
showsPrec :: Int -> LayerTreeMakeSnapshot -> ShowS
$cshowsPrec :: Int -> LayerTreeMakeSnapshot -> ShowS
Show)
instance FromJSON LayerTreeMakeSnapshot where
  parseJSON :: Value -> Parser LayerTreeMakeSnapshot
parseJSON = String
-> (Object -> Parser LayerTreeMakeSnapshot)
-> Value
-> Parser LayerTreeMakeSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeMakeSnapshot" ((Object -> Parser LayerTreeMakeSnapshot)
 -> Value -> Parser LayerTreeMakeSnapshot)
-> (Object -> Parser LayerTreeMakeSnapshot)
-> Value
-> Parser LayerTreeMakeSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> LayerTreeMakeSnapshot
LayerTreeMakeSnapshot
    (Text -> LayerTreeMakeSnapshot)
-> Parser Text -> Parser LayerTreeMakeSnapshot
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
"snapshotId"
instance Command PLayerTreeMakeSnapshot where
  type CommandResponse PLayerTreeMakeSnapshot = LayerTreeMakeSnapshot
  commandName :: Proxy PLayerTreeMakeSnapshot -> String
commandName Proxy PLayerTreeMakeSnapshot
_ = String
"LayerTree.makeSnapshot"


-- | Parameters of the 'LayerTree.profileSnapshot' command.
data PLayerTreeProfileSnapshot = PLayerTreeProfileSnapshot
  {
    -- | The id of the layer snapshot.
    PLayerTreeProfileSnapshot -> Text
pLayerTreeProfileSnapshotSnapshotId :: LayerTreeSnapshotId,
    -- | The maximum number of times to replay the snapshot (1, if not specified).
    PLayerTreeProfileSnapshot -> Maybe Int
pLayerTreeProfileSnapshotMinRepeatCount :: Maybe Int,
    -- | The minimum duration (in seconds) to replay the snapshot.
    PLayerTreeProfileSnapshot -> Maybe Double
pLayerTreeProfileSnapshotMinDuration :: Maybe Double,
    -- | The clip rectangle to apply when replaying the snapshot.
    PLayerTreeProfileSnapshot -> Maybe DOMRect
pLayerTreeProfileSnapshotClipRect :: Maybe DOMPageNetworkEmulationSecurity.DOMRect
  }
  deriving (PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool
(PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool)
-> (PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool)
-> Eq PLayerTreeProfileSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool
$c/= :: PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool
== :: PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool
$c== :: PLayerTreeProfileSnapshot -> PLayerTreeProfileSnapshot -> Bool
Eq, Int -> PLayerTreeProfileSnapshot -> ShowS
[PLayerTreeProfileSnapshot] -> ShowS
PLayerTreeProfileSnapshot -> String
(Int -> PLayerTreeProfileSnapshot -> ShowS)
-> (PLayerTreeProfileSnapshot -> String)
-> ([PLayerTreeProfileSnapshot] -> ShowS)
-> Show PLayerTreeProfileSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeProfileSnapshot] -> ShowS
$cshowList :: [PLayerTreeProfileSnapshot] -> ShowS
show :: PLayerTreeProfileSnapshot -> String
$cshow :: PLayerTreeProfileSnapshot -> String
showsPrec :: Int -> PLayerTreeProfileSnapshot -> ShowS
$cshowsPrec :: Int -> PLayerTreeProfileSnapshot -> ShowS
Show)
pLayerTreeProfileSnapshot
  {-
  -- | The id of the layer snapshot.
  -}
  :: LayerTreeSnapshotId
  -> PLayerTreeProfileSnapshot
pLayerTreeProfileSnapshot :: Text -> PLayerTreeProfileSnapshot
pLayerTreeProfileSnapshot
  Text
arg_pLayerTreeProfileSnapshotSnapshotId
  = Text
-> Maybe Int
-> Maybe Double
-> Maybe DOMRect
-> PLayerTreeProfileSnapshot
PLayerTreeProfileSnapshot
    Text
arg_pLayerTreeProfileSnapshotSnapshotId
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Double
forall a. Maybe a
Nothing
    Maybe DOMRect
forall a. Maybe a
Nothing
instance ToJSON PLayerTreeProfileSnapshot where
  toJSON :: PLayerTreeProfileSnapshot -> Value
toJSON PLayerTreeProfileSnapshot
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
"snapshotId" 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 (PLayerTreeProfileSnapshot -> Text
pLayerTreeProfileSnapshotSnapshotId PLayerTreeProfileSnapshot
p),
    (Text
"minRepeatCount" 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
<$> (PLayerTreeProfileSnapshot -> Maybe Int
pLayerTreeProfileSnapshotMinRepeatCount PLayerTreeProfileSnapshot
p),
    (Text
"minDuration" 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
<$> (PLayerTreeProfileSnapshot -> Maybe Double
pLayerTreeProfileSnapshotMinDuration PLayerTreeProfileSnapshot
p),
    (Text
"clipRect" Text -> DOMRect -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMRect -> Pair) -> Maybe DOMRect -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PLayerTreeProfileSnapshot -> Maybe DOMRect
pLayerTreeProfileSnapshotClipRect PLayerTreeProfileSnapshot
p)
    ]
data LayerTreeProfileSnapshot = LayerTreeProfileSnapshot
  {
    -- | The array of paint profiles, one per run.
    LayerTreeProfileSnapshot -> [[Double]]
layerTreeProfileSnapshotTimings :: [LayerTreePaintProfile]
  }
  deriving (LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool
(LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool)
-> (LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool)
-> Eq LayerTreeProfileSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool
$c/= :: LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool
== :: LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool
$c== :: LayerTreeProfileSnapshot -> LayerTreeProfileSnapshot -> Bool
Eq, Int -> LayerTreeProfileSnapshot -> ShowS
[LayerTreeProfileSnapshot] -> ShowS
LayerTreeProfileSnapshot -> String
(Int -> LayerTreeProfileSnapshot -> ShowS)
-> (LayerTreeProfileSnapshot -> String)
-> ([LayerTreeProfileSnapshot] -> ShowS)
-> Show LayerTreeProfileSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeProfileSnapshot] -> ShowS
$cshowList :: [LayerTreeProfileSnapshot] -> ShowS
show :: LayerTreeProfileSnapshot -> String
$cshow :: LayerTreeProfileSnapshot -> String
showsPrec :: Int -> LayerTreeProfileSnapshot -> ShowS
$cshowsPrec :: Int -> LayerTreeProfileSnapshot -> ShowS
Show)
instance FromJSON LayerTreeProfileSnapshot where
  parseJSON :: Value -> Parser LayerTreeProfileSnapshot
parseJSON = String
-> (Object -> Parser LayerTreeProfileSnapshot)
-> Value
-> Parser LayerTreeProfileSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeProfileSnapshot" ((Object -> Parser LayerTreeProfileSnapshot)
 -> Value -> Parser LayerTreeProfileSnapshot)
-> (Object -> Parser LayerTreeProfileSnapshot)
-> Value
-> Parser LayerTreeProfileSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> [[Double]] -> LayerTreeProfileSnapshot
LayerTreeProfileSnapshot
    ([[Double]] -> LayerTreeProfileSnapshot)
-> Parser [[Double]] -> Parser LayerTreeProfileSnapshot
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
"timings"
instance Command PLayerTreeProfileSnapshot where
  type CommandResponse PLayerTreeProfileSnapshot = LayerTreeProfileSnapshot
  commandName :: Proxy PLayerTreeProfileSnapshot -> String
commandName Proxy PLayerTreeProfileSnapshot
_ = String
"LayerTree.profileSnapshot"

-- | Releases layer snapshot captured by the back-end.

-- | Parameters of the 'LayerTree.releaseSnapshot' command.
data PLayerTreeReleaseSnapshot = PLayerTreeReleaseSnapshot
  {
    -- | The id of the layer snapshot.
    PLayerTreeReleaseSnapshot -> Text
pLayerTreeReleaseSnapshotSnapshotId :: LayerTreeSnapshotId
  }
  deriving (PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool
(PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool)
-> (PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool)
-> Eq PLayerTreeReleaseSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool
$c/= :: PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool
== :: PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool
$c== :: PLayerTreeReleaseSnapshot -> PLayerTreeReleaseSnapshot -> Bool
Eq, Int -> PLayerTreeReleaseSnapshot -> ShowS
[PLayerTreeReleaseSnapshot] -> ShowS
PLayerTreeReleaseSnapshot -> String
(Int -> PLayerTreeReleaseSnapshot -> ShowS)
-> (PLayerTreeReleaseSnapshot -> String)
-> ([PLayerTreeReleaseSnapshot] -> ShowS)
-> Show PLayerTreeReleaseSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeReleaseSnapshot] -> ShowS
$cshowList :: [PLayerTreeReleaseSnapshot] -> ShowS
show :: PLayerTreeReleaseSnapshot -> String
$cshow :: PLayerTreeReleaseSnapshot -> String
showsPrec :: Int -> PLayerTreeReleaseSnapshot -> ShowS
$cshowsPrec :: Int -> PLayerTreeReleaseSnapshot -> ShowS
Show)
pLayerTreeReleaseSnapshot
  {-
  -- | The id of the layer snapshot.
  -}
  :: LayerTreeSnapshotId
  -> PLayerTreeReleaseSnapshot
pLayerTreeReleaseSnapshot :: Text -> PLayerTreeReleaseSnapshot
pLayerTreeReleaseSnapshot
  Text
arg_pLayerTreeReleaseSnapshotSnapshotId
  = Text -> PLayerTreeReleaseSnapshot
PLayerTreeReleaseSnapshot
    Text
arg_pLayerTreeReleaseSnapshotSnapshotId
instance ToJSON PLayerTreeReleaseSnapshot where
  toJSON :: PLayerTreeReleaseSnapshot -> Value
toJSON PLayerTreeReleaseSnapshot
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
"snapshotId" 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 (PLayerTreeReleaseSnapshot -> Text
pLayerTreeReleaseSnapshotSnapshotId PLayerTreeReleaseSnapshot
p)
    ]
instance Command PLayerTreeReleaseSnapshot where
  type CommandResponse PLayerTreeReleaseSnapshot = ()
  commandName :: Proxy PLayerTreeReleaseSnapshot -> String
commandName Proxy PLayerTreeReleaseSnapshot
_ = String
"LayerTree.releaseSnapshot"
  fromJSON :: Proxy PLayerTreeReleaseSnapshot
-> Value -> Result (CommandResponse PLayerTreeReleaseSnapshot)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PLayerTreeReleaseSnapshot -> Result ())
-> Proxy PLayerTreeReleaseSnapshot
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PLayerTreeReleaseSnapshot -> ())
-> Proxy PLayerTreeReleaseSnapshot
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PLayerTreeReleaseSnapshot -> ()
forall a b. a -> b -> a
const ()

-- | Replays the layer snapshot and returns the resulting bitmap.

-- | Parameters of the 'LayerTree.replaySnapshot' command.
data PLayerTreeReplaySnapshot = PLayerTreeReplaySnapshot
  {
    -- | The id of the layer snapshot.
    PLayerTreeReplaySnapshot -> Text
pLayerTreeReplaySnapshotSnapshotId :: LayerTreeSnapshotId,
    -- | The first step to replay from (replay from the very start if not specified).
    PLayerTreeReplaySnapshot -> Maybe Int
pLayerTreeReplaySnapshotFromStep :: Maybe Int,
    -- | The last step to replay to (replay till the end if not specified).
    PLayerTreeReplaySnapshot -> Maybe Int
pLayerTreeReplaySnapshotToStep :: Maybe Int,
    -- | The scale to apply while replaying (defaults to 1).
    PLayerTreeReplaySnapshot -> Maybe Double
pLayerTreeReplaySnapshotScale :: Maybe Double
  }
  deriving (PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool
(PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool)
-> (PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool)
-> Eq PLayerTreeReplaySnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool
$c/= :: PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool
== :: PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool
$c== :: PLayerTreeReplaySnapshot -> PLayerTreeReplaySnapshot -> Bool
Eq, Int -> PLayerTreeReplaySnapshot -> ShowS
[PLayerTreeReplaySnapshot] -> ShowS
PLayerTreeReplaySnapshot -> String
(Int -> PLayerTreeReplaySnapshot -> ShowS)
-> (PLayerTreeReplaySnapshot -> String)
-> ([PLayerTreeReplaySnapshot] -> ShowS)
-> Show PLayerTreeReplaySnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeReplaySnapshot] -> ShowS
$cshowList :: [PLayerTreeReplaySnapshot] -> ShowS
show :: PLayerTreeReplaySnapshot -> String
$cshow :: PLayerTreeReplaySnapshot -> String
showsPrec :: Int -> PLayerTreeReplaySnapshot -> ShowS
$cshowsPrec :: Int -> PLayerTreeReplaySnapshot -> ShowS
Show)
pLayerTreeReplaySnapshot
  {-
  -- | The id of the layer snapshot.
  -}
  :: LayerTreeSnapshotId
  -> PLayerTreeReplaySnapshot
pLayerTreeReplaySnapshot :: Text -> PLayerTreeReplaySnapshot
pLayerTreeReplaySnapshot
  Text
arg_pLayerTreeReplaySnapshotSnapshotId
  = Text
-> Maybe Int
-> Maybe Int
-> Maybe Double
-> PLayerTreeReplaySnapshot
PLayerTreeReplaySnapshot
    Text
arg_pLayerTreeReplaySnapshotSnapshotId
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Double
forall a. Maybe a
Nothing
instance ToJSON PLayerTreeReplaySnapshot where
  toJSON :: PLayerTreeReplaySnapshot -> Value
toJSON PLayerTreeReplaySnapshot
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
"snapshotId" 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 (PLayerTreeReplaySnapshot -> Text
pLayerTreeReplaySnapshotSnapshotId PLayerTreeReplaySnapshot
p),
    (Text
"fromStep" 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
<$> (PLayerTreeReplaySnapshot -> Maybe Int
pLayerTreeReplaySnapshotFromStep PLayerTreeReplaySnapshot
p),
    (Text
"toStep" 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
<$> (PLayerTreeReplaySnapshot -> Maybe Int
pLayerTreeReplaySnapshotToStep PLayerTreeReplaySnapshot
p),
    (Text
"scale" 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
<$> (PLayerTreeReplaySnapshot -> Maybe Double
pLayerTreeReplaySnapshotScale PLayerTreeReplaySnapshot
p)
    ]
data LayerTreeReplaySnapshot = LayerTreeReplaySnapshot
  {
    -- | A data: URL for resulting image.
    LayerTreeReplaySnapshot -> Text
layerTreeReplaySnapshotDataURL :: T.Text
  }
  deriving (LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool
(LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool)
-> (LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool)
-> Eq LayerTreeReplaySnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool
$c/= :: LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool
== :: LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool
$c== :: LayerTreeReplaySnapshot -> LayerTreeReplaySnapshot -> Bool
Eq, Int -> LayerTreeReplaySnapshot -> ShowS
[LayerTreeReplaySnapshot] -> ShowS
LayerTreeReplaySnapshot -> String
(Int -> LayerTreeReplaySnapshot -> ShowS)
-> (LayerTreeReplaySnapshot -> String)
-> ([LayerTreeReplaySnapshot] -> ShowS)
-> Show LayerTreeReplaySnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeReplaySnapshot] -> ShowS
$cshowList :: [LayerTreeReplaySnapshot] -> ShowS
show :: LayerTreeReplaySnapshot -> String
$cshow :: LayerTreeReplaySnapshot -> String
showsPrec :: Int -> LayerTreeReplaySnapshot -> ShowS
$cshowsPrec :: Int -> LayerTreeReplaySnapshot -> ShowS
Show)
instance FromJSON LayerTreeReplaySnapshot where
  parseJSON :: Value -> Parser LayerTreeReplaySnapshot
parseJSON = String
-> (Object -> Parser LayerTreeReplaySnapshot)
-> Value
-> Parser LayerTreeReplaySnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeReplaySnapshot" ((Object -> Parser LayerTreeReplaySnapshot)
 -> Value -> Parser LayerTreeReplaySnapshot)
-> (Object -> Parser LayerTreeReplaySnapshot)
-> Value
-> Parser LayerTreeReplaySnapshot
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> LayerTreeReplaySnapshot
LayerTreeReplaySnapshot
    (Text -> LayerTreeReplaySnapshot)
-> Parser Text -> Parser LayerTreeReplaySnapshot
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
"dataURL"
instance Command PLayerTreeReplaySnapshot where
  type CommandResponse PLayerTreeReplaySnapshot = LayerTreeReplaySnapshot
  commandName :: Proxy PLayerTreeReplaySnapshot -> String
commandName Proxy PLayerTreeReplaySnapshot
_ = String
"LayerTree.replaySnapshot"

-- | Replays the layer snapshot and returns canvas log.

-- | Parameters of the 'LayerTree.snapshotCommandLog' command.
data PLayerTreeSnapshotCommandLog = PLayerTreeSnapshotCommandLog
  {
    -- | The id of the layer snapshot.
    PLayerTreeSnapshotCommandLog -> Text
pLayerTreeSnapshotCommandLogSnapshotId :: LayerTreeSnapshotId
  }
  deriving (PLayerTreeSnapshotCommandLog
-> PLayerTreeSnapshotCommandLog -> Bool
(PLayerTreeSnapshotCommandLog
 -> PLayerTreeSnapshotCommandLog -> Bool)
-> (PLayerTreeSnapshotCommandLog
    -> PLayerTreeSnapshotCommandLog -> Bool)
-> Eq PLayerTreeSnapshotCommandLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PLayerTreeSnapshotCommandLog
-> PLayerTreeSnapshotCommandLog -> Bool
$c/= :: PLayerTreeSnapshotCommandLog
-> PLayerTreeSnapshotCommandLog -> Bool
== :: PLayerTreeSnapshotCommandLog
-> PLayerTreeSnapshotCommandLog -> Bool
$c== :: PLayerTreeSnapshotCommandLog
-> PLayerTreeSnapshotCommandLog -> Bool
Eq, Int -> PLayerTreeSnapshotCommandLog -> ShowS
[PLayerTreeSnapshotCommandLog] -> ShowS
PLayerTreeSnapshotCommandLog -> String
(Int -> PLayerTreeSnapshotCommandLog -> ShowS)
-> (PLayerTreeSnapshotCommandLog -> String)
-> ([PLayerTreeSnapshotCommandLog] -> ShowS)
-> Show PLayerTreeSnapshotCommandLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PLayerTreeSnapshotCommandLog] -> ShowS
$cshowList :: [PLayerTreeSnapshotCommandLog] -> ShowS
show :: PLayerTreeSnapshotCommandLog -> String
$cshow :: PLayerTreeSnapshotCommandLog -> String
showsPrec :: Int -> PLayerTreeSnapshotCommandLog -> ShowS
$cshowsPrec :: Int -> PLayerTreeSnapshotCommandLog -> ShowS
Show)
pLayerTreeSnapshotCommandLog
  {-
  -- | The id of the layer snapshot.
  -}
  :: LayerTreeSnapshotId
  -> PLayerTreeSnapshotCommandLog
pLayerTreeSnapshotCommandLog :: Text -> PLayerTreeSnapshotCommandLog
pLayerTreeSnapshotCommandLog
  Text
arg_pLayerTreeSnapshotCommandLogSnapshotId
  = Text -> PLayerTreeSnapshotCommandLog
PLayerTreeSnapshotCommandLog
    Text
arg_pLayerTreeSnapshotCommandLogSnapshotId
instance ToJSON PLayerTreeSnapshotCommandLog where
  toJSON :: PLayerTreeSnapshotCommandLog -> Value
toJSON PLayerTreeSnapshotCommandLog
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
"snapshotId" 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 (PLayerTreeSnapshotCommandLog -> Text
pLayerTreeSnapshotCommandLogSnapshotId PLayerTreeSnapshotCommandLog
p)
    ]
data LayerTreeSnapshotCommandLog = LayerTreeSnapshotCommandLog
  {
    -- | The array of canvas function calls.
    LayerTreeSnapshotCommandLog -> [[(Text, Text)]]
layerTreeSnapshotCommandLogCommandLog :: [[(T.Text, T.Text)]]
  }
  deriving (LayerTreeSnapshotCommandLog -> LayerTreeSnapshotCommandLog -> Bool
(LayerTreeSnapshotCommandLog
 -> LayerTreeSnapshotCommandLog -> Bool)
-> (LayerTreeSnapshotCommandLog
    -> LayerTreeSnapshotCommandLog -> Bool)
-> Eq LayerTreeSnapshotCommandLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerTreeSnapshotCommandLog -> LayerTreeSnapshotCommandLog -> Bool
$c/= :: LayerTreeSnapshotCommandLog -> LayerTreeSnapshotCommandLog -> Bool
== :: LayerTreeSnapshotCommandLog -> LayerTreeSnapshotCommandLog -> Bool
$c== :: LayerTreeSnapshotCommandLog -> LayerTreeSnapshotCommandLog -> Bool
Eq, Int -> LayerTreeSnapshotCommandLog -> ShowS
[LayerTreeSnapshotCommandLog] -> ShowS
LayerTreeSnapshotCommandLog -> String
(Int -> LayerTreeSnapshotCommandLog -> ShowS)
-> (LayerTreeSnapshotCommandLog -> String)
-> ([LayerTreeSnapshotCommandLog] -> ShowS)
-> Show LayerTreeSnapshotCommandLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerTreeSnapshotCommandLog] -> ShowS
$cshowList :: [LayerTreeSnapshotCommandLog] -> ShowS
show :: LayerTreeSnapshotCommandLog -> String
$cshow :: LayerTreeSnapshotCommandLog -> String
showsPrec :: Int -> LayerTreeSnapshotCommandLog -> ShowS
$cshowsPrec :: Int -> LayerTreeSnapshotCommandLog -> ShowS
Show)
instance FromJSON LayerTreeSnapshotCommandLog where
  parseJSON :: Value -> Parser LayerTreeSnapshotCommandLog
parseJSON = String
-> (Object -> Parser LayerTreeSnapshotCommandLog)
-> Value
-> Parser LayerTreeSnapshotCommandLog
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LayerTreeSnapshotCommandLog" ((Object -> Parser LayerTreeSnapshotCommandLog)
 -> Value -> Parser LayerTreeSnapshotCommandLog)
-> (Object -> Parser LayerTreeSnapshotCommandLog)
-> Value
-> Parser LayerTreeSnapshotCommandLog
forall a b. (a -> b) -> a -> b
$ \Object
o -> [[(Text, Text)]] -> LayerTreeSnapshotCommandLog
LayerTreeSnapshotCommandLog
    ([[(Text, Text)]] -> LayerTreeSnapshotCommandLog)
-> Parser [[(Text, Text)]] -> Parser LayerTreeSnapshotCommandLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [[(Text, Text)]]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"commandLog"
instance Command PLayerTreeSnapshotCommandLog where
  type CommandResponse PLayerTreeSnapshotCommandLog = LayerTreeSnapshotCommandLog
  commandName :: Proxy PLayerTreeSnapshotCommandLog -> String
commandName Proxy PLayerTreeSnapshotCommandLog
_ = String
"LayerTree.snapshotCommandLog"