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


{- |
= PerformanceTimeline

Reporting of performance timeline events, as specified in
https://w3c.github.io/performance-timeline/#dom-performanceobserver.
-}


module CDP.Domains.PerformanceTimeline (module CDP.Domains.PerformanceTimeline) 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 'PerformanceTimeline.LargestContentfulPaint'.
--   See https://github.com/WICG/LargestContentfulPaint and largest_contentful_paint.idl
data PerformanceTimelineLargestContentfulPaint = PerformanceTimelineLargestContentfulPaint
  {
    PerformanceTimelineLargestContentfulPaint -> NetworkTimeSinceEpoch
performanceTimelineLargestContentfulPaintRenderTime :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    PerformanceTimelineLargestContentfulPaint -> NetworkTimeSinceEpoch
performanceTimelineLargestContentfulPaintLoadTime :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    -- | The number of pixels being painted.
    PerformanceTimelineLargestContentfulPaint -> NetworkTimeSinceEpoch
performanceTimelineLargestContentfulPaintSize :: Double,
    -- | The id attribute of the element, if available.
    PerformanceTimelineLargestContentfulPaint -> Maybe Text
performanceTimelineLargestContentfulPaintElementId :: Maybe T.Text,
    -- | The URL of the image (may be trimmed).
    PerformanceTimelineLargestContentfulPaint -> Maybe Text
performanceTimelineLargestContentfulPaintUrl :: Maybe T.Text,
    PerformanceTimelineLargestContentfulPaint -> Maybe DOMBackendNodeId
performanceTimelineLargestContentfulPaintNodeId :: Maybe DOMPageNetworkEmulationSecurity.DOMBackendNodeId
  }
  deriving (PerformanceTimelineLargestContentfulPaint
-> PerformanceTimelineLargestContentfulPaint -> Bool
(PerformanceTimelineLargestContentfulPaint
 -> PerformanceTimelineLargestContentfulPaint -> Bool)
-> (PerformanceTimelineLargestContentfulPaint
    -> PerformanceTimelineLargestContentfulPaint -> Bool)
-> Eq PerformanceTimelineLargestContentfulPaint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceTimelineLargestContentfulPaint
-> PerformanceTimelineLargestContentfulPaint -> Bool
$c/= :: PerformanceTimelineLargestContentfulPaint
-> PerformanceTimelineLargestContentfulPaint -> Bool
== :: PerformanceTimelineLargestContentfulPaint
-> PerformanceTimelineLargestContentfulPaint -> Bool
$c== :: PerformanceTimelineLargestContentfulPaint
-> PerformanceTimelineLargestContentfulPaint -> Bool
Eq, DOMBackendNodeId
-> PerformanceTimelineLargestContentfulPaint -> ShowS
[PerformanceTimelineLargestContentfulPaint] -> ShowS
PerformanceTimelineLargestContentfulPaint -> String
(DOMBackendNodeId
 -> PerformanceTimelineLargestContentfulPaint -> ShowS)
-> (PerformanceTimelineLargestContentfulPaint -> String)
-> ([PerformanceTimelineLargestContentfulPaint] -> ShowS)
-> Show PerformanceTimelineLargestContentfulPaint
forall a.
(DOMBackendNodeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceTimelineLargestContentfulPaint] -> ShowS
$cshowList :: [PerformanceTimelineLargestContentfulPaint] -> ShowS
show :: PerformanceTimelineLargestContentfulPaint -> String
$cshow :: PerformanceTimelineLargestContentfulPaint -> String
showsPrec :: DOMBackendNodeId
-> PerformanceTimelineLargestContentfulPaint -> ShowS
$cshowsPrec :: DOMBackendNodeId
-> PerformanceTimelineLargestContentfulPaint -> ShowS
Show)
instance FromJSON PerformanceTimelineLargestContentfulPaint where
  parseJSON :: Value -> Parser PerformanceTimelineLargestContentfulPaint
parseJSON = String
-> (Object -> Parser PerformanceTimelineLargestContentfulPaint)
-> Value
-> Parser PerformanceTimelineLargestContentfulPaint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceTimelineLargestContentfulPaint" ((Object -> Parser PerformanceTimelineLargestContentfulPaint)
 -> Value -> Parser PerformanceTimelineLargestContentfulPaint)
-> (Object -> Parser PerformanceTimelineLargestContentfulPaint)
-> Value
-> Parser PerformanceTimelineLargestContentfulPaint
forall a b. (a -> b) -> a -> b
$ \Object
o -> NetworkTimeSinceEpoch
-> NetworkTimeSinceEpoch
-> NetworkTimeSinceEpoch
-> Maybe Text
-> Maybe Text
-> Maybe DOMBackendNodeId
-> PerformanceTimelineLargestContentfulPaint
PerformanceTimelineLargestContentfulPaint
    (NetworkTimeSinceEpoch
 -> NetworkTimeSinceEpoch
 -> NetworkTimeSinceEpoch
 -> Maybe Text
 -> Maybe Text
 -> Maybe DOMBackendNodeId
 -> PerformanceTimelineLargestContentfulPaint)
-> Parser NetworkTimeSinceEpoch
-> Parser
     (NetworkTimeSinceEpoch
      -> NetworkTimeSinceEpoch
      -> Maybe Text
      -> Maybe Text
      -> Maybe DOMBackendNodeId
      -> PerformanceTimelineLargestContentfulPaint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"renderTime"
    Parser
  (NetworkTimeSinceEpoch
   -> NetworkTimeSinceEpoch
   -> Maybe Text
   -> Maybe Text
   -> Maybe DOMBackendNodeId
   -> PerformanceTimelineLargestContentfulPaint)
-> Parser NetworkTimeSinceEpoch
-> Parser
     (NetworkTimeSinceEpoch
      -> Maybe Text
      -> Maybe Text
      -> Maybe DOMBackendNodeId
      -> PerformanceTimelineLargestContentfulPaint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"loadTime"
    Parser
  (NetworkTimeSinceEpoch
   -> Maybe Text
   -> Maybe Text
   -> Maybe DOMBackendNodeId
   -> PerformanceTimelineLargestContentfulPaint)
-> Parser NetworkTimeSinceEpoch
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DOMBackendNodeId
      -> PerformanceTimelineLargestContentfulPaint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"size"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DOMBackendNodeId
   -> PerformanceTimelineLargestContentfulPaint)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DOMBackendNodeId
      -> PerformanceTimelineLargestContentfulPaint)
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
"elementId"
    Parser
  (Maybe Text
   -> Maybe DOMBackendNodeId
   -> PerformanceTimelineLargestContentfulPaint)
-> Parser (Maybe Text)
-> Parser
     (Maybe DOMBackendNodeId
      -> PerformanceTimelineLargestContentfulPaint)
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
"url"
    Parser
  (Maybe DOMBackendNodeId
   -> PerformanceTimelineLargestContentfulPaint)
-> Parser (Maybe DOMBackendNodeId)
-> Parser PerformanceTimelineLargestContentfulPaint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMBackendNodeId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"nodeId"
instance ToJSON PerformanceTimelineLargestContentfulPaint where
  toJSON :: PerformanceTimelineLargestContentfulPaint -> Value
toJSON PerformanceTimelineLargestContentfulPaint
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
"renderTime" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (PerformanceTimelineLargestContentfulPaint -> NetworkTimeSinceEpoch
performanceTimelineLargestContentfulPaintRenderTime PerformanceTimelineLargestContentfulPaint
p),
    (Text
"loadTime" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (PerformanceTimelineLargestContentfulPaint -> NetworkTimeSinceEpoch
performanceTimelineLargestContentfulPaintLoadTime PerformanceTimelineLargestContentfulPaint
p),
    (Text
"size" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (PerformanceTimelineLargestContentfulPaint -> NetworkTimeSinceEpoch
performanceTimelineLargestContentfulPaintSize PerformanceTimelineLargestContentfulPaint
p),
    (Text
"elementId" 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
<$> (PerformanceTimelineLargestContentfulPaint -> Maybe Text
performanceTimelineLargestContentfulPaintElementId PerformanceTimelineLargestContentfulPaint
p),
    (Text
"url" 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
<$> (PerformanceTimelineLargestContentfulPaint -> Maybe Text
performanceTimelineLargestContentfulPaintUrl PerformanceTimelineLargestContentfulPaint
p),
    (Text
"nodeId" Text -> DOMBackendNodeId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMBackendNodeId -> Pair) -> Maybe DOMBackendNodeId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PerformanceTimelineLargestContentfulPaint -> Maybe DOMBackendNodeId
performanceTimelineLargestContentfulPaintNodeId PerformanceTimelineLargestContentfulPaint
p)
    ]

-- | Type 'PerformanceTimeline.LayoutShiftAttribution'.
data PerformanceTimelineLayoutShiftAttribution = PerformanceTimelineLayoutShiftAttribution
  {
    PerformanceTimelineLayoutShiftAttribution -> DOMRect
performanceTimelineLayoutShiftAttributionPreviousRect :: DOMPageNetworkEmulationSecurity.DOMRect,
    PerformanceTimelineLayoutShiftAttribution -> DOMRect
performanceTimelineLayoutShiftAttributionCurrentRect :: DOMPageNetworkEmulationSecurity.DOMRect,
    PerformanceTimelineLayoutShiftAttribution -> Maybe DOMBackendNodeId
performanceTimelineLayoutShiftAttributionNodeId :: Maybe DOMPageNetworkEmulationSecurity.DOMBackendNodeId
  }
  deriving (PerformanceTimelineLayoutShiftAttribution
-> PerformanceTimelineLayoutShiftAttribution -> Bool
(PerformanceTimelineLayoutShiftAttribution
 -> PerformanceTimelineLayoutShiftAttribution -> Bool)
-> (PerformanceTimelineLayoutShiftAttribution
    -> PerformanceTimelineLayoutShiftAttribution -> Bool)
-> Eq PerformanceTimelineLayoutShiftAttribution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceTimelineLayoutShiftAttribution
-> PerformanceTimelineLayoutShiftAttribution -> Bool
$c/= :: PerformanceTimelineLayoutShiftAttribution
-> PerformanceTimelineLayoutShiftAttribution -> Bool
== :: PerformanceTimelineLayoutShiftAttribution
-> PerformanceTimelineLayoutShiftAttribution -> Bool
$c== :: PerformanceTimelineLayoutShiftAttribution
-> PerformanceTimelineLayoutShiftAttribution -> Bool
Eq, DOMBackendNodeId
-> PerformanceTimelineLayoutShiftAttribution -> ShowS
[PerformanceTimelineLayoutShiftAttribution] -> ShowS
PerformanceTimelineLayoutShiftAttribution -> String
(DOMBackendNodeId
 -> PerformanceTimelineLayoutShiftAttribution -> ShowS)
-> (PerformanceTimelineLayoutShiftAttribution -> String)
-> ([PerformanceTimelineLayoutShiftAttribution] -> ShowS)
-> Show PerformanceTimelineLayoutShiftAttribution
forall a.
(DOMBackendNodeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceTimelineLayoutShiftAttribution] -> ShowS
$cshowList :: [PerformanceTimelineLayoutShiftAttribution] -> ShowS
show :: PerformanceTimelineLayoutShiftAttribution -> String
$cshow :: PerformanceTimelineLayoutShiftAttribution -> String
showsPrec :: DOMBackendNodeId
-> PerformanceTimelineLayoutShiftAttribution -> ShowS
$cshowsPrec :: DOMBackendNodeId
-> PerformanceTimelineLayoutShiftAttribution -> ShowS
Show)
instance FromJSON PerformanceTimelineLayoutShiftAttribution where
  parseJSON :: Value -> Parser PerformanceTimelineLayoutShiftAttribution
parseJSON = String
-> (Object -> Parser PerformanceTimelineLayoutShiftAttribution)
-> Value
-> Parser PerformanceTimelineLayoutShiftAttribution
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceTimelineLayoutShiftAttribution" ((Object -> Parser PerformanceTimelineLayoutShiftAttribution)
 -> Value -> Parser PerformanceTimelineLayoutShiftAttribution)
-> (Object -> Parser PerformanceTimelineLayoutShiftAttribution)
-> Value
-> Parser PerformanceTimelineLayoutShiftAttribution
forall a b. (a -> b) -> a -> b
$ \Object
o -> DOMRect
-> DOMRect
-> Maybe DOMBackendNodeId
-> PerformanceTimelineLayoutShiftAttribution
PerformanceTimelineLayoutShiftAttribution
    (DOMRect
 -> DOMRect
 -> Maybe DOMBackendNodeId
 -> PerformanceTimelineLayoutShiftAttribution)
-> Parser DOMRect
-> Parser
     (DOMRect
      -> Maybe DOMBackendNodeId
      -> PerformanceTimelineLayoutShiftAttribution)
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
"previousRect"
    Parser
  (DOMRect
   -> Maybe DOMBackendNodeId
   -> PerformanceTimelineLayoutShiftAttribution)
-> Parser DOMRect
-> Parser
     (Maybe DOMBackendNodeId
      -> PerformanceTimelineLayoutShiftAttribution)
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
"currentRect"
    Parser
  (Maybe DOMBackendNodeId
   -> PerformanceTimelineLayoutShiftAttribution)
-> Parser (Maybe DOMBackendNodeId)
-> Parser PerformanceTimelineLayoutShiftAttribution
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe DOMBackendNodeId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"nodeId"
instance ToJSON PerformanceTimelineLayoutShiftAttribution where
  toJSON :: PerformanceTimelineLayoutShiftAttribution -> Value
toJSON PerformanceTimelineLayoutShiftAttribution
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
"previousRect" 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 (PerformanceTimelineLayoutShiftAttribution -> DOMRect
performanceTimelineLayoutShiftAttributionPreviousRect PerformanceTimelineLayoutShiftAttribution
p),
    (Text
"currentRect" 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 (PerformanceTimelineLayoutShiftAttribution -> DOMRect
performanceTimelineLayoutShiftAttributionCurrentRect PerformanceTimelineLayoutShiftAttribution
p),
    (Text
"nodeId" Text -> DOMBackendNodeId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (DOMBackendNodeId -> Pair) -> Maybe DOMBackendNodeId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PerformanceTimelineLayoutShiftAttribution -> Maybe DOMBackendNodeId
performanceTimelineLayoutShiftAttributionNodeId PerformanceTimelineLayoutShiftAttribution
p)
    ]

-- | Type 'PerformanceTimeline.LayoutShift'.
--   See https://wicg.github.io/layout-instability/#sec-layout-shift and layout_shift.idl
data PerformanceTimelineLayoutShift = PerformanceTimelineLayoutShift
  {
    -- | Score increment produced by this event.
    PerformanceTimelineLayoutShift -> NetworkTimeSinceEpoch
performanceTimelineLayoutShiftValue :: Double,
    PerformanceTimelineLayoutShift -> Bool
performanceTimelineLayoutShiftHadRecentInput :: Bool,
    PerformanceTimelineLayoutShift -> NetworkTimeSinceEpoch
performanceTimelineLayoutShiftLastInputTime :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    PerformanceTimelineLayoutShift
-> [PerformanceTimelineLayoutShiftAttribution]
performanceTimelineLayoutShiftSources :: [PerformanceTimelineLayoutShiftAttribution]
  }
  deriving (PerformanceTimelineLayoutShift
-> PerformanceTimelineLayoutShift -> Bool
(PerformanceTimelineLayoutShift
 -> PerformanceTimelineLayoutShift -> Bool)
-> (PerformanceTimelineLayoutShift
    -> PerformanceTimelineLayoutShift -> Bool)
-> Eq PerformanceTimelineLayoutShift
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceTimelineLayoutShift
-> PerformanceTimelineLayoutShift -> Bool
$c/= :: PerformanceTimelineLayoutShift
-> PerformanceTimelineLayoutShift -> Bool
== :: PerformanceTimelineLayoutShift
-> PerformanceTimelineLayoutShift -> Bool
$c== :: PerformanceTimelineLayoutShift
-> PerformanceTimelineLayoutShift -> Bool
Eq, DOMBackendNodeId -> PerformanceTimelineLayoutShift -> ShowS
[PerformanceTimelineLayoutShift] -> ShowS
PerformanceTimelineLayoutShift -> String
(DOMBackendNodeId -> PerformanceTimelineLayoutShift -> ShowS)
-> (PerformanceTimelineLayoutShift -> String)
-> ([PerformanceTimelineLayoutShift] -> ShowS)
-> Show PerformanceTimelineLayoutShift
forall a.
(DOMBackendNodeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceTimelineLayoutShift] -> ShowS
$cshowList :: [PerformanceTimelineLayoutShift] -> ShowS
show :: PerformanceTimelineLayoutShift -> String
$cshow :: PerformanceTimelineLayoutShift -> String
showsPrec :: DOMBackendNodeId -> PerformanceTimelineLayoutShift -> ShowS
$cshowsPrec :: DOMBackendNodeId -> PerformanceTimelineLayoutShift -> ShowS
Show)
instance FromJSON PerformanceTimelineLayoutShift where
  parseJSON :: Value -> Parser PerformanceTimelineLayoutShift
parseJSON = String
-> (Object -> Parser PerformanceTimelineLayoutShift)
-> Value
-> Parser PerformanceTimelineLayoutShift
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceTimelineLayoutShift" ((Object -> Parser PerformanceTimelineLayoutShift)
 -> Value -> Parser PerformanceTimelineLayoutShift)
-> (Object -> Parser PerformanceTimelineLayoutShift)
-> Value
-> Parser PerformanceTimelineLayoutShift
forall a b. (a -> b) -> a -> b
$ \Object
o -> NetworkTimeSinceEpoch
-> Bool
-> NetworkTimeSinceEpoch
-> [PerformanceTimelineLayoutShiftAttribution]
-> PerformanceTimelineLayoutShift
PerformanceTimelineLayoutShift
    (NetworkTimeSinceEpoch
 -> Bool
 -> NetworkTimeSinceEpoch
 -> [PerformanceTimelineLayoutShiftAttribution]
 -> PerformanceTimelineLayoutShift)
-> Parser NetworkTimeSinceEpoch
-> Parser
     (Bool
      -> NetworkTimeSinceEpoch
      -> [PerformanceTimelineLayoutShiftAttribution]
      -> PerformanceTimelineLayoutShift)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
    Parser
  (Bool
   -> NetworkTimeSinceEpoch
   -> [PerformanceTimelineLayoutShiftAttribution]
   -> PerformanceTimelineLayoutShift)
-> Parser Bool
-> Parser
     (NetworkTimeSinceEpoch
      -> [PerformanceTimelineLayoutShiftAttribution]
      -> PerformanceTimelineLayoutShift)
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
"hadRecentInput"
    Parser
  (NetworkTimeSinceEpoch
   -> [PerformanceTimelineLayoutShiftAttribution]
   -> PerformanceTimelineLayoutShift)
-> Parser NetworkTimeSinceEpoch
-> Parser
     ([PerformanceTimelineLayoutShiftAttribution]
      -> PerformanceTimelineLayoutShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"lastInputTime"
    Parser
  ([PerformanceTimelineLayoutShiftAttribution]
   -> PerformanceTimelineLayoutShift)
-> Parser [PerformanceTimelineLayoutShiftAttribution]
-> Parser PerformanceTimelineLayoutShift
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> Parser [PerformanceTimelineLayoutShiftAttribution]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"sources"
instance ToJSON PerformanceTimelineLayoutShift where
  toJSON :: PerformanceTimelineLayoutShift -> Value
toJSON PerformanceTimelineLayoutShift
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 -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (PerformanceTimelineLayoutShift -> NetworkTimeSinceEpoch
performanceTimelineLayoutShiftValue PerformanceTimelineLayoutShift
p),
    (Text
"hadRecentInput" 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 (PerformanceTimelineLayoutShift -> Bool
performanceTimelineLayoutShiftHadRecentInput PerformanceTimelineLayoutShift
p),
    (Text
"lastInputTime" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (PerformanceTimelineLayoutShift -> NetworkTimeSinceEpoch
performanceTimelineLayoutShiftLastInputTime PerformanceTimelineLayoutShift
p),
    (Text
"sources" Text -> [PerformanceTimelineLayoutShiftAttribution] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([PerformanceTimelineLayoutShiftAttribution] -> Pair)
-> Maybe [PerformanceTimelineLayoutShiftAttribution] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PerformanceTimelineLayoutShiftAttribution]
-> Maybe [PerformanceTimelineLayoutShiftAttribution]
forall a. a -> Maybe a
Just (PerformanceTimelineLayoutShift
-> [PerformanceTimelineLayoutShiftAttribution]
performanceTimelineLayoutShiftSources PerformanceTimelineLayoutShift
p)
    ]

-- | Type 'PerformanceTimeline.TimelineEvent'.
data PerformanceTimelineTimelineEvent = PerformanceTimelineTimelineEvent
  {
    -- | Identifies the frame that this event is related to. Empty for non-frame targets.
    PerformanceTimelineTimelineEvent -> Text
performanceTimelineTimelineEventFrameId :: DOMPageNetworkEmulationSecurity.PageFrameId,
    -- | The event type, as specified in https://w3c.github.io/performance-timeline/#dom-performanceentry-entrytype
    --   This determines which of the optional "details" fiedls is present.
    PerformanceTimelineTimelineEvent -> Text
performanceTimelineTimelineEventType :: T.Text,
    -- | Name may be empty depending on the type.
    PerformanceTimelineTimelineEvent -> Text
performanceTimelineTimelineEventName :: T.Text,
    -- | Time in seconds since Epoch, monotonically increasing within document lifetime.
    PerformanceTimelineTimelineEvent -> NetworkTimeSinceEpoch
performanceTimelineTimelineEventTime :: DOMPageNetworkEmulationSecurity.NetworkTimeSinceEpoch,
    -- | Event duration, if applicable.
    PerformanceTimelineTimelineEvent -> Maybe NetworkTimeSinceEpoch
performanceTimelineTimelineEventDuration :: Maybe Double,
    PerformanceTimelineTimelineEvent
-> Maybe PerformanceTimelineLargestContentfulPaint
performanceTimelineTimelineEventLcpDetails :: Maybe PerformanceTimelineLargestContentfulPaint,
    PerformanceTimelineTimelineEvent
-> Maybe PerformanceTimelineLayoutShift
performanceTimelineTimelineEventLayoutShiftDetails :: Maybe PerformanceTimelineLayoutShift
  }
  deriving (PerformanceTimelineTimelineEvent
-> PerformanceTimelineTimelineEvent -> Bool
(PerformanceTimelineTimelineEvent
 -> PerformanceTimelineTimelineEvent -> Bool)
-> (PerformanceTimelineTimelineEvent
    -> PerformanceTimelineTimelineEvent -> Bool)
-> Eq PerformanceTimelineTimelineEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceTimelineTimelineEvent
-> PerformanceTimelineTimelineEvent -> Bool
$c/= :: PerformanceTimelineTimelineEvent
-> PerformanceTimelineTimelineEvent -> Bool
== :: PerformanceTimelineTimelineEvent
-> PerformanceTimelineTimelineEvent -> Bool
$c== :: PerformanceTimelineTimelineEvent
-> PerformanceTimelineTimelineEvent -> Bool
Eq, DOMBackendNodeId -> PerformanceTimelineTimelineEvent -> ShowS
[PerformanceTimelineTimelineEvent] -> ShowS
PerformanceTimelineTimelineEvent -> String
(DOMBackendNodeId -> PerformanceTimelineTimelineEvent -> ShowS)
-> (PerformanceTimelineTimelineEvent -> String)
-> ([PerformanceTimelineTimelineEvent] -> ShowS)
-> Show PerformanceTimelineTimelineEvent
forall a.
(DOMBackendNodeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceTimelineTimelineEvent] -> ShowS
$cshowList :: [PerformanceTimelineTimelineEvent] -> ShowS
show :: PerformanceTimelineTimelineEvent -> String
$cshow :: PerformanceTimelineTimelineEvent -> String
showsPrec :: DOMBackendNodeId -> PerformanceTimelineTimelineEvent -> ShowS
$cshowsPrec :: DOMBackendNodeId -> PerformanceTimelineTimelineEvent -> ShowS
Show)
instance FromJSON PerformanceTimelineTimelineEvent where
  parseJSON :: Value -> Parser PerformanceTimelineTimelineEvent
parseJSON = String
-> (Object -> Parser PerformanceTimelineTimelineEvent)
-> Value
-> Parser PerformanceTimelineTimelineEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceTimelineTimelineEvent" ((Object -> Parser PerformanceTimelineTimelineEvent)
 -> Value -> Parser PerformanceTimelineTimelineEvent)
-> (Object -> Parser PerformanceTimelineTimelineEvent)
-> Value
-> Parser PerformanceTimelineTimelineEvent
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> Text
-> NetworkTimeSinceEpoch
-> Maybe NetworkTimeSinceEpoch
-> Maybe PerformanceTimelineLargestContentfulPaint
-> Maybe PerformanceTimelineLayoutShift
-> PerformanceTimelineTimelineEvent
PerformanceTimelineTimelineEvent
    (Text
 -> Text
 -> Text
 -> NetworkTimeSinceEpoch
 -> Maybe NetworkTimeSinceEpoch
 -> Maybe PerformanceTimelineLargestContentfulPaint
 -> Maybe PerformanceTimelineLayoutShift
 -> PerformanceTimelineTimelineEvent)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> NetworkTimeSinceEpoch
      -> Maybe NetworkTimeSinceEpoch
      -> Maybe PerformanceTimelineLargestContentfulPaint
      -> Maybe PerformanceTimelineLayoutShift
      -> PerformanceTimelineTimelineEvent)
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
"frameId"
    Parser
  (Text
   -> Text
   -> NetworkTimeSinceEpoch
   -> Maybe NetworkTimeSinceEpoch
   -> Maybe PerformanceTimelineLargestContentfulPaint
   -> Maybe PerformanceTimelineLayoutShift
   -> PerformanceTimelineTimelineEvent)
-> Parser Text
-> Parser
     (Text
      -> NetworkTimeSinceEpoch
      -> Maybe NetworkTimeSinceEpoch
      -> Maybe PerformanceTimelineLargestContentfulPaint
      -> Maybe PerformanceTimelineLayoutShift
      -> PerformanceTimelineTimelineEvent)
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
"type"
    Parser
  (Text
   -> NetworkTimeSinceEpoch
   -> Maybe NetworkTimeSinceEpoch
   -> Maybe PerformanceTimelineLargestContentfulPaint
   -> Maybe PerformanceTimelineLayoutShift
   -> PerformanceTimelineTimelineEvent)
-> Parser Text
-> Parser
     (NetworkTimeSinceEpoch
      -> Maybe NetworkTimeSinceEpoch
      -> Maybe PerformanceTimelineLargestContentfulPaint
      -> Maybe PerformanceTimelineLayoutShift
      -> PerformanceTimelineTimelineEvent)
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
  (NetworkTimeSinceEpoch
   -> Maybe NetworkTimeSinceEpoch
   -> Maybe PerformanceTimelineLargestContentfulPaint
   -> Maybe PerformanceTimelineLayoutShift
   -> PerformanceTimelineTimelineEvent)
-> Parser NetworkTimeSinceEpoch
-> Parser
     (Maybe NetworkTimeSinceEpoch
      -> Maybe PerformanceTimelineLargestContentfulPaint
      -> Maybe PerformanceTimelineLayoutShift
      -> PerformanceTimelineTimelineEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser NetworkTimeSinceEpoch
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"time"
    Parser
  (Maybe NetworkTimeSinceEpoch
   -> Maybe PerformanceTimelineLargestContentfulPaint
   -> Maybe PerformanceTimelineLayoutShift
   -> PerformanceTimelineTimelineEvent)
-> Parser (Maybe NetworkTimeSinceEpoch)
-> Parser
     (Maybe PerformanceTimelineLargestContentfulPaint
      -> Maybe PerformanceTimelineLayoutShift
      -> PerformanceTimelineTimelineEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NetworkTimeSinceEpoch)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"duration"
    Parser
  (Maybe PerformanceTimelineLargestContentfulPaint
   -> Maybe PerformanceTimelineLayoutShift
   -> PerformanceTimelineTimelineEvent)
-> Parser (Maybe PerformanceTimelineLargestContentfulPaint)
-> Parser
     (Maybe PerformanceTimelineLayoutShift
      -> PerformanceTimelineTimelineEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> Parser (Maybe PerformanceTimelineLargestContentfulPaint)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"lcpDetails"
    Parser
  (Maybe PerformanceTimelineLayoutShift
   -> PerformanceTimelineTimelineEvent)
-> Parser (Maybe PerformanceTimelineLayoutShift)
-> Parser PerformanceTimelineTimelineEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe PerformanceTimelineLayoutShift)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"layoutShiftDetails"
instance ToJSON PerformanceTimelineTimelineEvent where
  toJSON :: PerformanceTimelineTimelineEvent -> Value
toJSON PerformanceTimelineTimelineEvent
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 (PerformanceTimelineTimelineEvent -> Text
performanceTimelineTimelineEventFrameId PerformanceTimelineTimelineEvent
p),
    (Text
"type" 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 (PerformanceTimelineTimelineEvent -> Text
performanceTimelineTimelineEventType PerformanceTimelineTimelineEvent
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 (PerformanceTimelineTimelineEvent -> Text
performanceTimelineTimelineEventName PerformanceTimelineTimelineEvent
p),
    (Text
"time" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkTimeSinceEpoch -> Maybe NetworkTimeSinceEpoch
forall a. a -> Maybe a
Just (PerformanceTimelineTimelineEvent -> NetworkTimeSinceEpoch
performanceTimelineTimelineEventTime PerformanceTimelineTimelineEvent
p),
    (Text
"duration" Text -> NetworkTimeSinceEpoch -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (NetworkTimeSinceEpoch -> Pair)
-> Maybe NetworkTimeSinceEpoch -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PerformanceTimelineTimelineEvent -> Maybe NetworkTimeSinceEpoch
performanceTimelineTimelineEventDuration PerformanceTimelineTimelineEvent
p),
    (Text
"lcpDetails" Text -> PerformanceTimelineLargestContentfulPaint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (PerformanceTimelineLargestContentfulPaint -> Pair)
-> Maybe PerformanceTimelineLargestContentfulPaint -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PerformanceTimelineTimelineEvent
-> Maybe PerformanceTimelineLargestContentfulPaint
performanceTimelineTimelineEventLcpDetails PerformanceTimelineTimelineEvent
p),
    (Text
"layoutShiftDetails" Text -> PerformanceTimelineLayoutShift -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (PerformanceTimelineLayoutShift -> Pair)
-> Maybe PerformanceTimelineLayoutShift -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PerformanceTimelineTimelineEvent
-> Maybe PerformanceTimelineLayoutShift
performanceTimelineTimelineEventLayoutShiftDetails PerformanceTimelineTimelineEvent
p)
    ]

-- | Type of the 'PerformanceTimeline.timelineEventAdded' event.
data PerformanceTimelineTimelineEventAdded = PerformanceTimelineTimelineEventAdded
  {
    PerformanceTimelineTimelineEventAdded
-> PerformanceTimelineTimelineEvent
performanceTimelineTimelineEventAddedEvent :: PerformanceTimelineTimelineEvent
  }
  deriving (PerformanceTimelineTimelineEventAdded
-> PerformanceTimelineTimelineEventAdded -> Bool
(PerformanceTimelineTimelineEventAdded
 -> PerformanceTimelineTimelineEventAdded -> Bool)
-> (PerformanceTimelineTimelineEventAdded
    -> PerformanceTimelineTimelineEventAdded -> Bool)
-> Eq PerformanceTimelineTimelineEventAdded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceTimelineTimelineEventAdded
-> PerformanceTimelineTimelineEventAdded -> Bool
$c/= :: PerformanceTimelineTimelineEventAdded
-> PerformanceTimelineTimelineEventAdded -> Bool
== :: PerformanceTimelineTimelineEventAdded
-> PerformanceTimelineTimelineEventAdded -> Bool
$c== :: PerformanceTimelineTimelineEventAdded
-> PerformanceTimelineTimelineEventAdded -> Bool
Eq, DOMBackendNodeId -> PerformanceTimelineTimelineEventAdded -> ShowS
[PerformanceTimelineTimelineEventAdded] -> ShowS
PerformanceTimelineTimelineEventAdded -> String
(DOMBackendNodeId
 -> PerformanceTimelineTimelineEventAdded -> ShowS)
-> (PerformanceTimelineTimelineEventAdded -> String)
-> ([PerformanceTimelineTimelineEventAdded] -> ShowS)
-> Show PerformanceTimelineTimelineEventAdded
forall a.
(DOMBackendNodeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceTimelineTimelineEventAdded] -> ShowS
$cshowList :: [PerformanceTimelineTimelineEventAdded] -> ShowS
show :: PerformanceTimelineTimelineEventAdded -> String
$cshow :: PerformanceTimelineTimelineEventAdded -> String
showsPrec :: DOMBackendNodeId -> PerformanceTimelineTimelineEventAdded -> ShowS
$cshowsPrec :: DOMBackendNodeId -> PerformanceTimelineTimelineEventAdded -> ShowS
Show)
instance FromJSON PerformanceTimelineTimelineEventAdded where
  parseJSON :: Value -> Parser PerformanceTimelineTimelineEventAdded
parseJSON = String
-> (Object -> Parser PerformanceTimelineTimelineEventAdded)
-> Value
-> Parser PerformanceTimelineTimelineEventAdded
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceTimelineTimelineEventAdded" ((Object -> Parser PerformanceTimelineTimelineEventAdded)
 -> Value -> Parser PerformanceTimelineTimelineEventAdded)
-> (Object -> Parser PerformanceTimelineTimelineEventAdded)
-> Value
-> Parser PerformanceTimelineTimelineEventAdded
forall a b. (a -> b) -> a -> b
$ \Object
o -> PerformanceTimelineTimelineEvent
-> PerformanceTimelineTimelineEventAdded
PerformanceTimelineTimelineEventAdded
    (PerformanceTimelineTimelineEvent
 -> PerformanceTimelineTimelineEventAdded)
-> Parser PerformanceTimelineTimelineEvent
-> Parser PerformanceTimelineTimelineEventAdded
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser PerformanceTimelineTimelineEvent
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"event"
instance Event PerformanceTimelineTimelineEventAdded where
  eventName :: Proxy PerformanceTimelineTimelineEventAdded -> String
eventName Proxy PerformanceTimelineTimelineEventAdded
_ = String
"PerformanceTimeline.timelineEventAdded"

-- | Previously buffered events would be reported before method returns.
--   See also: timelineEventAdded

-- | Parameters of the 'PerformanceTimeline.enable' command.
data PPerformanceTimelineEnable = PPerformanceTimelineEnable
  {
    -- | The types of event to report, as specified in
    --   https://w3c.github.io/performance-timeline/#dom-performanceentry-entrytype
    --   The specified filter overrides any previous filters, passing empty
    --   filter disables recording.
    --   Note that not all types exposed to the web platform are currently supported.
    PPerformanceTimelineEnable -> [Text]
pPerformanceTimelineEnableEventTypes :: [T.Text]
  }
  deriving (PPerformanceTimelineEnable -> PPerformanceTimelineEnable -> Bool
(PPerformanceTimelineEnable -> PPerformanceTimelineEnable -> Bool)
-> (PPerformanceTimelineEnable
    -> PPerformanceTimelineEnable -> Bool)
-> Eq PPerformanceTimelineEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPerformanceTimelineEnable -> PPerformanceTimelineEnable -> Bool
$c/= :: PPerformanceTimelineEnable -> PPerformanceTimelineEnable -> Bool
== :: PPerformanceTimelineEnable -> PPerformanceTimelineEnable -> Bool
$c== :: PPerformanceTimelineEnable -> PPerformanceTimelineEnable -> Bool
Eq, DOMBackendNodeId -> PPerformanceTimelineEnable -> ShowS
[PPerformanceTimelineEnable] -> ShowS
PPerformanceTimelineEnable -> String
(DOMBackendNodeId -> PPerformanceTimelineEnable -> ShowS)
-> (PPerformanceTimelineEnable -> String)
-> ([PPerformanceTimelineEnable] -> ShowS)
-> Show PPerformanceTimelineEnable
forall a.
(DOMBackendNodeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPerformanceTimelineEnable] -> ShowS
$cshowList :: [PPerformanceTimelineEnable] -> ShowS
show :: PPerformanceTimelineEnable -> String
$cshow :: PPerformanceTimelineEnable -> String
showsPrec :: DOMBackendNodeId -> PPerformanceTimelineEnable -> ShowS
$cshowsPrec :: DOMBackendNodeId -> PPerformanceTimelineEnable -> ShowS
Show)
pPerformanceTimelineEnable
  {-
  -- | The types of event to report, as specified in
  --   https://w3c.github.io/performance-timeline/#dom-performanceentry-entrytype
  --   The specified filter overrides any previous filters, passing empty
  --   filter disables recording.
  --   Note that not all types exposed to the web platform are currently supported.
  -}
  :: [T.Text]
  -> PPerformanceTimelineEnable
pPerformanceTimelineEnable :: [Text] -> PPerformanceTimelineEnable
pPerformanceTimelineEnable
  [Text]
arg_pPerformanceTimelineEnableEventTypes
  = [Text] -> PPerformanceTimelineEnable
PPerformanceTimelineEnable
    [Text]
arg_pPerformanceTimelineEnableEventTypes
instance ToJSON PPerformanceTimelineEnable where
  toJSON :: PPerformanceTimelineEnable -> Value
toJSON PPerformanceTimelineEnable
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
"eventTypes" 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 (PPerformanceTimelineEnable -> [Text]
pPerformanceTimelineEnableEventTypes PPerformanceTimelineEnable
p)
    ]
instance Command PPerformanceTimelineEnable where
  type CommandResponse PPerformanceTimelineEnable = ()
  commandName :: Proxy PPerformanceTimelineEnable -> String
commandName Proxy PPerformanceTimelineEnable
_ = String
"PerformanceTimeline.enable"
  fromJSON :: Proxy PPerformanceTimelineEnable
-> Value -> Result (CommandResponse PPerformanceTimelineEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PPerformanceTimelineEnable -> Result ())
-> Proxy PPerformanceTimelineEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PPerformanceTimelineEnable -> ())
-> Proxy PPerformanceTimelineEnable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PPerformanceTimelineEnable -> ()
forall a b. a -> b -> a
const ()