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


{- |
= Runtime

Runtime domain exposes JavaScript runtime by means of remote evaluation and mirror objects.
Evaluation results are returned as mirror object that expose object type, string representation
and unique identifier that can be used for further object reference. Original objects are
maintained in memory unless they are either explicitly released or are released along with the
other objects in their object group.
-}


module CDP.Domains.Runtime (module CDP.Domains.Runtime) 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




-- | Type 'Runtime.ScriptId'.
--   Unique script identifier.
type RuntimeScriptId = T.Text

-- | Type 'Runtime.WebDriverValue'.
--   Represents the value serialiazed by the WebDriver BiDi specification
--   https://w3c.github.io/webdriver-bidi.
data RuntimeWebDriverValueType = RuntimeWebDriverValueTypeUndefined | RuntimeWebDriverValueTypeNull | RuntimeWebDriverValueTypeString | RuntimeWebDriverValueTypeNumber | RuntimeWebDriverValueTypeBoolean | RuntimeWebDriverValueTypeBigint | RuntimeWebDriverValueTypeRegexp | RuntimeWebDriverValueTypeDate | RuntimeWebDriverValueTypeSymbol | RuntimeWebDriverValueTypeArray | RuntimeWebDriverValueTypeObject | RuntimeWebDriverValueTypeFunction | RuntimeWebDriverValueTypeMap | RuntimeWebDriverValueTypeSet | RuntimeWebDriverValueTypeWeakmap | RuntimeWebDriverValueTypeWeakset | RuntimeWebDriverValueTypeError | RuntimeWebDriverValueTypeProxy | RuntimeWebDriverValueTypePromise | RuntimeWebDriverValueTypeTypedarray | RuntimeWebDriverValueTypeArraybuffer | RuntimeWebDriverValueTypeNode | RuntimeWebDriverValueTypeWindow
  deriving (Eq RuntimeWebDriverValueType
Eq RuntimeWebDriverValueType
-> (RuntimeWebDriverValueType
    -> RuntimeWebDriverValueType -> Ordering)
-> (RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool)
-> (RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool)
-> (RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool)
-> (RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool)
-> (RuntimeWebDriverValueType
    -> RuntimeWebDriverValueType -> RuntimeWebDriverValueType)
-> (RuntimeWebDriverValueType
    -> RuntimeWebDriverValueType -> RuntimeWebDriverValueType)
-> Ord RuntimeWebDriverValueType
RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Ordering
RuntimeWebDriverValueType
-> RuntimeWebDriverValueType -> RuntimeWebDriverValueType
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 :: RuntimeWebDriverValueType
-> RuntimeWebDriverValueType -> RuntimeWebDriverValueType
$cmin :: RuntimeWebDriverValueType
-> RuntimeWebDriverValueType -> RuntimeWebDriverValueType
max :: RuntimeWebDriverValueType
-> RuntimeWebDriverValueType -> RuntimeWebDriverValueType
$cmax :: RuntimeWebDriverValueType
-> RuntimeWebDriverValueType -> RuntimeWebDriverValueType
>= :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
$c>= :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
> :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
$c> :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
<= :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
$c<= :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
< :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
$c< :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
compare :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Ordering
$ccompare :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Ordering
$cp1Ord :: Eq RuntimeWebDriverValueType
Ord, RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
(RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool)
-> (RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool)
-> Eq RuntimeWebDriverValueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
$c/= :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
== :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
$c== :: RuntimeWebDriverValueType -> RuntimeWebDriverValueType -> Bool
Eq, Int -> RuntimeWebDriverValueType -> ShowS
[RuntimeWebDriverValueType] -> ShowS
RuntimeWebDriverValueType -> String
(Int -> RuntimeWebDriverValueType -> ShowS)
-> (RuntimeWebDriverValueType -> String)
-> ([RuntimeWebDriverValueType] -> ShowS)
-> Show RuntimeWebDriverValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeWebDriverValueType] -> ShowS
$cshowList :: [RuntimeWebDriverValueType] -> ShowS
show :: RuntimeWebDriverValueType -> String
$cshow :: RuntimeWebDriverValueType -> String
showsPrec :: Int -> RuntimeWebDriverValueType -> ShowS
$cshowsPrec :: Int -> RuntimeWebDriverValueType -> ShowS
Show, ReadPrec [RuntimeWebDriverValueType]
ReadPrec RuntimeWebDriverValueType
Int -> ReadS RuntimeWebDriverValueType
ReadS [RuntimeWebDriverValueType]
(Int -> ReadS RuntimeWebDriverValueType)
-> ReadS [RuntimeWebDriverValueType]
-> ReadPrec RuntimeWebDriverValueType
-> ReadPrec [RuntimeWebDriverValueType]
-> Read RuntimeWebDriverValueType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimeWebDriverValueType]
$creadListPrec :: ReadPrec [RuntimeWebDriverValueType]
readPrec :: ReadPrec RuntimeWebDriverValueType
$creadPrec :: ReadPrec RuntimeWebDriverValueType
readList :: ReadS [RuntimeWebDriverValueType]
$creadList :: ReadS [RuntimeWebDriverValueType]
readsPrec :: Int -> ReadS RuntimeWebDriverValueType
$creadsPrec :: Int -> ReadS RuntimeWebDriverValueType
Read)
instance FromJSON RuntimeWebDriverValueType where
  parseJSON :: Value -> Parser RuntimeWebDriverValueType
parseJSON = String
-> (Text -> Parser RuntimeWebDriverValueType)
-> Value
-> Parser RuntimeWebDriverValueType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimeWebDriverValueType" ((Text -> Parser RuntimeWebDriverValueType)
 -> Value -> Parser RuntimeWebDriverValueType)
-> (Text -> Parser RuntimeWebDriverValueType)
-> Value
-> Parser RuntimeWebDriverValueType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"undefined" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeUndefined
    Text
"null" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeNull
    Text
"string" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeString
    Text
"number" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeNumber
    Text
"boolean" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeBoolean
    Text
"bigint" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeBigint
    Text
"regexp" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeRegexp
    Text
"date" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeDate
    Text
"symbol" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeSymbol
    Text
"array" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeArray
    Text
"object" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeObject
    Text
"function" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeFunction
    Text
"map" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeMap
    Text
"set" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeSet
    Text
"weakmap" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeWeakmap
    Text
"weakset" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeWeakset
    Text
"error" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeError
    Text
"proxy" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeProxy
    Text
"promise" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypePromise
    Text
"typedarray" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeTypedarray
    Text
"arraybuffer" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeArraybuffer
    Text
"node" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeNode
    Text
"window" -> RuntimeWebDriverValueType -> Parser RuntimeWebDriverValueType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeWebDriverValueType
RuntimeWebDriverValueTypeWindow
    Text
"_" -> String -> Parser RuntimeWebDriverValueType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimeWebDriverValueType"
instance ToJSON RuntimeWebDriverValueType where
  toJSON :: RuntimeWebDriverValueType -> Value
toJSON RuntimeWebDriverValueType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimeWebDriverValueType
v of
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeUndefined -> Text
"undefined"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeNull -> Text
"null"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeString -> Text
"string"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeNumber -> Text
"number"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeBoolean -> Text
"boolean"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeBigint -> Text
"bigint"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeRegexp -> Text
"regexp"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeDate -> Text
"date"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeSymbol -> Text
"symbol"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeArray -> Text
"array"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeObject -> Text
"object"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeFunction -> Text
"function"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeMap -> Text
"map"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeSet -> Text
"set"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeWeakmap -> Text
"weakmap"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeWeakset -> Text
"weakset"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeError -> Text
"error"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeProxy -> Text
"proxy"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypePromise -> Text
"promise"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeTypedarray -> Text
"typedarray"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeArraybuffer -> Text
"arraybuffer"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeNode -> Text
"node"
    RuntimeWebDriverValueType
RuntimeWebDriverValueTypeWindow -> Text
"window"
data RuntimeWebDriverValue = RuntimeWebDriverValue
  {
    RuntimeWebDriverValue -> RuntimeWebDriverValueType
runtimeWebDriverValueType :: RuntimeWebDriverValueType,
    RuntimeWebDriverValue -> Maybe Value
runtimeWebDriverValueValue :: Maybe A.Value,
    RuntimeWebDriverValue -> Maybe Text
runtimeWebDriverValueObjectId :: Maybe T.Text
  }
  deriving (RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool
(RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool)
-> (RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool)
-> Eq RuntimeWebDriverValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool
$c/= :: RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool
== :: RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool
$c== :: RuntimeWebDriverValue -> RuntimeWebDriverValue -> Bool
Eq, Int -> RuntimeWebDriverValue -> ShowS
[RuntimeWebDriverValue] -> ShowS
RuntimeWebDriverValue -> String
(Int -> RuntimeWebDriverValue -> ShowS)
-> (RuntimeWebDriverValue -> String)
-> ([RuntimeWebDriverValue] -> ShowS)
-> Show RuntimeWebDriverValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeWebDriverValue] -> ShowS
$cshowList :: [RuntimeWebDriverValue] -> ShowS
show :: RuntimeWebDriverValue -> String
$cshow :: RuntimeWebDriverValue -> String
showsPrec :: Int -> RuntimeWebDriverValue -> ShowS
$cshowsPrec :: Int -> RuntimeWebDriverValue -> ShowS
Show)
instance FromJSON RuntimeWebDriverValue where
  parseJSON :: Value -> Parser RuntimeWebDriverValue
parseJSON = String
-> (Object -> Parser RuntimeWebDriverValue)
-> Value
-> Parser RuntimeWebDriverValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeWebDriverValue" ((Object -> Parser RuntimeWebDriverValue)
 -> Value -> Parser RuntimeWebDriverValue)
-> (Object -> Parser RuntimeWebDriverValue)
-> Value
-> Parser RuntimeWebDriverValue
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeWebDriverValueType
-> Maybe Value -> Maybe Text -> RuntimeWebDriverValue
RuntimeWebDriverValue
    (RuntimeWebDriverValueType
 -> Maybe Value -> Maybe Text -> RuntimeWebDriverValue)
-> Parser RuntimeWebDriverValueType
-> Parser (Maybe Value -> Maybe Text -> RuntimeWebDriverValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeWebDriverValueType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser (Maybe Value -> Maybe Text -> RuntimeWebDriverValue)
-> Parser (Maybe Value)
-> Parser (Maybe Text -> RuntimeWebDriverValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"value"
    Parser (Maybe Text -> RuntimeWebDriverValue)
-> Parser (Maybe Text) -> Parser RuntimeWebDriverValue
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
"objectId"
instance ToJSON RuntimeWebDriverValue where
  toJSON :: RuntimeWebDriverValue -> Value
toJSON RuntimeWebDriverValue
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
"type" Text -> RuntimeWebDriverValueType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeWebDriverValueType -> Pair)
-> Maybe RuntimeWebDriverValueType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeWebDriverValueType -> Maybe RuntimeWebDriverValueType
forall a. a -> Maybe a
Just (RuntimeWebDriverValue -> RuntimeWebDriverValueType
runtimeWebDriverValueType RuntimeWebDriverValue
p),
    (Text
"value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeWebDriverValue -> Maybe Value
runtimeWebDriverValueValue RuntimeWebDriverValue
p),
    (Text
"objectId" 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
<$> (RuntimeWebDriverValue -> Maybe Text
runtimeWebDriverValueObjectId RuntimeWebDriverValue
p)
    ]

-- | Type 'Runtime.RemoteObjectId'.
--   Unique object identifier.
type RuntimeRemoteObjectId = T.Text

-- | Type 'Runtime.UnserializableValue'.
--   Primitive value which cannot be JSON-stringified. Includes values `-0`, `NaN`, `Infinity`,
--   `-Infinity`, and bigint literals.
type RuntimeUnserializableValue = T.Text

-- | Type 'Runtime.RemoteObject'.
--   Mirror object referencing original JavaScript object.
data RuntimeRemoteObjectType = RuntimeRemoteObjectTypeObject | RuntimeRemoteObjectTypeFunction | RuntimeRemoteObjectTypeUndefined | RuntimeRemoteObjectTypeString | RuntimeRemoteObjectTypeNumber | RuntimeRemoteObjectTypeBoolean | RuntimeRemoteObjectTypeSymbol | RuntimeRemoteObjectTypeBigint
  deriving (Eq RuntimeRemoteObjectType
Eq RuntimeRemoteObjectType
-> (RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Ordering)
-> (RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool)
-> (RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool)
-> (RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool)
-> (RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool)
-> (RuntimeRemoteObjectType
    -> RuntimeRemoteObjectType -> RuntimeRemoteObjectType)
-> (RuntimeRemoteObjectType
    -> RuntimeRemoteObjectType -> RuntimeRemoteObjectType)
-> Ord RuntimeRemoteObjectType
RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Ordering
RuntimeRemoteObjectType
-> RuntimeRemoteObjectType -> RuntimeRemoteObjectType
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 :: RuntimeRemoteObjectType
-> RuntimeRemoteObjectType -> RuntimeRemoteObjectType
$cmin :: RuntimeRemoteObjectType
-> RuntimeRemoteObjectType -> RuntimeRemoteObjectType
max :: RuntimeRemoteObjectType
-> RuntimeRemoteObjectType -> RuntimeRemoteObjectType
$cmax :: RuntimeRemoteObjectType
-> RuntimeRemoteObjectType -> RuntimeRemoteObjectType
>= :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
$c>= :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
> :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
$c> :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
<= :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
$c<= :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
< :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
$c< :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
compare :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Ordering
$ccompare :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Ordering
$cp1Ord :: Eq RuntimeRemoteObjectType
Ord, RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
(RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool)
-> (RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool)
-> Eq RuntimeRemoteObjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
$c/= :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
== :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
$c== :: RuntimeRemoteObjectType -> RuntimeRemoteObjectType -> Bool
Eq, Int -> RuntimeRemoteObjectType -> ShowS
[RuntimeRemoteObjectType] -> ShowS
RuntimeRemoteObjectType -> String
(Int -> RuntimeRemoteObjectType -> ShowS)
-> (RuntimeRemoteObjectType -> String)
-> ([RuntimeRemoteObjectType] -> ShowS)
-> Show RuntimeRemoteObjectType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeRemoteObjectType] -> ShowS
$cshowList :: [RuntimeRemoteObjectType] -> ShowS
show :: RuntimeRemoteObjectType -> String
$cshow :: RuntimeRemoteObjectType -> String
showsPrec :: Int -> RuntimeRemoteObjectType -> ShowS
$cshowsPrec :: Int -> RuntimeRemoteObjectType -> ShowS
Show, ReadPrec [RuntimeRemoteObjectType]
ReadPrec RuntimeRemoteObjectType
Int -> ReadS RuntimeRemoteObjectType
ReadS [RuntimeRemoteObjectType]
(Int -> ReadS RuntimeRemoteObjectType)
-> ReadS [RuntimeRemoteObjectType]
-> ReadPrec RuntimeRemoteObjectType
-> ReadPrec [RuntimeRemoteObjectType]
-> Read RuntimeRemoteObjectType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimeRemoteObjectType]
$creadListPrec :: ReadPrec [RuntimeRemoteObjectType]
readPrec :: ReadPrec RuntimeRemoteObjectType
$creadPrec :: ReadPrec RuntimeRemoteObjectType
readList :: ReadS [RuntimeRemoteObjectType]
$creadList :: ReadS [RuntimeRemoteObjectType]
readsPrec :: Int -> ReadS RuntimeRemoteObjectType
$creadsPrec :: Int -> ReadS RuntimeRemoteObjectType
Read)
instance FromJSON RuntimeRemoteObjectType where
  parseJSON :: Value -> Parser RuntimeRemoteObjectType
parseJSON = String
-> (Text -> Parser RuntimeRemoteObjectType)
-> Value
-> Parser RuntimeRemoteObjectType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimeRemoteObjectType" ((Text -> Parser RuntimeRemoteObjectType)
 -> Value -> Parser RuntimeRemoteObjectType)
-> (Text -> Parser RuntimeRemoteObjectType)
-> Value
-> Parser RuntimeRemoteObjectType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"object" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeObject
    Text
"function" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeFunction
    Text
"undefined" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeUndefined
    Text
"string" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeString
    Text
"number" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeNumber
    Text
"boolean" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeBoolean
    Text
"symbol" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeSymbol
    Text
"bigint" -> RuntimeRemoteObjectType -> Parser RuntimeRemoteObjectType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectType
RuntimeRemoteObjectTypeBigint
    Text
"_" -> String -> Parser RuntimeRemoteObjectType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimeRemoteObjectType"
instance ToJSON RuntimeRemoteObjectType where
  toJSON :: RuntimeRemoteObjectType -> Value
toJSON RuntimeRemoteObjectType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimeRemoteObjectType
v of
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeObject -> Text
"object"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeFunction -> Text
"function"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeUndefined -> Text
"undefined"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeString -> Text
"string"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeNumber -> Text
"number"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeBoolean -> Text
"boolean"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeSymbol -> Text
"symbol"
    RuntimeRemoteObjectType
RuntimeRemoteObjectTypeBigint -> Text
"bigint"
data RuntimeRemoteObjectSubtype = RuntimeRemoteObjectSubtypeArray | RuntimeRemoteObjectSubtypeNull | RuntimeRemoteObjectSubtypeNode | RuntimeRemoteObjectSubtypeRegexp | RuntimeRemoteObjectSubtypeDate | RuntimeRemoteObjectSubtypeMap | RuntimeRemoteObjectSubtypeSet | RuntimeRemoteObjectSubtypeWeakmap | RuntimeRemoteObjectSubtypeWeakset | RuntimeRemoteObjectSubtypeIterator | RuntimeRemoteObjectSubtypeGenerator | RuntimeRemoteObjectSubtypeError | RuntimeRemoteObjectSubtypeProxy | RuntimeRemoteObjectSubtypePromise | RuntimeRemoteObjectSubtypeTypedarray | RuntimeRemoteObjectSubtypeArraybuffer | RuntimeRemoteObjectSubtypeDataview | RuntimeRemoteObjectSubtypeWebassemblymemory | RuntimeRemoteObjectSubtypeWasmvalue
  deriving (Eq RuntimeRemoteObjectSubtype
Eq RuntimeRemoteObjectSubtype
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> Ordering)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> Bool)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> Bool)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> Bool)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> Bool)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype)
-> Ord RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> Ordering
RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype
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 :: RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype
$cmin :: RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype
max :: RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype
$cmax :: RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype
>= :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
$c>= :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
> :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
$c> :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
<= :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
$c<= :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
< :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
$c< :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
compare :: RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> Ordering
$ccompare :: RuntimeRemoteObjectSubtype
-> RuntimeRemoteObjectSubtype -> Ordering
$cp1Ord :: Eq RuntimeRemoteObjectSubtype
Ord, RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
(RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool)
-> (RuntimeRemoteObjectSubtype
    -> RuntimeRemoteObjectSubtype -> Bool)
-> Eq RuntimeRemoteObjectSubtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
$c/= :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
== :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
$c== :: RuntimeRemoteObjectSubtype -> RuntimeRemoteObjectSubtype -> Bool
Eq, Int -> RuntimeRemoteObjectSubtype -> ShowS
[RuntimeRemoteObjectSubtype] -> ShowS
RuntimeRemoteObjectSubtype -> String
(Int -> RuntimeRemoteObjectSubtype -> ShowS)
-> (RuntimeRemoteObjectSubtype -> String)
-> ([RuntimeRemoteObjectSubtype] -> ShowS)
-> Show RuntimeRemoteObjectSubtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeRemoteObjectSubtype] -> ShowS
$cshowList :: [RuntimeRemoteObjectSubtype] -> ShowS
show :: RuntimeRemoteObjectSubtype -> String
$cshow :: RuntimeRemoteObjectSubtype -> String
showsPrec :: Int -> RuntimeRemoteObjectSubtype -> ShowS
$cshowsPrec :: Int -> RuntimeRemoteObjectSubtype -> ShowS
Show, ReadPrec [RuntimeRemoteObjectSubtype]
ReadPrec RuntimeRemoteObjectSubtype
Int -> ReadS RuntimeRemoteObjectSubtype
ReadS [RuntimeRemoteObjectSubtype]
(Int -> ReadS RuntimeRemoteObjectSubtype)
-> ReadS [RuntimeRemoteObjectSubtype]
-> ReadPrec RuntimeRemoteObjectSubtype
-> ReadPrec [RuntimeRemoteObjectSubtype]
-> Read RuntimeRemoteObjectSubtype
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimeRemoteObjectSubtype]
$creadListPrec :: ReadPrec [RuntimeRemoteObjectSubtype]
readPrec :: ReadPrec RuntimeRemoteObjectSubtype
$creadPrec :: ReadPrec RuntimeRemoteObjectSubtype
readList :: ReadS [RuntimeRemoteObjectSubtype]
$creadList :: ReadS [RuntimeRemoteObjectSubtype]
readsPrec :: Int -> ReadS RuntimeRemoteObjectSubtype
$creadsPrec :: Int -> ReadS RuntimeRemoteObjectSubtype
Read)
instance FromJSON RuntimeRemoteObjectSubtype where
  parseJSON :: Value -> Parser RuntimeRemoteObjectSubtype
parseJSON = String
-> (Text -> Parser RuntimeRemoteObjectSubtype)
-> Value
-> Parser RuntimeRemoteObjectSubtype
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimeRemoteObjectSubtype" ((Text -> Parser RuntimeRemoteObjectSubtype)
 -> Value -> Parser RuntimeRemoteObjectSubtype)
-> (Text -> Parser RuntimeRemoteObjectSubtype)
-> Value
-> Parser RuntimeRemoteObjectSubtype
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"array" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeArray
    Text
"null" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeNull
    Text
"node" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeNode
    Text
"regexp" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeRegexp
    Text
"date" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeDate
    Text
"map" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeMap
    Text
"set" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeSet
    Text
"weakmap" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWeakmap
    Text
"weakset" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWeakset
    Text
"iterator" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeIterator
    Text
"generator" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeGenerator
    Text
"error" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeError
    Text
"proxy" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeProxy
    Text
"promise" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypePromise
    Text
"typedarray" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeTypedarray
    Text
"arraybuffer" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeArraybuffer
    Text
"dataview" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeDataview
    Text
"webassemblymemory" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWebassemblymemory
    Text
"wasmvalue" -> RuntimeRemoteObjectSubtype -> Parser RuntimeRemoteObjectSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWasmvalue
    Text
"_" -> String -> Parser RuntimeRemoteObjectSubtype
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimeRemoteObjectSubtype"
instance ToJSON RuntimeRemoteObjectSubtype where
  toJSON :: RuntimeRemoteObjectSubtype -> Value
toJSON RuntimeRemoteObjectSubtype
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimeRemoteObjectSubtype
v of
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeArray -> Text
"array"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeNull -> Text
"null"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeNode -> Text
"node"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeRegexp -> Text
"regexp"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeDate -> Text
"date"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeMap -> Text
"map"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeSet -> Text
"set"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWeakmap -> Text
"weakmap"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWeakset -> Text
"weakset"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeIterator -> Text
"iterator"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeGenerator -> Text
"generator"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeError -> Text
"error"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeProxy -> Text
"proxy"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypePromise -> Text
"promise"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeTypedarray -> Text
"typedarray"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeArraybuffer -> Text
"arraybuffer"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeDataview -> Text
"dataview"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWebassemblymemory -> Text
"webassemblymemory"
    RuntimeRemoteObjectSubtype
RuntimeRemoteObjectSubtypeWasmvalue -> Text
"wasmvalue"
data RuntimeRemoteObject = RuntimeRemoteObject
  {
    -- | Object type.
    RuntimeRemoteObject -> RuntimeRemoteObjectType
runtimeRemoteObjectType :: RuntimeRemoteObjectType,
    -- | Object subtype hint. Specified for `object` type values only.
    --   NOTE: If you change anything here, make sure to also update
    --   `subtype` in `ObjectPreview` and `PropertyPreview` below.
    RuntimeRemoteObject -> Maybe RuntimeRemoteObjectSubtype
runtimeRemoteObjectSubtype :: Maybe RuntimeRemoteObjectSubtype,
    -- | Object class (constructor) name. Specified for `object` type values only.
    RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectClassName :: Maybe T.Text,
    -- | Remote object value in case of primitive values or JSON values (if it was requested).
    RuntimeRemoteObject -> Maybe Value
runtimeRemoteObjectValue :: Maybe A.Value,
    -- | Primitive value which can not be JSON-stringified does not have `value`, but gets this
    --   property.
    RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectUnserializableValue :: Maybe RuntimeUnserializableValue,
    -- | String representation of the object.
    RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectDescription :: Maybe T.Text,
    -- | WebDriver BiDi representation of the value.
    RuntimeRemoteObject -> Maybe RuntimeWebDriverValue
runtimeRemoteObjectWebDriverValue :: Maybe RuntimeWebDriverValue,
    -- | Unique object identifier (for non-primitive values).
    RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectObjectId :: Maybe RuntimeRemoteObjectId,
    -- | Preview containing abbreviated property values. Specified for `object` type values only.
    RuntimeRemoteObject -> Maybe RuntimeObjectPreview
runtimeRemoteObjectPreview :: Maybe RuntimeObjectPreview,
    RuntimeRemoteObject -> Maybe RuntimeCustomPreview
runtimeRemoteObjectCustomPreview :: Maybe RuntimeCustomPreview
  }
  deriving (RuntimeRemoteObject -> RuntimeRemoteObject -> Bool
(RuntimeRemoteObject -> RuntimeRemoteObject -> Bool)
-> (RuntimeRemoteObject -> RuntimeRemoteObject -> Bool)
-> Eq RuntimeRemoteObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeRemoteObject -> RuntimeRemoteObject -> Bool
$c/= :: RuntimeRemoteObject -> RuntimeRemoteObject -> Bool
== :: RuntimeRemoteObject -> RuntimeRemoteObject -> Bool
$c== :: RuntimeRemoteObject -> RuntimeRemoteObject -> Bool
Eq, Int -> RuntimeRemoteObject -> ShowS
[RuntimeRemoteObject] -> ShowS
RuntimeRemoteObject -> String
(Int -> RuntimeRemoteObject -> ShowS)
-> (RuntimeRemoteObject -> String)
-> ([RuntimeRemoteObject] -> ShowS)
-> Show RuntimeRemoteObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeRemoteObject] -> ShowS
$cshowList :: [RuntimeRemoteObject] -> ShowS
show :: RuntimeRemoteObject -> String
$cshow :: RuntimeRemoteObject -> String
showsPrec :: Int -> RuntimeRemoteObject -> ShowS
$cshowsPrec :: Int -> RuntimeRemoteObject -> ShowS
Show)
instance FromJSON RuntimeRemoteObject where
  parseJSON :: Value -> Parser RuntimeRemoteObject
parseJSON = String
-> (Object -> Parser RuntimeRemoteObject)
-> Value
-> Parser RuntimeRemoteObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeRemoteObject" ((Object -> Parser RuntimeRemoteObject)
 -> Value -> Parser RuntimeRemoteObject)
-> (Object -> Parser RuntimeRemoteObject)
-> Value
-> Parser RuntimeRemoteObject
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObjectType
-> Maybe RuntimeRemoteObjectSubtype
-> Maybe Text
-> Maybe Value
-> Maybe Text
-> Maybe Text
-> Maybe RuntimeWebDriverValue
-> Maybe Text
-> Maybe RuntimeObjectPreview
-> Maybe RuntimeCustomPreview
-> RuntimeRemoteObject
RuntimeRemoteObject
    (RuntimeRemoteObjectType
 -> Maybe RuntimeRemoteObjectSubtype
 -> Maybe Text
 -> Maybe Value
 -> Maybe Text
 -> Maybe Text
 -> Maybe RuntimeWebDriverValue
 -> Maybe Text
 -> Maybe RuntimeObjectPreview
 -> Maybe RuntimeCustomPreview
 -> RuntimeRemoteObject)
-> Parser RuntimeRemoteObjectType
-> Parser
     (Maybe RuntimeRemoteObjectSubtype
      -> Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe RuntimeWebDriverValue
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObjectType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  (Maybe RuntimeRemoteObjectSubtype
   -> Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe RuntimeWebDriverValue
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe RuntimeRemoteObjectSubtype)
-> Parser
     (Maybe Text
      -> Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe RuntimeWebDriverValue
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObjectSubtype)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"subtype"
    Parser
  (Maybe Text
   -> Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe RuntimeWebDriverValue
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Value
      -> Maybe Text
      -> Maybe Text
      -> Maybe RuntimeWebDriverValue
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
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
"className"
    Parser
  (Maybe Value
   -> Maybe Text
   -> Maybe Text
   -> Maybe RuntimeWebDriverValue
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe Value)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe RuntimeWebDriverValue
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"value"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe RuntimeWebDriverValue
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe RuntimeWebDriverValue
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
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
"unserializableValue"
    Parser
  (Maybe Text
   -> Maybe RuntimeWebDriverValue
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe RuntimeWebDriverValue
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
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
"description"
    Parser
  (Maybe RuntimeWebDriverValue
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe RuntimeWebDriverValue)
-> Parser
     (Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview
      -> RuntimeRemoteObject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeWebDriverValue)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"webDriverValue"
    Parser
  (Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview
   -> RuntimeRemoteObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe RuntimeObjectPreview
      -> Maybe RuntimeCustomPreview -> RuntimeRemoteObject)
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
"objectId"
    Parser
  (Maybe RuntimeObjectPreview
   -> Maybe RuntimeCustomPreview -> RuntimeRemoteObject)
-> Parser (Maybe RuntimeObjectPreview)
-> Parser (Maybe RuntimeCustomPreview -> RuntimeRemoteObject)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeObjectPreview)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"preview"
    Parser (Maybe RuntimeCustomPreview -> RuntimeRemoteObject)
-> Parser (Maybe RuntimeCustomPreview)
-> Parser RuntimeRemoteObject
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeCustomPreview)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"customPreview"
instance ToJSON RuntimeRemoteObject where
  toJSON :: RuntimeRemoteObject -> Value
toJSON RuntimeRemoteObject
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
"type" Text -> RuntimeRemoteObjectType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObjectType -> Pair)
-> Maybe RuntimeRemoteObjectType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeRemoteObjectType -> Maybe RuntimeRemoteObjectType
forall a. a -> Maybe a
Just (RuntimeRemoteObject -> RuntimeRemoteObjectType
runtimeRemoteObjectType RuntimeRemoteObject
p),
    (Text
"subtype" Text -> RuntimeRemoteObjectSubtype -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObjectSubtype -> Pair)
-> Maybe RuntimeRemoteObjectSubtype -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeRemoteObject -> Maybe RuntimeRemoteObjectSubtype
runtimeRemoteObjectSubtype RuntimeRemoteObject
p),
    (Text
"className" 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
<$> (RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectClassName RuntimeRemoteObject
p),
    (Text
"value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeRemoteObject -> Maybe Value
runtimeRemoteObjectValue RuntimeRemoteObject
p),
    (Text
"unserializableValue" 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
<$> (RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectUnserializableValue RuntimeRemoteObject
p),
    (Text
"description" 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
<$> (RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectDescription RuntimeRemoteObject
p),
    (Text
"webDriverValue" Text -> RuntimeWebDriverValue -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeWebDriverValue -> Pair)
-> Maybe RuntimeWebDriverValue -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeRemoteObject -> Maybe RuntimeWebDriverValue
runtimeRemoteObjectWebDriverValue RuntimeRemoteObject
p),
    (Text
"objectId" 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
<$> (RuntimeRemoteObject -> Maybe Text
runtimeRemoteObjectObjectId RuntimeRemoteObject
p),
    (Text
"preview" Text -> RuntimeObjectPreview -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeObjectPreview -> Pair)
-> Maybe RuntimeObjectPreview -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeRemoteObject -> Maybe RuntimeObjectPreview
runtimeRemoteObjectPreview RuntimeRemoteObject
p),
    (Text
"customPreview" Text -> RuntimeCustomPreview -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeCustomPreview -> Pair)
-> Maybe RuntimeCustomPreview -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeRemoteObject -> Maybe RuntimeCustomPreview
runtimeRemoteObjectCustomPreview RuntimeRemoteObject
p)
    ]

-- | Type 'Runtime.CustomPreview'.
data RuntimeCustomPreview = RuntimeCustomPreview
  {
    -- | The JSON-stringified result of formatter.header(object, config) call.
    --   It contains json ML array that represents RemoteObject.
    RuntimeCustomPreview -> Text
runtimeCustomPreviewHeader :: T.Text,
    -- | If formatter returns true as a result of formatter.hasBody call then bodyGetterId will
    --   contain RemoteObjectId for the function that returns result of formatter.body(object, config) call.
    --   The result value is json ML array.
    RuntimeCustomPreview -> Maybe Text
runtimeCustomPreviewBodyGetterId :: Maybe RuntimeRemoteObjectId
  }
  deriving (RuntimeCustomPreview -> RuntimeCustomPreview -> Bool
(RuntimeCustomPreview -> RuntimeCustomPreview -> Bool)
-> (RuntimeCustomPreview -> RuntimeCustomPreview -> Bool)
-> Eq RuntimeCustomPreview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCustomPreview -> RuntimeCustomPreview -> Bool
$c/= :: RuntimeCustomPreview -> RuntimeCustomPreview -> Bool
== :: RuntimeCustomPreview -> RuntimeCustomPreview -> Bool
$c== :: RuntimeCustomPreview -> RuntimeCustomPreview -> Bool
Eq, Int -> RuntimeCustomPreview -> ShowS
[RuntimeCustomPreview] -> ShowS
RuntimeCustomPreview -> String
(Int -> RuntimeCustomPreview -> ShowS)
-> (RuntimeCustomPreview -> String)
-> ([RuntimeCustomPreview] -> ShowS)
-> Show RuntimeCustomPreview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCustomPreview] -> ShowS
$cshowList :: [RuntimeCustomPreview] -> ShowS
show :: RuntimeCustomPreview -> String
$cshow :: RuntimeCustomPreview -> String
showsPrec :: Int -> RuntimeCustomPreview -> ShowS
$cshowsPrec :: Int -> RuntimeCustomPreview -> ShowS
Show)
instance FromJSON RuntimeCustomPreview where
  parseJSON :: Value -> Parser RuntimeCustomPreview
parseJSON = String
-> (Object -> Parser RuntimeCustomPreview)
-> Value
-> Parser RuntimeCustomPreview
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeCustomPreview" ((Object -> Parser RuntimeCustomPreview)
 -> Value -> Parser RuntimeCustomPreview)
-> (Object -> Parser RuntimeCustomPreview)
-> Value
-> Parser RuntimeCustomPreview
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe Text -> RuntimeCustomPreview
RuntimeCustomPreview
    (Text -> Maybe Text -> RuntimeCustomPreview)
-> Parser Text -> Parser (Maybe Text -> RuntimeCustomPreview)
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
"header"
    Parser (Maybe Text -> RuntimeCustomPreview)
-> Parser (Maybe Text) -> Parser RuntimeCustomPreview
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
"bodyGetterId"
instance ToJSON RuntimeCustomPreview where
  toJSON :: RuntimeCustomPreview -> Value
toJSON RuntimeCustomPreview
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
"header" 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 (RuntimeCustomPreview -> Text
runtimeCustomPreviewHeader RuntimeCustomPreview
p),
    (Text
"bodyGetterId" 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
<$> (RuntimeCustomPreview -> Maybe Text
runtimeCustomPreviewBodyGetterId RuntimeCustomPreview
p)
    ]

-- | Type 'Runtime.ObjectPreview'.
--   Object containing abbreviated remote object value.
data RuntimeObjectPreviewType = RuntimeObjectPreviewTypeObject | RuntimeObjectPreviewTypeFunction | RuntimeObjectPreviewTypeUndefined | RuntimeObjectPreviewTypeString | RuntimeObjectPreviewTypeNumber | RuntimeObjectPreviewTypeBoolean | RuntimeObjectPreviewTypeSymbol | RuntimeObjectPreviewTypeBigint
  deriving (Eq RuntimeObjectPreviewType
Eq RuntimeObjectPreviewType
-> (RuntimeObjectPreviewType
    -> RuntimeObjectPreviewType -> Ordering)
-> (RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool)
-> (RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool)
-> (RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool)
-> (RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool)
-> (RuntimeObjectPreviewType
    -> RuntimeObjectPreviewType -> RuntimeObjectPreviewType)
-> (RuntimeObjectPreviewType
    -> RuntimeObjectPreviewType -> RuntimeObjectPreviewType)
-> Ord RuntimeObjectPreviewType
RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Ordering
RuntimeObjectPreviewType
-> RuntimeObjectPreviewType -> RuntimeObjectPreviewType
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 :: RuntimeObjectPreviewType
-> RuntimeObjectPreviewType -> RuntimeObjectPreviewType
$cmin :: RuntimeObjectPreviewType
-> RuntimeObjectPreviewType -> RuntimeObjectPreviewType
max :: RuntimeObjectPreviewType
-> RuntimeObjectPreviewType -> RuntimeObjectPreviewType
$cmax :: RuntimeObjectPreviewType
-> RuntimeObjectPreviewType -> RuntimeObjectPreviewType
>= :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
$c>= :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
> :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
$c> :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
<= :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
$c<= :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
< :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
$c< :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
compare :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Ordering
$ccompare :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Ordering
$cp1Ord :: Eq RuntimeObjectPreviewType
Ord, RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
(RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool)
-> (RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool)
-> Eq RuntimeObjectPreviewType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
$c/= :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
== :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
$c== :: RuntimeObjectPreviewType -> RuntimeObjectPreviewType -> Bool
Eq, Int -> RuntimeObjectPreviewType -> ShowS
[RuntimeObjectPreviewType] -> ShowS
RuntimeObjectPreviewType -> String
(Int -> RuntimeObjectPreviewType -> ShowS)
-> (RuntimeObjectPreviewType -> String)
-> ([RuntimeObjectPreviewType] -> ShowS)
-> Show RuntimeObjectPreviewType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeObjectPreviewType] -> ShowS
$cshowList :: [RuntimeObjectPreviewType] -> ShowS
show :: RuntimeObjectPreviewType -> String
$cshow :: RuntimeObjectPreviewType -> String
showsPrec :: Int -> RuntimeObjectPreviewType -> ShowS
$cshowsPrec :: Int -> RuntimeObjectPreviewType -> ShowS
Show, ReadPrec [RuntimeObjectPreviewType]
ReadPrec RuntimeObjectPreviewType
Int -> ReadS RuntimeObjectPreviewType
ReadS [RuntimeObjectPreviewType]
(Int -> ReadS RuntimeObjectPreviewType)
-> ReadS [RuntimeObjectPreviewType]
-> ReadPrec RuntimeObjectPreviewType
-> ReadPrec [RuntimeObjectPreviewType]
-> Read RuntimeObjectPreviewType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimeObjectPreviewType]
$creadListPrec :: ReadPrec [RuntimeObjectPreviewType]
readPrec :: ReadPrec RuntimeObjectPreviewType
$creadPrec :: ReadPrec RuntimeObjectPreviewType
readList :: ReadS [RuntimeObjectPreviewType]
$creadList :: ReadS [RuntimeObjectPreviewType]
readsPrec :: Int -> ReadS RuntimeObjectPreviewType
$creadsPrec :: Int -> ReadS RuntimeObjectPreviewType
Read)
instance FromJSON RuntimeObjectPreviewType where
  parseJSON :: Value -> Parser RuntimeObjectPreviewType
parseJSON = String
-> (Text -> Parser RuntimeObjectPreviewType)
-> Value
-> Parser RuntimeObjectPreviewType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimeObjectPreviewType" ((Text -> Parser RuntimeObjectPreviewType)
 -> Value -> Parser RuntimeObjectPreviewType)
-> (Text -> Parser RuntimeObjectPreviewType)
-> Value
-> Parser RuntimeObjectPreviewType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"object" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeObject
    Text
"function" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeFunction
    Text
"undefined" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeUndefined
    Text
"string" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeString
    Text
"number" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeNumber
    Text
"boolean" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeBoolean
    Text
"symbol" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeSymbol
    Text
"bigint" -> RuntimeObjectPreviewType -> Parser RuntimeObjectPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewType
RuntimeObjectPreviewTypeBigint
    Text
"_" -> String -> Parser RuntimeObjectPreviewType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimeObjectPreviewType"
instance ToJSON RuntimeObjectPreviewType where
  toJSON :: RuntimeObjectPreviewType -> Value
toJSON RuntimeObjectPreviewType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimeObjectPreviewType
v of
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeObject -> Text
"object"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeFunction -> Text
"function"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeUndefined -> Text
"undefined"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeString -> Text
"string"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeNumber -> Text
"number"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeBoolean -> Text
"boolean"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeSymbol -> Text
"symbol"
    RuntimeObjectPreviewType
RuntimeObjectPreviewTypeBigint -> Text
"bigint"
data RuntimeObjectPreviewSubtype = RuntimeObjectPreviewSubtypeArray | RuntimeObjectPreviewSubtypeNull | RuntimeObjectPreviewSubtypeNode | RuntimeObjectPreviewSubtypeRegexp | RuntimeObjectPreviewSubtypeDate | RuntimeObjectPreviewSubtypeMap | RuntimeObjectPreviewSubtypeSet | RuntimeObjectPreviewSubtypeWeakmap | RuntimeObjectPreviewSubtypeWeakset | RuntimeObjectPreviewSubtypeIterator | RuntimeObjectPreviewSubtypeGenerator | RuntimeObjectPreviewSubtypeError | RuntimeObjectPreviewSubtypeProxy | RuntimeObjectPreviewSubtypePromise | RuntimeObjectPreviewSubtypeTypedarray | RuntimeObjectPreviewSubtypeArraybuffer | RuntimeObjectPreviewSubtypeDataview | RuntimeObjectPreviewSubtypeWebassemblymemory | RuntimeObjectPreviewSubtypeWasmvalue
  deriving (Eq RuntimeObjectPreviewSubtype
Eq RuntimeObjectPreviewSubtype
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> Ordering)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> Bool)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> Bool)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> Bool)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> Bool)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype)
-> Ord RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> Ordering
RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype
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 :: RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype
$cmin :: RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype
max :: RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype
$cmax :: RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype
>= :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
$c>= :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
> :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
$c> :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
<= :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
$c<= :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
< :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
$c< :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
compare :: RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> Ordering
$ccompare :: RuntimeObjectPreviewSubtype
-> RuntimeObjectPreviewSubtype -> Ordering
$cp1Ord :: Eq RuntimeObjectPreviewSubtype
Ord, RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
(RuntimeObjectPreviewSubtype
 -> RuntimeObjectPreviewSubtype -> Bool)
-> (RuntimeObjectPreviewSubtype
    -> RuntimeObjectPreviewSubtype -> Bool)
-> Eq RuntimeObjectPreviewSubtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
$c/= :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
== :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
$c== :: RuntimeObjectPreviewSubtype -> RuntimeObjectPreviewSubtype -> Bool
Eq, Int -> RuntimeObjectPreviewSubtype -> ShowS
[RuntimeObjectPreviewSubtype] -> ShowS
RuntimeObjectPreviewSubtype -> String
(Int -> RuntimeObjectPreviewSubtype -> ShowS)
-> (RuntimeObjectPreviewSubtype -> String)
-> ([RuntimeObjectPreviewSubtype] -> ShowS)
-> Show RuntimeObjectPreviewSubtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeObjectPreviewSubtype] -> ShowS
$cshowList :: [RuntimeObjectPreviewSubtype] -> ShowS
show :: RuntimeObjectPreviewSubtype -> String
$cshow :: RuntimeObjectPreviewSubtype -> String
showsPrec :: Int -> RuntimeObjectPreviewSubtype -> ShowS
$cshowsPrec :: Int -> RuntimeObjectPreviewSubtype -> ShowS
Show, ReadPrec [RuntimeObjectPreviewSubtype]
ReadPrec RuntimeObjectPreviewSubtype
Int -> ReadS RuntimeObjectPreviewSubtype
ReadS [RuntimeObjectPreviewSubtype]
(Int -> ReadS RuntimeObjectPreviewSubtype)
-> ReadS [RuntimeObjectPreviewSubtype]
-> ReadPrec RuntimeObjectPreviewSubtype
-> ReadPrec [RuntimeObjectPreviewSubtype]
-> Read RuntimeObjectPreviewSubtype
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimeObjectPreviewSubtype]
$creadListPrec :: ReadPrec [RuntimeObjectPreviewSubtype]
readPrec :: ReadPrec RuntimeObjectPreviewSubtype
$creadPrec :: ReadPrec RuntimeObjectPreviewSubtype
readList :: ReadS [RuntimeObjectPreviewSubtype]
$creadList :: ReadS [RuntimeObjectPreviewSubtype]
readsPrec :: Int -> ReadS RuntimeObjectPreviewSubtype
$creadsPrec :: Int -> ReadS RuntimeObjectPreviewSubtype
Read)
instance FromJSON RuntimeObjectPreviewSubtype where
  parseJSON :: Value -> Parser RuntimeObjectPreviewSubtype
parseJSON = String
-> (Text -> Parser RuntimeObjectPreviewSubtype)
-> Value
-> Parser RuntimeObjectPreviewSubtype
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimeObjectPreviewSubtype" ((Text -> Parser RuntimeObjectPreviewSubtype)
 -> Value -> Parser RuntimeObjectPreviewSubtype)
-> (Text -> Parser RuntimeObjectPreviewSubtype)
-> Value
-> Parser RuntimeObjectPreviewSubtype
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"array" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeArray
    Text
"null" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeNull
    Text
"node" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeNode
    Text
"regexp" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeRegexp
    Text
"date" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeDate
    Text
"map" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeMap
    Text
"set" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeSet
    Text
"weakmap" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWeakmap
    Text
"weakset" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWeakset
    Text
"iterator" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeIterator
    Text
"generator" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeGenerator
    Text
"error" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeError
    Text
"proxy" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeProxy
    Text
"promise" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypePromise
    Text
"typedarray" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeTypedarray
    Text
"arraybuffer" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeArraybuffer
    Text
"dataview" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeDataview
    Text
"webassemblymemory" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWebassemblymemory
    Text
"wasmvalue" -> RuntimeObjectPreviewSubtype -> Parser RuntimeObjectPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWasmvalue
    Text
"_" -> String -> Parser RuntimeObjectPreviewSubtype
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimeObjectPreviewSubtype"
instance ToJSON RuntimeObjectPreviewSubtype where
  toJSON :: RuntimeObjectPreviewSubtype -> Value
toJSON RuntimeObjectPreviewSubtype
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimeObjectPreviewSubtype
v of
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeArray -> Text
"array"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeNull -> Text
"null"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeNode -> Text
"node"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeRegexp -> Text
"regexp"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeDate -> Text
"date"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeMap -> Text
"map"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeSet -> Text
"set"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWeakmap -> Text
"weakmap"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWeakset -> Text
"weakset"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeIterator -> Text
"iterator"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeGenerator -> Text
"generator"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeError -> Text
"error"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeProxy -> Text
"proxy"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypePromise -> Text
"promise"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeTypedarray -> Text
"typedarray"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeArraybuffer -> Text
"arraybuffer"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeDataview -> Text
"dataview"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWebassemblymemory -> Text
"webassemblymemory"
    RuntimeObjectPreviewSubtype
RuntimeObjectPreviewSubtypeWasmvalue -> Text
"wasmvalue"
data RuntimeObjectPreview = RuntimeObjectPreview
  {
    -- | Object type.
    RuntimeObjectPreview -> RuntimeObjectPreviewType
runtimeObjectPreviewType :: RuntimeObjectPreviewType,
    -- | Object subtype hint. Specified for `object` type values only.
    RuntimeObjectPreview -> Maybe RuntimeObjectPreviewSubtype
runtimeObjectPreviewSubtype :: Maybe RuntimeObjectPreviewSubtype,
    -- | String representation of the object.
    RuntimeObjectPreview -> Maybe Text
runtimeObjectPreviewDescription :: Maybe T.Text,
    -- | True iff some of the properties or entries of the original object did not fit.
    RuntimeObjectPreview -> Bool
runtimeObjectPreviewOverflow :: Bool,
    -- | List of the properties.
    RuntimeObjectPreview -> [RuntimePropertyPreview]
runtimeObjectPreviewProperties :: [RuntimePropertyPreview],
    -- | List of the entries. Specified for `map` and `set` subtype values only.
    RuntimeObjectPreview -> Maybe [RuntimeEntryPreview]
runtimeObjectPreviewEntries :: Maybe [RuntimeEntryPreview]
  }
  deriving (RuntimeObjectPreview -> RuntimeObjectPreview -> Bool
(RuntimeObjectPreview -> RuntimeObjectPreview -> Bool)
-> (RuntimeObjectPreview -> RuntimeObjectPreview -> Bool)
-> Eq RuntimeObjectPreview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeObjectPreview -> RuntimeObjectPreview -> Bool
$c/= :: RuntimeObjectPreview -> RuntimeObjectPreview -> Bool
== :: RuntimeObjectPreview -> RuntimeObjectPreview -> Bool
$c== :: RuntimeObjectPreview -> RuntimeObjectPreview -> Bool
Eq, Int -> RuntimeObjectPreview -> ShowS
[RuntimeObjectPreview] -> ShowS
RuntimeObjectPreview -> String
(Int -> RuntimeObjectPreview -> ShowS)
-> (RuntimeObjectPreview -> String)
-> ([RuntimeObjectPreview] -> ShowS)
-> Show RuntimeObjectPreview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeObjectPreview] -> ShowS
$cshowList :: [RuntimeObjectPreview] -> ShowS
show :: RuntimeObjectPreview -> String
$cshow :: RuntimeObjectPreview -> String
showsPrec :: Int -> RuntimeObjectPreview -> ShowS
$cshowsPrec :: Int -> RuntimeObjectPreview -> ShowS
Show)
instance FromJSON RuntimeObjectPreview where
  parseJSON :: Value -> Parser RuntimeObjectPreview
parseJSON = String
-> (Object -> Parser RuntimeObjectPreview)
-> Value
-> Parser RuntimeObjectPreview
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeObjectPreview" ((Object -> Parser RuntimeObjectPreview)
 -> Value -> Parser RuntimeObjectPreview)
-> (Object -> Parser RuntimeObjectPreview)
-> Value
-> Parser RuntimeObjectPreview
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeObjectPreviewType
-> Maybe RuntimeObjectPreviewSubtype
-> Maybe Text
-> Bool
-> [RuntimePropertyPreview]
-> Maybe [RuntimeEntryPreview]
-> RuntimeObjectPreview
RuntimeObjectPreview
    (RuntimeObjectPreviewType
 -> Maybe RuntimeObjectPreviewSubtype
 -> Maybe Text
 -> Bool
 -> [RuntimePropertyPreview]
 -> Maybe [RuntimeEntryPreview]
 -> RuntimeObjectPreview)
-> Parser RuntimeObjectPreviewType
-> Parser
     (Maybe RuntimeObjectPreviewSubtype
      -> Maybe Text
      -> Bool
      -> [RuntimePropertyPreview]
      -> Maybe [RuntimeEntryPreview]
      -> RuntimeObjectPreview)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeObjectPreviewType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  (Maybe RuntimeObjectPreviewSubtype
   -> Maybe Text
   -> Bool
   -> [RuntimePropertyPreview]
   -> Maybe [RuntimeEntryPreview]
   -> RuntimeObjectPreview)
-> Parser (Maybe RuntimeObjectPreviewSubtype)
-> Parser
     (Maybe Text
      -> Bool
      -> [RuntimePropertyPreview]
      -> Maybe [RuntimeEntryPreview]
      -> RuntimeObjectPreview)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeObjectPreviewSubtype)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"subtype"
    Parser
  (Maybe Text
   -> Bool
   -> [RuntimePropertyPreview]
   -> Maybe [RuntimeEntryPreview]
   -> RuntimeObjectPreview)
-> Parser (Maybe Text)
-> Parser
     (Bool
      -> [RuntimePropertyPreview]
      -> Maybe [RuntimeEntryPreview]
      -> RuntimeObjectPreview)
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
"description"
    Parser
  (Bool
   -> [RuntimePropertyPreview]
   -> Maybe [RuntimeEntryPreview]
   -> RuntimeObjectPreview)
-> Parser Bool
-> Parser
     ([RuntimePropertyPreview]
      -> Maybe [RuntimeEntryPreview] -> RuntimeObjectPreview)
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
"overflow"
    Parser
  ([RuntimePropertyPreview]
   -> Maybe [RuntimeEntryPreview] -> RuntimeObjectPreview)
-> Parser [RuntimePropertyPreview]
-> Parser (Maybe [RuntimeEntryPreview] -> RuntimeObjectPreview)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [RuntimePropertyPreview]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"properties"
    Parser (Maybe [RuntimeEntryPreview] -> RuntimeObjectPreview)
-> Parser (Maybe [RuntimeEntryPreview])
-> Parser RuntimeObjectPreview
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [RuntimeEntryPreview])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"entries"
instance ToJSON RuntimeObjectPreview where
  toJSON :: RuntimeObjectPreview -> Value
toJSON RuntimeObjectPreview
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
"type" Text -> RuntimeObjectPreviewType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeObjectPreviewType -> Pair)
-> Maybe RuntimeObjectPreviewType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeObjectPreviewType -> Maybe RuntimeObjectPreviewType
forall a. a -> Maybe a
Just (RuntimeObjectPreview -> RuntimeObjectPreviewType
runtimeObjectPreviewType RuntimeObjectPreview
p),
    (Text
"subtype" Text -> RuntimeObjectPreviewSubtype -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeObjectPreviewSubtype -> Pair)
-> Maybe RuntimeObjectPreviewSubtype -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeObjectPreview -> Maybe RuntimeObjectPreviewSubtype
runtimeObjectPreviewSubtype RuntimeObjectPreview
p),
    (Text
"description" 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
<$> (RuntimeObjectPreview -> Maybe Text
runtimeObjectPreviewDescription RuntimeObjectPreview
p),
    (Text
"overflow" 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 (RuntimeObjectPreview -> Bool
runtimeObjectPreviewOverflow RuntimeObjectPreview
p),
    (Text
"properties" Text -> [RuntimePropertyPreview] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([RuntimePropertyPreview] -> Pair)
-> Maybe [RuntimePropertyPreview] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RuntimePropertyPreview] -> Maybe [RuntimePropertyPreview]
forall a. a -> Maybe a
Just (RuntimeObjectPreview -> [RuntimePropertyPreview]
runtimeObjectPreviewProperties RuntimeObjectPreview
p),
    (Text
"entries" Text -> [RuntimeEntryPreview] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([RuntimeEntryPreview] -> Pair)
-> Maybe [RuntimeEntryPreview] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeObjectPreview -> Maybe [RuntimeEntryPreview]
runtimeObjectPreviewEntries RuntimeObjectPreview
p)
    ]

-- | Type 'Runtime.PropertyPreview'.
data RuntimePropertyPreviewType = RuntimePropertyPreviewTypeObject | RuntimePropertyPreviewTypeFunction | RuntimePropertyPreviewTypeUndefined | RuntimePropertyPreviewTypeString | RuntimePropertyPreviewTypeNumber | RuntimePropertyPreviewTypeBoolean | RuntimePropertyPreviewTypeSymbol | RuntimePropertyPreviewTypeAccessor | RuntimePropertyPreviewTypeBigint
  deriving (Eq RuntimePropertyPreviewType
Eq RuntimePropertyPreviewType
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> Ordering)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> Bool)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> Bool)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> Bool)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> Bool)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> RuntimePropertyPreviewType)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> RuntimePropertyPreviewType)
-> Ord RuntimePropertyPreviewType
RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> Ordering
RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> RuntimePropertyPreviewType
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 :: RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> RuntimePropertyPreviewType
$cmin :: RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> RuntimePropertyPreviewType
max :: RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> RuntimePropertyPreviewType
$cmax :: RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> RuntimePropertyPreviewType
>= :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
$c>= :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
> :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
$c> :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
<= :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
$c<= :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
< :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
$c< :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
compare :: RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> Ordering
$ccompare :: RuntimePropertyPreviewType
-> RuntimePropertyPreviewType -> Ordering
$cp1Ord :: Eq RuntimePropertyPreviewType
Ord, RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
(RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool)
-> (RuntimePropertyPreviewType
    -> RuntimePropertyPreviewType -> Bool)
-> Eq RuntimePropertyPreviewType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
$c/= :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
== :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
$c== :: RuntimePropertyPreviewType -> RuntimePropertyPreviewType -> Bool
Eq, Int -> RuntimePropertyPreviewType -> ShowS
[RuntimePropertyPreviewType] -> ShowS
RuntimePropertyPreviewType -> String
(Int -> RuntimePropertyPreviewType -> ShowS)
-> (RuntimePropertyPreviewType -> String)
-> ([RuntimePropertyPreviewType] -> ShowS)
-> Show RuntimePropertyPreviewType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimePropertyPreviewType] -> ShowS
$cshowList :: [RuntimePropertyPreviewType] -> ShowS
show :: RuntimePropertyPreviewType -> String
$cshow :: RuntimePropertyPreviewType -> String
showsPrec :: Int -> RuntimePropertyPreviewType -> ShowS
$cshowsPrec :: Int -> RuntimePropertyPreviewType -> ShowS
Show, ReadPrec [RuntimePropertyPreviewType]
ReadPrec RuntimePropertyPreviewType
Int -> ReadS RuntimePropertyPreviewType
ReadS [RuntimePropertyPreviewType]
(Int -> ReadS RuntimePropertyPreviewType)
-> ReadS [RuntimePropertyPreviewType]
-> ReadPrec RuntimePropertyPreviewType
-> ReadPrec [RuntimePropertyPreviewType]
-> Read RuntimePropertyPreviewType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimePropertyPreviewType]
$creadListPrec :: ReadPrec [RuntimePropertyPreviewType]
readPrec :: ReadPrec RuntimePropertyPreviewType
$creadPrec :: ReadPrec RuntimePropertyPreviewType
readList :: ReadS [RuntimePropertyPreviewType]
$creadList :: ReadS [RuntimePropertyPreviewType]
readsPrec :: Int -> ReadS RuntimePropertyPreviewType
$creadsPrec :: Int -> ReadS RuntimePropertyPreviewType
Read)
instance FromJSON RuntimePropertyPreviewType where
  parseJSON :: Value -> Parser RuntimePropertyPreviewType
parseJSON = String
-> (Text -> Parser RuntimePropertyPreviewType)
-> Value
-> Parser RuntimePropertyPreviewType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimePropertyPreviewType" ((Text -> Parser RuntimePropertyPreviewType)
 -> Value -> Parser RuntimePropertyPreviewType)
-> (Text -> Parser RuntimePropertyPreviewType)
-> Value
-> Parser RuntimePropertyPreviewType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"object" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeObject
    Text
"function" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeFunction
    Text
"undefined" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeUndefined
    Text
"string" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeString
    Text
"number" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeNumber
    Text
"boolean" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeBoolean
    Text
"symbol" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeSymbol
    Text
"accessor" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeAccessor
    Text
"bigint" -> RuntimePropertyPreviewType -> Parser RuntimePropertyPreviewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewType
RuntimePropertyPreviewTypeBigint
    Text
"_" -> String -> Parser RuntimePropertyPreviewType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimePropertyPreviewType"
instance ToJSON RuntimePropertyPreviewType where
  toJSON :: RuntimePropertyPreviewType -> Value
toJSON RuntimePropertyPreviewType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimePropertyPreviewType
v of
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeObject -> Text
"object"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeFunction -> Text
"function"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeUndefined -> Text
"undefined"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeString -> Text
"string"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeNumber -> Text
"number"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeBoolean -> Text
"boolean"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeSymbol -> Text
"symbol"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeAccessor -> Text
"accessor"
    RuntimePropertyPreviewType
RuntimePropertyPreviewTypeBigint -> Text
"bigint"
data RuntimePropertyPreviewSubtype = RuntimePropertyPreviewSubtypeArray | RuntimePropertyPreviewSubtypeNull | RuntimePropertyPreviewSubtypeNode | RuntimePropertyPreviewSubtypeRegexp | RuntimePropertyPreviewSubtypeDate | RuntimePropertyPreviewSubtypeMap | RuntimePropertyPreviewSubtypeSet | RuntimePropertyPreviewSubtypeWeakmap | RuntimePropertyPreviewSubtypeWeakset | RuntimePropertyPreviewSubtypeIterator | RuntimePropertyPreviewSubtypeGenerator | RuntimePropertyPreviewSubtypeError | RuntimePropertyPreviewSubtypeProxy | RuntimePropertyPreviewSubtypePromise | RuntimePropertyPreviewSubtypeTypedarray | RuntimePropertyPreviewSubtypeArraybuffer | RuntimePropertyPreviewSubtypeDataview | RuntimePropertyPreviewSubtypeWebassemblymemory | RuntimePropertyPreviewSubtypeWasmvalue
  deriving (Eq RuntimePropertyPreviewSubtype
Eq RuntimePropertyPreviewSubtype
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> Ordering)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> Bool)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> Bool)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> Bool)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> Bool)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype)
-> Ord RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Ordering
RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype
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 :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype
$cmin :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype
max :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype
$cmax :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> RuntimePropertyPreviewSubtype
>= :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
$c>= :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
> :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
$c> :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
<= :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
$c<= :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
< :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
$c< :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
compare :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Ordering
$ccompare :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Ordering
$cp1Ord :: Eq RuntimePropertyPreviewSubtype
Ord, RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
(RuntimePropertyPreviewSubtype
 -> RuntimePropertyPreviewSubtype -> Bool)
-> (RuntimePropertyPreviewSubtype
    -> RuntimePropertyPreviewSubtype -> Bool)
-> Eq RuntimePropertyPreviewSubtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
$c/= :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
== :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
$c== :: RuntimePropertyPreviewSubtype
-> RuntimePropertyPreviewSubtype -> Bool
Eq, Int -> RuntimePropertyPreviewSubtype -> ShowS
[RuntimePropertyPreviewSubtype] -> ShowS
RuntimePropertyPreviewSubtype -> String
(Int -> RuntimePropertyPreviewSubtype -> ShowS)
-> (RuntimePropertyPreviewSubtype -> String)
-> ([RuntimePropertyPreviewSubtype] -> ShowS)
-> Show RuntimePropertyPreviewSubtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimePropertyPreviewSubtype] -> ShowS
$cshowList :: [RuntimePropertyPreviewSubtype] -> ShowS
show :: RuntimePropertyPreviewSubtype -> String
$cshow :: RuntimePropertyPreviewSubtype -> String
showsPrec :: Int -> RuntimePropertyPreviewSubtype -> ShowS
$cshowsPrec :: Int -> RuntimePropertyPreviewSubtype -> ShowS
Show, ReadPrec [RuntimePropertyPreviewSubtype]
ReadPrec RuntimePropertyPreviewSubtype
Int -> ReadS RuntimePropertyPreviewSubtype
ReadS [RuntimePropertyPreviewSubtype]
(Int -> ReadS RuntimePropertyPreviewSubtype)
-> ReadS [RuntimePropertyPreviewSubtype]
-> ReadPrec RuntimePropertyPreviewSubtype
-> ReadPrec [RuntimePropertyPreviewSubtype]
-> Read RuntimePropertyPreviewSubtype
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimePropertyPreviewSubtype]
$creadListPrec :: ReadPrec [RuntimePropertyPreviewSubtype]
readPrec :: ReadPrec RuntimePropertyPreviewSubtype
$creadPrec :: ReadPrec RuntimePropertyPreviewSubtype
readList :: ReadS [RuntimePropertyPreviewSubtype]
$creadList :: ReadS [RuntimePropertyPreviewSubtype]
readsPrec :: Int -> ReadS RuntimePropertyPreviewSubtype
$creadsPrec :: Int -> ReadS RuntimePropertyPreviewSubtype
Read)
instance FromJSON RuntimePropertyPreviewSubtype where
  parseJSON :: Value -> Parser RuntimePropertyPreviewSubtype
parseJSON = String
-> (Text -> Parser RuntimePropertyPreviewSubtype)
-> Value
-> Parser RuntimePropertyPreviewSubtype
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimePropertyPreviewSubtype" ((Text -> Parser RuntimePropertyPreviewSubtype)
 -> Value -> Parser RuntimePropertyPreviewSubtype)
-> (Text -> Parser RuntimePropertyPreviewSubtype)
-> Value
-> Parser RuntimePropertyPreviewSubtype
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"array" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeArray
    Text
"null" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeNull
    Text
"node" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeNode
    Text
"regexp" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeRegexp
    Text
"date" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeDate
    Text
"map" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeMap
    Text
"set" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeSet
    Text
"weakmap" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWeakmap
    Text
"weakset" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWeakset
    Text
"iterator" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeIterator
    Text
"generator" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeGenerator
    Text
"error" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeError
    Text
"proxy" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeProxy
    Text
"promise" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypePromise
    Text
"typedarray" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeTypedarray
    Text
"arraybuffer" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeArraybuffer
    Text
"dataview" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeDataview
    Text
"webassemblymemory" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWebassemblymemory
    Text
"wasmvalue" -> RuntimePropertyPreviewSubtype
-> Parser RuntimePropertyPreviewSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWasmvalue
    Text
"_" -> String -> Parser RuntimePropertyPreviewSubtype
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimePropertyPreviewSubtype"
instance ToJSON RuntimePropertyPreviewSubtype where
  toJSON :: RuntimePropertyPreviewSubtype -> Value
toJSON RuntimePropertyPreviewSubtype
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimePropertyPreviewSubtype
v of
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeArray -> Text
"array"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeNull -> Text
"null"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeNode -> Text
"node"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeRegexp -> Text
"regexp"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeDate -> Text
"date"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeMap -> Text
"map"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeSet -> Text
"set"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWeakmap -> Text
"weakmap"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWeakset -> Text
"weakset"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeIterator -> Text
"iterator"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeGenerator -> Text
"generator"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeError -> Text
"error"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeProxy -> Text
"proxy"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypePromise -> Text
"promise"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeTypedarray -> Text
"typedarray"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeArraybuffer -> Text
"arraybuffer"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeDataview -> Text
"dataview"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWebassemblymemory -> Text
"webassemblymemory"
    RuntimePropertyPreviewSubtype
RuntimePropertyPreviewSubtypeWasmvalue -> Text
"wasmvalue"
data RuntimePropertyPreview = RuntimePropertyPreview
  {
    -- | Property name.
    RuntimePropertyPreview -> Text
runtimePropertyPreviewName :: T.Text,
    -- | Object type. Accessor means that the property itself is an accessor property.
    RuntimePropertyPreview -> RuntimePropertyPreviewType
runtimePropertyPreviewType :: RuntimePropertyPreviewType,
    -- | User-friendly property value string.
    RuntimePropertyPreview -> Maybe Text
runtimePropertyPreviewValue :: Maybe T.Text,
    -- | Nested value preview.
    RuntimePropertyPreview -> Maybe RuntimeObjectPreview
runtimePropertyPreviewValuePreview :: Maybe RuntimeObjectPreview,
    -- | Object subtype hint. Specified for `object` type values only.
    RuntimePropertyPreview -> Maybe RuntimePropertyPreviewSubtype
runtimePropertyPreviewSubtype :: Maybe RuntimePropertyPreviewSubtype
  }
  deriving (RuntimePropertyPreview -> RuntimePropertyPreview -> Bool
(RuntimePropertyPreview -> RuntimePropertyPreview -> Bool)
-> (RuntimePropertyPreview -> RuntimePropertyPreview -> Bool)
-> Eq RuntimePropertyPreview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimePropertyPreview -> RuntimePropertyPreview -> Bool
$c/= :: RuntimePropertyPreview -> RuntimePropertyPreview -> Bool
== :: RuntimePropertyPreview -> RuntimePropertyPreview -> Bool
$c== :: RuntimePropertyPreview -> RuntimePropertyPreview -> Bool
Eq, Int -> RuntimePropertyPreview -> ShowS
[RuntimePropertyPreview] -> ShowS
RuntimePropertyPreview -> String
(Int -> RuntimePropertyPreview -> ShowS)
-> (RuntimePropertyPreview -> String)
-> ([RuntimePropertyPreview] -> ShowS)
-> Show RuntimePropertyPreview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimePropertyPreview] -> ShowS
$cshowList :: [RuntimePropertyPreview] -> ShowS
show :: RuntimePropertyPreview -> String
$cshow :: RuntimePropertyPreview -> String
showsPrec :: Int -> RuntimePropertyPreview -> ShowS
$cshowsPrec :: Int -> RuntimePropertyPreview -> ShowS
Show)
instance FromJSON RuntimePropertyPreview where
  parseJSON :: Value -> Parser RuntimePropertyPreview
parseJSON = String
-> (Object -> Parser RuntimePropertyPreview)
-> Value
-> Parser RuntimePropertyPreview
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimePropertyPreview" ((Object -> Parser RuntimePropertyPreview)
 -> Value -> Parser RuntimePropertyPreview)
-> (Object -> Parser RuntimePropertyPreview)
-> Value
-> Parser RuntimePropertyPreview
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> RuntimePropertyPreviewType
-> Maybe Text
-> Maybe RuntimeObjectPreview
-> Maybe RuntimePropertyPreviewSubtype
-> RuntimePropertyPreview
RuntimePropertyPreview
    (Text
 -> RuntimePropertyPreviewType
 -> Maybe Text
 -> Maybe RuntimeObjectPreview
 -> Maybe RuntimePropertyPreviewSubtype
 -> RuntimePropertyPreview)
-> Parser Text
-> Parser
     (RuntimePropertyPreviewType
      -> Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimePropertyPreviewSubtype
      -> RuntimePropertyPreview)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (RuntimePropertyPreviewType
   -> Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimePropertyPreviewSubtype
   -> RuntimePropertyPreview)
-> Parser RuntimePropertyPreviewType
-> Parser
     (Maybe Text
      -> Maybe RuntimeObjectPreview
      -> Maybe RuntimePropertyPreviewSubtype
      -> RuntimePropertyPreview)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimePropertyPreviewType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  (Maybe Text
   -> Maybe RuntimeObjectPreview
   -> Maybe RuntimePropertyPreviewSubtype
   -> RuntimePropertyPreview)
-> Parser (Maybe Text)
-> Parser
     (Maybe RuntimeObjectPreview
      -> Maybe RuntimePropertyPreviewSubtype -> RuntimePropertyPreview)
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
"value"
    Parser
  (Maybe RuntimeObjectPreview
   -> Maybe RuntimePropertyPreviewSubtype -> RuntimePropertyPreview)
-> Parser (Maybe RuntimeObjectPreview)
-> Parser
     (Maybe RuntimePropertyPreviewSubtype -> RuntimePropertyPreview)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeObjectPreview)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"valuePreview"
    Parser
  (Maybe RuntimePropertyPreviewSubtype -> RuntimePropertyPreview)
-> Parser (Maybe RuntimePropertyPreviewSubtype)
-> Parser RuntimePropertyPreview
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimePropertyPreviewSubtype)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"subtype"
instance ToJSON RuntimePropertyPreview where
  toJSON :: RuntimePropertyPreview -> Value
toJSON RuntimePropertyPreview
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (RuntimePropertyPreview -> Text
runtimePropertyPreviewName RuntimePropertyPreview
p),
    (Text
"type" Text -> RuntimePropertyPreviewType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimePropertyPreviewType -> Pair)
-> Maybe RuntimePropertyPreviewType -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimePropertyPreviewType -> Maybe RuntimePropertyPreviewType
forall a. a -> Maybe a
Just (RuntimePropertyPreview -> RuntimePropertyPreviewType
runtimePropertyPreviewType RuntimePropertyPreview
p),
    (Text
"value" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyPreview -> Maybe Text
runtimePropertyPreviewValue RuntimePropertyPreview
p),
    (Text
"valuePreview" Text -> RuntimeObjectPreview -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeObjectPreview -> Pair)
-> Maybe RuntimeObjectPreview -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyPreview -> Maybe RuntimeObjectPreview
runtimePropertyPreviewValuePreview RuntimePropertyPreview
p),
    (Text
"subtype" Text -> RuntimePropertyPreviewSubtype -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimePropertyPreviewSubtype -> Pair)
-> Maybe RuntimePropertyPreviewSubtype -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyPreview -> Maybe RuntimePropertyPreviewSubtype
runtimePropertyPreviewSubtype RuntimePropertyPreview
p)
    ]

-- | Type 'Runtime.EntryPreview'.
data RuntimeEntryPreview = RuntimeEntryPreview
  {
    -- | Preview of the key. Specified for map-like collection entries.
    RuntimeEntryPreview -> Maybe RuntimeObjectPreview
runtimeEntryPreviewKey :: Maybe RuntimeObjectPreview,
    -- | Preview of the value.
    RuntimeEntryPreview -> RuntimeObjectPreview
runtimeEntryPreviewValue :: RuntimeObjectPreview
  }
  deriving (RuntimeEntryPreview -> RuntimeEntryPreview -> Bool
(RuntimeEntryPreview -> RuntimeEntryPreview -> Bool)
-> (RuntimeEntryPreview -> RuntimeEntryPreview -> Bool)
-> Eq RuntimeEntryPreview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeEntryPreview -> RuntimeEntryPreview -> Bool
$c/= :: RuntimeEntryPreview -> RuntimeEntryPreview -> Bool
== :: RuntimeEntryPreview -> RuntimeEntryPreview -> Bool
$c== :: RuntimeEntryPreview -> RuntimeEntryPreview -> Bool
Eq, Int -> RuntimeEntryPreview -> ShowS
[RuntimeEntryPreview] -> ShowS
RuntimeEntryPreview -> String
(Int -> RuntimeEntryPreview -> ShowS)
-> (RuntimeEntryPreview -> String)
-> ([RuntimeEntryPreview] -> ShowS)
-> Show RuntimeEntryPreview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeEntryPreview] -> ShowS
$cshowList :: [RuntimeEntryPreview] -> ShowS
show :: RuntimeEntryPreview -> String
$cshow :: RuntimeEntryPreview -> String
showsPrec :: Int -> RuntimeEntryPreview -> ShowS
$cshowsPrec :: Int -> RuntimeEntryPreview -> ShowS
Show)
instance FromJSON RuntimeEntryPreview where
  parseJSON :: Value -> Parser RuntimeEntryPreview
parseJSON = String
-> (Object -> Parser RuntimeEntryPreview)
-> Value
-> Parser RuntimeEntryPreview
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeEntryPreview" ((Object -> Parser RuntimeEntryPreview)
 -> Value -> Parser RuntimeEntryPreview)
-> (Object -> Parser RuntimeEntryPreview)
-> Value
-> Parser RuntimeEntryPreview
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe RuntimeObjectPreview
-> RuntimeObjectPreview -> RuntimeEntryPreview
RuntimeEntryPreview
    (Maybe RuntimeObjectPreview
 -> RuntimeObjectPreview -> RuntimeEntryPreview)
-> Parser (Maybe RuntimeObjectPreview)
-> Parser (RuntimeObjectPreview -> RuntimeEntryPreview)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe RuntimeObjectPreview)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"key"
    Parser (RuntimeObjectPreview -> RuntimeEntryPreview)
-> Parser RuntimeObjectPreview -> Parser RuntimeEntryPreview
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeObjectPreview
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"value"
instance ToJSON RuntimeEntryPreview where
  toJSON :: RuntimeEntryPreview -> Value
toJSON RuntimeEntryPreview
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
"key" Text -> RuntimeObjectPreview -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeObjectPreview -> Pair)
-> Maybe RuntimeObjectPreview -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeEntryPreview -> Maybe RuntimeObjectPreview
runtimeEntryPreviewKey RuntimeEntryPreview
p),
    (Text
"value" Text -> RuntimeObjectPreview -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeObjectPreview -> Pair)
-> Maybe RuntimeObjectPreview -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeObjectPreview -> Maybe RuntimeObjectPreview
forall a. a -> Maybe a
Just (RuntimeEntryPreview -> RuntimeObjectPreview
runtimeEntryPreviewValue RuntimeEntryPreview
p)
    ]

-- | Type 'Runtime.PropertyDescriptor'.
--   Object property descriptor.
data RuntimePropertyDescriptor = RuntimePropertyDescriptor
  {
    -- | Property name or symbol description.
    RuntimePropertyDescriptor -> Text
runtimePropertyDescriptorName :: T.Text,
    -- | The value associated with the property.
    RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorValue :: Maybe RuntimeRemoteObject,
    -- | True if the value associated with the property may be changed (data descriptors only).
    RuntimePropertyDescriptor -> Maybe Bool
runtimePropertyDescriptorWritable :: Maybe Bool,
    -- | A function which serves as a getter for the property, or `undefined` if there is no getter
    --   (accessor descriptors only).
    RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorGet :: Maybe RuntimeRemoteObject,
    -- | A function which serves as a setter for the property, or `undefined` if there is no setter
    --   (accessor descriptors only).
    RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorSet :: Maybe RuntimeRemoteObject,
    -- | True if the type of this property descriptor may be changed and if the property may be
    --   deleted from the corresponding object.
    RuntimePropertyDescriptor -> Bool
runtimePropertyDescriptorConfigurable :: Bool,
    -- | True if this property shows up during enumeration of the properties on the corresponding
    --   object.
    RuntimePropertyDescriptor -> Bool
runtimePropertyDescriptorEnumerable :: Bool,
    -- | True if the result was thrown during the evaluation.
    RuntimePropertyDescriptor -> Maybe Bool
runtimePropertyDescriptorWasThrown :: Maybe Bool,
    -- | True if the property is owned for the object.
    RuntimePropertyDescriptor -> Maybe Bool
runtimePropertyDescriptorIsOwn :: Maybe Bool,
    -- | Property symbol object, if the property is of the `symbol` type.
    RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorSymbol :: Maybe RuntimeRemoteObject
  }
  deriving (RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool
(RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool)
-> (RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool)
-> Eq RuntimePropertyDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool
$c/= :: RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool
== :: RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool
$c== :: RuntimePropertyDescriptor -> RuntimePropertyDescriptor -> Bool
Eq, Int -> RuntimePropertyDescriptor -> ShowS
[RuntimePropertyDescriptor] -> ShowS
RuntimePropertyDescriptor -> String
(Int -> RuntimePropertyDescriptor -> ShowS)
-> (RuntimePropertyDescriptor -> String)
-> ([RuntimePropertyDescriptor] -> ShowS)
-> Show RuntimePropertyDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimePropertyDescriptor] -> ShowS
$cshowList :: [RuntimePropertyDescriptor] -> ShowS
show :: RuntimePropertyDescriptor -> String
$cshow :: RuntimePropertyDescriptor -> String
showsPrec :: Int -> RuntimePropertyDescriptor -> ShowS
$cshowsPrec :: Int -> RuntimePropertyDescriptor -> ShowS
Show)
instance FromJSON RuntimePropertyDescriptor where
  parseJSON :: Value -> Parser RuntimePropertyDescriptor
parseJSON = String
-> (Object -> Parser RuntimePropertyDescriptor)
-> Value
-> Parser RuntimePropertyDescriptor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimePropertyDescriptor" ((Object -> Parser RuntimePropertyDescriptor)
 -> Value -> Parser RuntimePropertyDescriptor)
-> (Object -> Parser RuntimePropertyDescriptor)
-> Value
-> Parser RuntimePropertyDescriptor
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe RuntimeRemoteObject
-> Maybe Bool
-> Maybe RuntimeRemoteObject
-> Maybe RuntimeRemoteObject
-> Bool
-> Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RuntimeRemoteObject
-> RuntimePropertyDescriptor
RuntimePropertyDescriptor
    (Text
 -> Maybe RuntimeRemoteObject
 -> Maybe Bool
 -> Maybe RuntimeRemoteObject
 -> Maybe RuntimeRemoteObject
 -> Bool
 -> Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe RuntimeRemoteObject
 -> RuntimePropertyDescriptor)
-> Parser Text
-> Parser
     (Maybe RuntimeRemoteObject
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (Maybe RuntimeRemoteObject
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser
     (Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"value"
    Parser
  (Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser (Maybe Bool)
-> Parser
     (Maybe RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
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
"writable"
    Parser
  (Maybe RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser
     (Maybe RuntimeRemoteObject
      -> Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"get"
    Parser
  (Maybe RuntimeRemoteObject
   -> Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser
     (Bool
      -> Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"set"
    Parser
  (Bool
   -> Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser Bool
-> Parser
     (Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
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
"configurable"
    Parser
  (Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser Bool
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe RuntimeRemoteObject
      -> RuntimePropertyDescriptor)
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
"enumerable"
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe RuntimeRemoteObject
   -> RuntimePropertyDescriptor)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe RuntimeRemoteObject -> RuntimePropertyDescriptor)
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
"wasThrown"
    Parser
  (Maybe Bool
   -> Maybe RuntimeRemoteObject -> RuntimePropertyDescriptor)
-> Parser (Maybe Bool)
-> Parser (Maybe RuntimeRemoteObject -> RuntimePropertyDescriptor)
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
"isOwn"
    Parser (Maybe RuntimeRemoteObject -> RuntimePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser RuntimePropertyDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"symbol"
instance ToJSON RuntimePropertyDescriptor where
  toJSON :: RuntimePropertyDescriptor -> Value
toJSON RuntimePropertyDescriptor
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (RuntimePropertyDescriptor -> Text
runtimePropertyDescriptorName RuntimePropertyDescriptor
p),
    (Text
"value" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorValue RuntimePropertyDescriptor
p),
    (Text
"writable" 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
<$> (RuntimePropertyDescriptor -> Maybe Bool
runtimePropertyDescriptorWritable RuntimePropertyDescriptor
p),
    (Text
"get" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorGet RuntimePropertyDescriptor
p),
    (Text
"set" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorSet RuntimePropertyDescriptor
p),
    (Text
"configurable" 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 (RuntimePropertyDescriptor -> Bool
runtimePropertyDescriptorConfigurable RuntimePropertyDescriptor
p),
    (Text
"enumerable" 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 (RuntimePropertyDescriptor -> Bool
runtimePropertyDescriptorEnumerable RuntimePropertyDescriptor
p),
    (Text
"wasThrown" 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
<$> (RuntimePropertyDescriptor -> Maybe Bool
runtimePropertyDescriptorWasThrown RuntimePropertyDescriptor
p),
    (Text
"isOwn" 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
<$> (RuntimePropertyDescriptor -> Maybe Bool
runtimePropertyDescriptorIsOwn RuntimePropertyDescriptor
p),
    (Text
"symbol" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePropertyDescriptorSymbol RuntimePropertyDescriptor
p)
    ]

-- | Type 'Runtime.InternalPropertyDescriptor'.
--   Object internal property descriptor. This property isn't normally visible in JavaScript code.
data RuntimeInternalPropertyDescriptor = RuntimeInternalPropertyDescriptor
  {
    -- | Conventional property name.
    RuntimeInternalPropertyDescriptor -> Text
runtimeInternalPropertyDescriptorName :: T.Text,
    -- | The value associated with the property.
    RuntimeInternalPropertyDescriptor -> Maybe RuntimeRemoteObject
runtimeInternalPropertyDescriptorValue :: Maybe RuntimeRemoteObject
  }
  deriving (RuntimeInternalPropertyDescriptor
-> RuntimeInternalPropertyDescriptor -> Bool
(RuntimeInternalPropertyDescriptor
 -> RuntimeInternalPropertyDescriptor -> Bool)
-> (RuntimeInternalPropertyDescriptor
    -> RuntimeInternalPropertyDescriptor -> Bool)
-> Eq RuntimeInternalPropertyDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeInternalPropertyDescriptor
-> RuntimeInternalPropertyDescriptor -> Bool
$c/= :: RuntimeInternalPropertyDescriptor
-> RuntimeInternalPropertyDescriptor -> Bool
== :: RuntimeInternalPropertyDescriptor
-> RuntimeInternalPropertyDescriptor -> Bool
$c== :: RuntimeInternalPropertyDescriptor
-> RuntimeInternalPropertyDescriptor -> Bool
Eq, Int -> RuntimeInternalPropertyDescriptor -> ShowS
[RuntimeInternalPropertyDescriptor] -> ShowS
RuntimeInternalPropertyDescriptor -> String
(Int -> RuntimeInternalPropertyDescriptor -> ShowS)
-> (RuntimeInternalPropertyDescriptor -> String)
-> ([RuntimeInternalPropertyDescriptor] -> ShowS)
-> Show RuntimeInternalPropertyDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeInternalPropertyDescriptor] -> ShowS
$cshowList :: [RuntimeInternalPropertyDescriptor] -> ShowS
show :: RuntimeInternalPropertyDescriptor -> String
$cshow :: RuntimeInternalPropertyDescriptor -> String
showsPrec :: Int -> RuntimeInternalPropertyDescriptor -> ShowS
$cshowsPrec :: Int -> RuntimeInternalPropertyDescriptor -> ShowS
Show)
instance FromJSON RuntimeInternalPropertyDescriptor where
  parseJSON :: Value -> Parser RuntimeInternalPropertyDescriptor
parseJSON = String
-> (Object -> Parser RuntimeInternalPropertyDescriptor)
-> Value
-> Parser RuntimeInternalPropertyDescriptor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeInternalPropertyDescriptor" ((Object -> Parser RuntimeInternalPropertyDescriptor)
 -> Value -> Parser RuntimeInternalPropertyDescriptor)
-> (Object -> Parser RuntimeInternalPropertyDescriptor)
-> Value
-> Parser RuntimeInternalPropertyDescriptor
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe RuntimeRemoteObject -> RuntimeInternalPropertyDescriptor
RuntimeInternalPropertyDescriptor
    (Text
 -> Maybe RuntimeRemoteObject -> RuntimeInternalPropertyDescriptor)
-> Parser Text
-> Parser
     (Maybe RuntimeRemoteObject -> RuntimeInternalPropertyDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (Maybe RuntimeRemoteObject -> RuntimeInternalPropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser RuntimeInternalPropertyDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"value"
instance ToJSON RuntimeInternalPropertyDescriptor where
  toJSON :: RuntimeInternalPropertyDescriptor -> Value
toJSON RuntimeInternalPropertyDescriptor
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (RuntimeInternalPropertyDescriptor -> Text
runtimeInternalPropertyDescriptorName RuntimeInternalPropertyDescriptor
p),
    (Text
"value" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeInternalPropertyDescriptor -> Maybe RuntimeRemoteObject
runtimeInternalPropertyDescriptorValue RuntimeInternalPropertyDescriptor
p)
    ]

-- | Type 'Runtime.PrivatePropertyDescriptor'.
--   Object private field descriptor.
data RuntimePrivatePropertyDescriptor = RuntimePrivatePropertyDescriptor
  {
    -- | Private property name.
    RuntimePrivatePropertyDescriptor -> Text
runtimePrivatePropertyDescriptorName :: T.Text,
    -- | The value associated with the private property.
    RuntimePrivatePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePrivatePropertyDescriptorValue :: Maybe RuntimeRemoteObject,
    -- | A function which serves as a getter for the private property,
    --   or `undefined` if there is no getter (accessor descriptors only).
    RuntimePrivatePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePrivatePropertyDescriptorGet :: Maybe RuntimeRemoteObject,
    -- | A function which serves as a setter for the private property,
    --   or `undefined` if there is no setter (accessor descriptors only).
    RuntimePrivatePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePrivatePropertyDescriptorSet :: Maybe RuntimeRemoteObject
  }
  deriving (RuntimePrivatePropertyDescriptor
-> RuntimePrivatePropertyDescriptor -> Bool
(RuntimePrivatePropertyDescriptor
 -> RuntimePrivatePropertyDescriptor -> Bool)
-> (RuntimePrivatePropertyDescriptor
    -> RuntimePrivatePropertyDescriptor -> Bool)
-> Eq RuntimePrivatePropertyDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimePrivatePropertyDescriptor
-> RuntimePrivatePropertyDescriptor -> Bool
$c/= :: RuntimePrivatePropertyDescriptor
-> RuntimePrivatePropertyDescriptor -> Bool
== :: RuntimePrivatePropertyDescriptor
-> RuntimePrivatePropertyDescriptor -> Bool
$c== :: RuntimePrivatePropertyDescriptor
-> RuntimePrivatePropertyDescriptor -> Bool
Eq, Int -> RuntimePrivatePropertyDescriptor -> ShowS
[RuntimePrivatePropertyDescriptor] -> ShowS
RuntimePrivatePropertyDescriptor -> String
(Int -> RuntimePrivatePropertyDescriptor -> ShowS)
-> (RuntimePrivatePropertyDescriptor -> String)
-> ([RuntimePrivatePropertyDescriptor] -> ShowS)
-> Show RuntimePrivatePropertyDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimePrivatePropertyDescriptor] -> ShowS
$cshowList :: [RuntimePrivatePropertyDescriptor] -> ShowS
show :: RuntimePrivatePropertyDescriptor -> String
$cshow :: RuntimePrivatePropertyDescriptor -> String
showsPrec :: Int -> RuntimePrivatePropertyDescriptor -> ShowS
$cshowsPrec :: Int -> RuntimePrivatePropertyDescriptor -> ShowS
Show)
instance FromJSON RuntimePrivatePropertyDescriptor where
  parseJSON :: Value -> Parser RuntimePrivatePropertyDescriptor
parseJSON = String
-> (Object -> Parser RuntimePrivatePropertyDescriptor)
-> Value
-> Parser RuntimePrivatePropertyDescriptor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimePrivatePropertyDescriptor" ((Object -> Parser RuntimePrivatePropertyDescriptor)
 -> Value -> Parser RuntimePrivatePropertyDescriptor)
-> (Object -> Parser RuntimePrivatePropertyDescriptor)
-> Value
-> Parser RuntimePrivatePropertyDescriptor
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe RuntimeRemoteObject
-> Maybe RuntimeRemoteObject
-> Maybe RuntimeRemoteObject
-> RuntimePrivatePropertyDescriptor
RuntimePrivatePropertyDescriptor
    (Text
 -> Maybe RuntimeRemoteObject
 -> Maybe RuntimeRemoteObject
 -> Maybe RuntimeRemoteObject
 -> RuntimePrivatePropertyDescriptor)
-> Parser Text
-> Parser
     (Maybe RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject
      -> RuntimePrivatePropertyDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser
  (Maybe RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject
   -> RuntimePrivatePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser
     (Maybe RuntimeRemoteObject
      -> Maybe RuntimeRemoteObject -> RuntimePrivatePropertyDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"value"
    Parser
  (Maybe RuntimeRemoteObject
   -> Maybe RuntimeRemoteObject -> RuntimePrivatePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser
     (Maybe RuntimeRemoteObject -> RuntimePrivatePropertyDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"get"
    Parser
  (Maybe RuntimeRemoteObject -> RuntimePrivatePropertyDescriptor)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser RuntimePrivatePropertyDescriptor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"set"
instance ToJSON RuntimePrivatePropertyDescriptor where
  toJSON :: RuntimePrivatePropertyDescriptor -> Value
toJSON RuntimePrivatePropertyDescriptor
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (RuntimePrivatePropertyDescriptor -> Text
runtimePrivatePropertyDescriptorName RuntimePrivatePropertyDescriptor
p),
    (Text
"value" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePrivatePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePrivatePropertyDescriptorValue RuntimePrivatePropertyDescriptor
p),
    (Text
"get" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePrivatePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePrivatePropertyDescriptorGet RuntimePrivatePropertyDescriptor
p),
    (Text
"set" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimePrivatePropertyDescriptor -> Maybe RuntimeRemoteObject
runtimePrivatePropertyDescriptorSet RuntimePrivatePropertyDescriptor
p)
    ]

-- | Type 'Runtime.CallArgument'.
--   Represents function call argument. Either remote object id `objectId`, primitive `value`,
--   unserializable primitive value or neither of (for undefined) them should be specified.
data RuntimeCallArgument = RuntimeCallArgument
  {
    -- | Primitive value or serializable javascript object.
    RuntimeCallArgument -> Maybe Value
runtimeCallArgumentValue :: Maybe A.Value,
    -- | Primitive value which can not be JSON-stringified.
    RuntimeCallArgument -> Maybe Text
runtimeCallArgumentUnserializableValue :: Maybe RuntimeUnserializableValue,
    -- | Remote object handle.
    RuntimeCallArgument -> Maybe Text
runtimeCallArgumentObjectId :: Maybe RuntimeRemoteObjectId
  }
  deriving (RuntimeCallArgument -> RuntimeCallArgument -> Bool
(RuntimeCallArgument -> RuntimeCallArgument -> Bool)
-> (RuntimeCallArgument -> RuntimeCallArgument -> Bool)
-> Eq RuntimeCallArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCallArgument -> RuntimeCallArgument -> Bool
$c/= :: RuntimeCallArgument -> RuntimeCallArgument -> Bool
== :: RuntimeCallArgument -> RuntimeCallArgument -> Bool
$c== :: RuntimeCallArgument -> RuntimeCallArgument -> Bool
Eq, Int -> RuntimeCallArgument -> ShowS
[RuntimeCallArgument] -> ShowS
RuntimeCallArgument -> String
(Int -> RuntimeCallArgument -> ShowS)
-> (RuntimeCallArgument -> String)
-> ([RuntimeCallArgument] -> ShowS)
-> Show RuntimeCallArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCallArgument] -> ShowS
$cshowList :: [RuntimeCallArgument] -> ShowS
show :: RuntimeCallArgument -> String
$cshow :: RuntimeCallArgument -> String
showsPrec :: Int -> RuntimeCallArgument -> ShowS
$cshowsPrec :: Int -> RuntimeCallArgument -> ShowS
Show)
instance FromJSON RuntimeCallArgument where
  parseJSON :: Value -> Parser RuntimeCallArgument
parseJSON = String
-> (Object -> Parser RuntimeCallArgument)
-> Value
-> Parser RuntimeCallArgument
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeCallArgument" ((Object -> Parser RuntimeCallArgument)
 -> Value -> Parser RuntimeCallArgument)
-> (Object -> Parser RuntimeCallArgument)
-> Value
-> Parser RuntimeCallArgument
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Value -> Maybe Text -> Maybe Text -> RuntimeCallArgument
RuntimeCallArgument
    (Maybe Value -> Maybe Text -> Maybe Text -> RuntimeCallArgument)
-> Parser (Maybe Value)
-> Parser (Maybe Text -> Maybe Text -> RuntimeCallArgument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"value"
    Parser (Maybe Text -> Maybe Text -> RuntimeCallArgument)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> RuntimeCallArgument)
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
"unserializableValue"
    Parser (Maybe Text -> RuntimeCallArgument)
-> Parser (Maybe Text) -> Parser RuntimeCallArgument
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
"objectId"
instance ToJSON RuntimeCallArgument where
  toJSON :: RuntimeCallArgument -> Value
toJSON RuntimeCallArgument
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 -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeCallArgument -> Maybe Value
runtimeCallArgumentValue RuntimeCallArgument
p),
    (Text
"unserializableValue" 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
<$> (RuntimeCallArgument -> Maybe Text
runtimeCallArgumentUnserializableValue RuntimeCallArgument
p),
    (Text
"objectId" 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
<$> (RuntimeCallArgument -> Maybe Text
runtimeCallArgumentObjectId RuntimeCallArgument
p)
    ]

-- | Type 'Runtime.ExecutionContextId'.
--   Id of an execution context.
type RuntimeExecutionContextId = Int

-- | Type 'Runtime.ExecutionContextDescription'.
--   Description of an isolated world.
data RuntimeExecutionContextDescription = RuntimeExecutionContextDescription
  {
    -- | Unique id of the execution context. It can be used to specify in which execution context
    --   script evaluation should be performed.
    RuntimeExecutionContextDescription -> Int
runtimeExecutionContextDescriptionId :: RuntimeExecutionContextId,
    -- | Execution context origin.
    RuntimeExecutionContextDescription -> Text
runtimeExecutionContextDescriptionOrigin :: T.Text,
    -- | Human readable name describing given context.
    RuntimeExecutionContextDescription -> Text
runtimeExecutionContextDescriptionName :: T.Text,
    -- | A system-unique execution context identifier. Unlike the id, this is unique across
    --   multiple processes, so can be reliably used to identify specific context while backend
    --   performs a cross-process navigation.
    RuntimeExecutionContextDescription -> Text
runtimeExecutionContextDescriptionUniqueId :: T.Text,
    -- | Embedder-specific auxiliary data.
    RuntimeExecutionContextDescription -> Maybe [(Text, Text)]
runtimeExecutionContextDescriptionAuxData :: Maybe [(T.Text, T.Text)]
  }
  deriving (RuntimeExecutionContextDescription
-> RuntimeExecutionContextDescription -> Bool
(RuntimeExecutionContextDescription
 -> RuntimeExecutionContextDescription -> Bool)
-> (RuntimeExecutionContextDescription
    -> RuntimeExecutionContextDescription -> Bool)
-> Eq RuntimeExecutionContextDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeExecutionContextDescription
-> RuntimeExecutionContextDescription -> Bool
$c/= :: RuntimeExecutionContextDescription
-> RuntimeExecutionContextDescription -> Bool
== :: RuntimeExecutionContextDescription
-> RuntimeExecutionContextDescription -> Bool
$c== :: RuntimeExecutionContextDescription
-> RuntimeExecutionContextDescription -> Bool
Eq, Int -> RuntimeExecutionContextDescription -> ShowS
[RuntimeExecutionContextDescription] -> ShowS
RuntimeExecutionContextDescription -> String
(Int -> RuntimeExecutionContextDescription -> ShowS)
-> (RuntimeExecutionContextDescription -> String)
-> ([RuntimeExecutionContextDescription] -> ShowS)
-> Show RuntimeExecutionContextDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeExecutionContextDescription] -> ShowS
$cshowList :: [RuntimeExecutionContextDescription] -> ShowS
show :: RuntimeExecutionContextDescription -> String
$cshow :: RuntimeExecutionContextDescription -> String
showsPrec :: Int -> RuntimeExecutionContextDescription -> ShowS
$cshowsPrec :: Int -> RuntimeExecutionContextDescription -> ShowS
Show)
instance FromJSON RuntimeExecutionContextDescription where
  parseJSON :: Value -> Parser RuntimeExecutionContextDescription
parseJSON = String
-> (Object -> Parser RuntimeExecutionContextDescription)
-> Value
-> Parser RuntimeExecutionContextDescription
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeExecutionContextDescription" ((Object -> Parser RuntimeExecutionContextDescription)
 -> Value -> Parser RuntimeExecutionContextDescription)
-> (Object -> Parser RuntimeExecutionContextDescription)
-> Value
-> Parser RuntimeExecutionContextDescription
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Text
-> Text
-> Maybe [(Text, Text)]
-> RuntimeExecutionContextDescription
RuntimeExecutionContextDescription
    (Int
 -> Text
 -> Text
 -> Text
 -> Maybe [(Text, Text)]
 -> RuntimeExecutionContextDescription)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe [(Text, Text)]
      -> RuntimeExecutionContextDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Parser
  (Text
   -> Text
   -> Text
   -> Maybe [(Text, Text)]
   -> RuntimeExecutionContextDescription)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe [(Text, Text)]
      -> RuntimeExecutionContextDescription)
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
"origin"
    Parser
  (Text
   -> Text
   -> Maybe [(Text, Text)]
   -> RuntimeExecutionContextDescription)
-> Parser Text
-> Parser
     (Text
      -> Maybe [(Text, Text)] -> RuntimeExecutionContextDescription)
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
  (Text
   -> Maybe [(Text, Text)] -> RuntimeExecutionContextDescription)
-> Parser Text
-> Parser
     (Maybe [(Text, Text)] -> RuntimeExecutionContextDescription)
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
"uniqueId"
    Parser (Maybe [(Text, Text)] -> RuntimeExecutionContextDescription)
-> Parser (Maybe [(Text, Text)])
-> Parser RuntimeExecutionContextDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"auxData"
instance ToJSON RuntimeExecutionContextDescription where
  toJSON :: RuntimeExecutionContextDescription -> Value
toJSON RuntimeExecutionContextDescription
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
"id" 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 (RuntimeExecutionContextDescription -> Int
runtimeExecutionContextDescriptionId RuntimeExecutionContextDescription
p),
    (Text
"origin" 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 (RuntimeExecutionContextDescription -> Text
runtimeExecutionContextDescriptionOrigin RuntimeExecutionContextDescription
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 (RuntimeExecutionContextDescription -> Text
runtimeExecutionContextDescriptionName RuntimeExecutionContextDescription
p),
    (Text
"uniqueId" 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 (RuntimeExecutionContextDescription -> Text
runtimeExecutionContextDescriptionUniqueId RuntimeExecutionContextDescription
p),
    (Text
"auxData" Text -> [(Text, Text)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([(Text, Text)] -> Pair) -> Maybe [(Text, Text)] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeExecutionContextDescription -> Maybe [(Text, Text)]
runtimeExecutionContextDescriptionAuxData RuntimeExecutionContextDescription
p)
    ]

-- | Type 'Runtime.ExceptionDetails'.
--   Detailed information about exception (or error) that was thrown during script compilation or
--   execution.
data RuntimeExceptionDetails = RuntimeExceptionDetails
  {
    -- | Exception id.
    RuntimeExceptionDetails -> Int
runtimeExceptionDetailsExceptionId :: Int,
    -- | Exception text, which should be used together with exception object when available.
    RuntimeExceptionDetails -> Text
runtimeExceptionDetailsText :: T.Text,
    -- | Line number of the exception location (0-based).
    RuntimeExceptionDetails -> Int
runtimeExceptionDetailsLineNumber :: Int,
    -- | Column number of the exception location (0-based).
    RuntimeExceptionDetails -> Int
runtimeExceptionDetailsColumnNumber :: Int,
    -- | Script ID of the exception location.
    RuntimeExceptionDetails -> Maybe Text
runtimeExceptionDetailsScriptId :: Maybe RuntimeScriptId,
    -- | URL of the exception location, to be used when the script was not reported.
    RuntimeExceptionDetails -> Maybe Text
runtimeExceptionDetailsUrl :: Maybe T.Text,
    -- | JavaScript stack trace if available.
    RuntimeExceptionDetails -> Maybe RuntimeStackTrace
runtimeExceptionDetailsStackTrace :: Maybe RuntimeStackTrace,
    -- | Exception object if available.
    RuntimeExceptionDetails -> Maybe RuntimeRemoteObject
runtimeExceptionDetailsException :: Maybe RuntimeRemoteObject,
    -- | Identifier of the context where exception happened.
    RuntimeExceptionDetails -> Maybe Int
runtimeExceptionDetailsExecutionContextId :: Maybe RuntimeExecutionContextId,
    -- | Dictionary with entries of meta data that the client associated
    --   with this exception, such as information about associated network
    --   requests, etc.
    RuntimeExceptionDetails -> Maybe [(Text, Text)]
runtimeExceptionDetailsExceptionMetaData :: Maybe [(T.Text, T.Text)]
  }
  deriving (RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool
(RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool)
-> (RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool)
-> Eq RuntimeExceptionDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool
$c/= :: RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool
== :: RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool
$c== :: RuntimeExceptionDetails -> RuntimeExceptionDetails -> Bool
Eq, Int -> RuntimeExceptionDetails -> ShowS
[RuntimeExceptionDetails] -> ShowS
RuntimeExceptionDetails -> String
(Int -> RuntimeExceptionDetails -> ShowS)
-> (RuntimeExceptionDetails -> String)
-> ([RuntimeExceptionDetails] -> ShowS)
-> Show RuntimeExceptionDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeExceptionDetails] -> ShowS
$cshowList :: [RuntimeExceptionDetails] -> ShowS
show :: RuntimeExceptionDetails -> String
$cshow :: RuntimeExceptionDetails -> String
showsPrec :: Int -> RuntimeExceptionDetails -> ShowS
$cshowsPrec :: Int -> RuntimeExceptionDetails -> ShowS
Show)
instance FromJSON RuntimeExceptionDetails where
  parseJSON :: Value -> Parser RuntimeExceptionDetails
parseJSON = String
-> (Object -> Parser RuntimeExceptionDetails)
-> Value
-> Parser RuntimeExceptionDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeExceptionDetails" ((Object -> Parser RuntimeExceptionDetails)
 -> Value -> Parser RuntimeExceptionDetails)
-> (Object -> Parser RuntimeExceptionDetails)
-> Value
-> Parser RuntimeExceptionDetails
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Int
-> Int
-> Maybe Text
-> Maybe Text
-> Maybe RuntimeStackTrace
-> Maybe RuntimeRemoteObject
-> Maybe Int
-> Maybe [(Text, Text)]
-> RuntimeExceptionDetails
RuntimeExceptionDetails
    (Int
 -> Text
 -> Int
 -> Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe RuntimeStackTrace
 -> Maybe RuntimeRemoteObject
 -> Maybe Int
 -> Maybe [(Text, Text)]
 -> RuntimeExceptionDetails)
-> Parser Int
-> Parser
     (Text
      -> Int
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeRemoteObject
      -> Maybe Int
      -> Maybe [(Text, Text)]
      -> RuntimeExceptionDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"exceptionId"
    Parser
  (Text
   -> Int
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeRemoteObject
   -> Maybe Int
   -> Maybe [(Text, Text)]
   -> RuntimeExceptionDetails)
-> Parser Text
-> Parser
     (Int
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeRemoteObject
      -> Maybe Int
      -> Maybe [(Text, Text)]
      -> RuntimeExceptionDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"text"
    Parser
  (Int
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeRemoteObject
   -> Maybe Int
   -> Maybe [(Text, Text)]
   -> RuntimeExceptionDetails)
-> Parser Int
-> Parser
     (Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeRemoteObject
      -> Maybe Int
      -> Maybe [(Text, Text)]
      -> RuntimeExceptionDetails)
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
"lineNumber"
    Parser
  (Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeRemoteObject
   -> Maybe Int
   -> Maybe [(Text, Text)]
   -> RuntimeExceptionDetails)
-> Parser Int
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeRemoteObject
      -> Maybe Int
      -> Maybe [(Text, Text)]
      -> RuntimeExceptionDetails)
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
"columnNumber"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeRemoteObject
   -> Maybe Int
   -> Maybe [(Text, Text)]
   -> RuntimeExceptionDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeRemoteObject
      -> Maybe Int
      -> Maybe [(Text, Text)]
      -> RuntimeExceptionDetails)
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
"scriptId"
    Parser
  (Maybe Text
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeRemoteObject
   -> Maybe Int
   -> Maybe [(Text, Text)]
   -> RuntimeExceptionDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe RuntimeStackTrace
      -> Maybe RuntimeRemoteObject
      -> Maybe Int
      -> Maybe [(Text, Text)]
      -> RuntimeExceptionDetails)
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 RuntimeStackTrace
   -> Maybe RuntimeRemoteObject
   -> Maybe Int
   -> Maybe [(Text, Text)]
   -> RuntimeExceptionDetails)
-> Parser (Maybe RuntimeStackTrace)
-> Parser
     (Maybe RuntimeRemoteObject
      -> Maybe Int -> Maybe [(Text, Text)] -> RuntimeExceptionDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeStackTrace)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"stackTrace"
    Parser
  (Maybe RuntimeRemoteObject
   -> Maybe Int -> Maybe [(Text, Text)] -> RuntimeExceptionDetails)
-> Parser (Maybe RuntimeRemoteObject)
-> Parser
     (Maybe Int -> Maybe [(Text, Text)] -> RuntimeExceptionDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeRemoteObject)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exception"
    Parser
  (Maybe Int -> Maybe [(Text, Text)] -> RuntimeExceptionDetails)
-> Parser (Maybe Int)
-> Parser (Maybe [(Text, Text)] -> RuntimeExceptionDetails)
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
"executionContextId"
    Parser (Maybe [(Text, Text)] -> RuntimeExceptionDetails)
-> Parser (Maybe [(Text, Text)]) -> Parser RuntimeExceptionDetails
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionMetaData"
instance ToJSON RuntimeExceptionDetails where
  toJSON :: RuntimeExceptionDetails -> Value
toJSON RuntimeExceptionDetails
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
"exceptionId" 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 (RuntimeExceptionDetails -> Int
runtimeExceptionDetailsExceptionId RuntimeExceptionDetails
p),
    (Text
"text" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (RuntimeExceptionDetails -> Text
runtimeExceptionDetailsText RuntimeExceptionDetails
p),
    (Text
"lineNumber" 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 (RuntimeExceptionDetails -> Int
runtimeExceptionDetailsLineNumber RuntimeExceptionDetails
p),
    (Text
"columnNumber" 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 (RuntimeExceptionDetails -> Int
runtimeExceptionDetailsColumnNumber RuntimeExceptionDetails
p),
    (Text
"scriptId" 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
<$> (RuntimeExceptionDetails -> Maybe Text
runtimeExceptionDetailsScriptId RuntimeExceptionDetails
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
<$> (RuntimeExceptionDetails -> Maybe Text
runtimeExceptionDetailsUrl RuntimeExceptionDetails
p),
    (Text
"stackTrace" Text -> RuntimeStackTrace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeStackTrace -> Pair)
-> Maybe RuntimeStackTrace -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeExceptionDetails -> Maybe RuntimeStackTrace
runtimeExceptionDetailsStackTrace RuntimeExceptionDetails
p),
    (Text
"exception" Text -> RuntimeRemoteObject -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeRemoteObject -> Pair)
-> Maybe RuntimeRemoteObject -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeExceptionDetails -> Maybe RuntimeRemoteObject
runtimeExceptionDetailsException RuntimeExceptionDetails
p),
    (Text
"executionContextId" 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
<$> (RuntimeExceptionDetails -> Maybe Int
runtimeExceptionDetailsExecutionContextId RuntimeExceptionDetails
p),
    (Text
"exceptionMetaData" Text -> [(Text, Text)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([(Text, Text)] -> Pair) -> Maybe [(Text, Text)] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeExceptionDetails -> Maybe [(Text, Text)]
runtimeExceptionDetailsExceptionMetaData RuntimeExceptionDetails
p)
    ]

-- | Type 'Runtime.Timestamp'.
--   Number of milliseconds since epoch.
type RuntimeTimestamp = Double

-- | Type 'Runtime.TimeDelta'.
--   Number of milliseconds.
type RuntimeTimeDelta = Double

-- | Type 'Runtime.CallFrame'.
--   Stack entry for runtime errors and assertions.
data RuntimeCallFrame = RuntimeCallFrame
  {
    -- | JavaScript function name.
    RuntimeCallFrame -> Text
runtimeCallFrameFunctionName :: T.Text,
    -- | JavaScript script id.
    RuntimeCallFrame -> Text
runtimeCallFrameScriptId :: RuntimeScriptId,
    -- | JavaScript script name or url.
    RuntimeCallFrame -> Text
runtimeCallFrameUrl :: T.Text,
    -- | JavaScript script line number (0-based).
    RuntimeCallFrame -> Int
runtimeCallFrameLineNumber :: Int,
    -- | JavaScript script column number (0-based).
    RuntimeCallFrame -> Int
runtimeCallFrameColumnNumber :: Int
  }
  deriving (RuntimeCallFrame -> RuntimeCallFrame -> Bool
(RuntimeCallFrame -> RuntimeCallFrame -> Bool)
-> (RuntimeCallFrame -> RuntimeCallFrame -> Bool)
-> Eq RuntimeCallFrame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCallFrame -> RuntimeCallFrame -> Bool
$c/= :: RuntimeCallFrame -> RuntimeCallFrame -> Bool
== :: RuntimeCallFrame -> RuntimeCallFrame -> Bool
$c== :: RuntimeCallFrame -> RuntimeCallFrame -> Bool
Eq, Int -> RuntimeCallFrame -> ShowS
[RuntimeCallFrame] -> ShowS
RuntimeCallFrame -> String
(Int -> RuntimeCallFrame -> ShowS)
-> (RuntimeCallFrame -> String)
-> ([RuntimeCallFrame] -> ShowS)
-> Show RuntimeCallFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCallFrame] -> ShowS
$cshowList :: [RuntimeCallFrame] -> ShowS
show :: RuntimeCallFrame -> String
$cshow :: RuntimeCallFrame -> String
showsPrec :: Int -> RuntimeCallFrame -> ShowS
$cshowsPrec :: Int -> RuntimeCallFrame -> ShowS
Show)
instance FromJSON RuntimeCallFrame where
  parseJSON :: Value -> Parser RuntimeCallFrame
parseJSON = String
-> (Object -> Parser RuntimeCallFrame)
-> Value
-> Parser RuntimeCallFrame
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeCallFrame" ((Object -> Parser RuntimeCallFrame)
 -> Value -> Parser RuntimeCallFrame)
-> (Object -> Parser RuntimeCallFrame)
-> Value
-> Parser RuntimeCallFrame
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> Int -> Int -> RuntimeCallFrame
RuntimeCallFrame
    (Text -> Text -> Text -> Int -> Int -> RuntimeCallFrame)
-> Parser Text
-> Parser (Text -> Text -> Int -> Int -> RuntimeCallFrame)
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
"functionName"
    Parser (Text -> Text -> Int -> Int -> RuntimeCallFrame)
-> Parser Text -> Parser (Text -> Int -> Int -> RuntimeCallFrame)
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
"scriptId"
    Parser (Text -> Int -> Int -> RuntimeCallFrame)
-> Parser Text -> Parser (Int -> Int -> RuntimeCallFrame)
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
"url"
    Parser (Int -> Int -> RuntimeCallFrame)
-> Parser Int -> Parser (Int -> RuntimeCallFrame)
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
"lineNumber"
    Parser (Int -> RuntimeCallFrame)
-> Parser Int -> Parser RuntimeCallFrame
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
"columnNumber"
instance ToJSON RuntimeCallFrame where
  toJSON :: RuntimeCallFrame -> Value
toJSON RuntimeCallFrame
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
"functionName" 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 (RuntimeCallFrame -> Text
runtimeCallFrameFunctionName RuntimeCallFrame
p),
    (Text
"scriptId" 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 (RuntimeCallFrame -> Text
runtimeCallFrameScriptId RuntimeCallFrame
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
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (RuntimeCallFrame -> Text
runtimeCallFrameUrl RuntimeCallFrame
p),
    (Text
"lineNumber" 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 (RuntimeCallFrame -> Int
runtimeCallFrameLineNumber RuntimeCallFrame
p),
    (Text
"columnNumber" 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 (RuntimeCallFrame -> Int
runtimeCallFrameColumnNumber RuntimeCallFrame
p)
    ]

-- | Type 'Runtime.StackTrace'.
--   Call frames for assertions or error messages.
data RuntimeStackTrace = RuntimeStackTrace
  {
    -- | String label of this stack trace. For async traces this may be a name of the function that
    --   initiated the async call.
    RuntimeStackTrace -> Maybe Text
runtimeStackTraceDescription :: Maybe T.Text,
    -- | JavaScript function name.
    RuntimeStackTrace -> [RuntimeCallFrame]
runtimeStackTraceCallFrames :: [RuntimeCallFrame],
    -- | Asynchronous JavaScript stack trace that preceded this stack, if available.
    RuntimeStackTrace -> Maybe RuntimeStackTrace
runtimeStackTraceParent :: Maybe RuntimeStackTrace,
    -- | Asynchronous JavaScript stack trace that preceded this stack, if available.
    RuntimeStackTrace -> Maybe RuntimeStackTraceId
runtimeStackTraceParentId :: Maybe RuntimeStackTraceId
  }
  deriving (RuntimeStackTrace -> RuntimeStackTrace -> Bool
(RuntimeStackTrace -> RuntimeStackTrace -> Bool)
-> (RuntimeStackTrace -> RuntimeStackTrace -> Bool)
-> Eq RuntimeStackTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeStackTrace -> RuntimeStackTrace -> Bool
$c/= :: RuntimeStackTrace -> RuntimeStackTrace -> Bool
== :: RuntimeStackTrace -> RuntimeStackTrace -> Bool
$c== :: RuntimeStackTrace -> RuntimeStackTrace -> Bool
Eq, Int -> RuntimeStackTrace -> ShowS
[RuntimeStackTrace] -> ShowS
RuntimeStackTrace -> String
(Int -> RuntimeStackTrace -> ShowS)
-> (RuntimeStackTrace -> String)
-> ([RuntimeStackTrace] -> ShowS)
-> Show RuntimeStackTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeStackTrace] -> ShowS
$cshowList :: [RuntimeStackTrace] -> ShowS
show :: RuntimeStackTrace -> String
$cshow :: RuntimeStackTrace -> String
showsPrec :: Int -> RuntimeStackTrace -> ShowS
$cshowsPrec :: Int -> RuntimeStackTrace -> ShowS
Show)
instance FromJSON RuntimeStackTrace where
  parseJSON :: Value -> Parser RuntimeStackTrace
parseJSON = String
-> (Object -> Parser RuntimeStackTrace)
-> Value
-> Parser RuntimeStackTrace
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeStackTrace" ((Object -> Parser RuntimeStackTrace)
 -> Value -> Parser RuntimeStackTrace)
-> (Object -> Parser RuntimeStackTrace)
-> Value
-> Parser RuntimeStackTrace
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> [RuntimeCallFrame]
-> Maybe RuntimeStackTrace
-> Maybe RuntimeStackTraceId
-> RuntimeStackTrace
RuntimeStackTrace
    (Maybe Text
 -> [RuntimeCallFrame]
 -> Maybe RuntimeStackTrace
 -> Maybe RuntimeStackTraceId
 -> RuntimeStackTrace)
-> Parser (Maybe Text)
-> Parser
     ([RuntimeCallFrame]
      -> Maybe RuntimeStackTrace
      -> Maybe RuntimeStackTraceId
      -> RuntimeStackTrace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"description"
    Parser
  ([RuntimeCallFrame]
   -> Maybe RuntimeStackTrace
   -> Maybe RuntimeStackTraceId
   -> RuntimeStackTrace)
-> Parser [RuntimeCallFrame]
-> Parser
     (Maybe RuntimeStackTrace
      -> Maybe RuntimeStackTraceId -> RuntimeStackTrace)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [RuntimeCallFrame]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"callFrames"
    Parser
  (Maybe RuntimeStackTrace
   -> Maybe RuntimeStackTraceId -> RuntimeStackTrace)
-> Parser (Maybe RuntimeStackTrace)
-> Parser (Maybe RuntimeStackTraceId -> RuntimeStackTrace)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeStackTrace)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"parent"
    Parser (Maybe RuntimeStackTraceId -> RuntimeStackTrace)
-> Parser (Maybe RuntimeStackTraceId) -> Parser RuntimeStackTrace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeStackTraceId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"parentId"
instance ToJSON RuntimeStackTrace where
  toJSON :: RuntimeStackTrace -> Value
toJSON RuntimeStackTrace
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
"description" 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
<$> (RuntimeStackTrace -> Maybe Text
runtimeStackTraceDescription RuntimeStackTrace
p),
    (Text
"callFrames" Text -> [RuntimeCallFrame] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([RuntimeCallFrame] -> Pair)
-> Maybe [RuntimeCallFrame] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RuntimeCallFrame] -> Maybe [RuntimeCallFrame]
forall a. a -> Maybe a
Just (RuntimeStackTrace -> [RuntimeCallFrame]
runtimeStackTraceCallFrames RuntimeStackTrace
p),
    (Text
"parent" Text -> RuntimeStackTrace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeStackTrace -> Pair)
-> Maybe RuntimeStackTrace -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeStackTrace -> Maybe RuntimeStackTrace
runtimeStackTraceParent RuntimeStackTrace
p),
    (Text
"parentId" Text -> RuntimeStackTraceId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeStackTraceId -> Pair)
-> Maybe RuntimeStackTraceId -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RuntimeStackTrace -> Maybe RuntimeStackTraceId
runtimeStackTraceParentId RuntimeStackTrace
p)
    ]

-- | Type 'Runtime.UniqueDebuggerId'.
--   Unique identifier of current debugger.
type RuntimeUniqueDebuggerId = T.Text

-- | Type 'Runtime.StackTraceId'.
--   If `debuggerId` is set stack trace comes from another debugger and can be resolved there. This
--   allows to track cross-debugger calls. See `Runtime.StackTrace` and `Debugger.paused` for usages.
data RuntimeStackTraceId = RuntimeStackTraceId
  {
    RuntimeStackTraceId -> Text
runtimeStackTraceIdId :: T.Text,
    RuntimeStackTraceId -> Maybe Text
runtimeStackTraceIdDebuggerId :: Maybe RuntimeUniqueDebuggerId
  }
  deriving (RuntimeStackTraceId -> RuntimeStackTraceId -> Bool
(RuntimeStackTraceId -> RuntimeStackTraceId -> Bool)
-> (RuntimeStackTraceId -> RuntimeStackTraceId -> Bool)
-> Eq RuntimeStackTraceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeStackTraceId -> RuntimeStackTraceId -> Bool
$c/= :: RuntimeStackTraceId -> RuntimeStackTraceId -> Bool
== :: RuntimeStackTraceId -> RuntimeStackTraceId -> Bool
$c== :: RuntimeStackTraceId -> RuntimeStackTraceId -> Bool
Eq, Int -> RuntimeStackTraceId -> ShowS
[RuntimeStackTraceId] -> ShowS
RuntimeStackTraceId -> String
(Int -> RuntimeStackTraceId -> ShowS)
-> (RuntimeStackTraceId -> String)
-> ([RuntimeStackTraceId] -> ShowS)
-> Show RuntimeStackTraceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeStackTraceId] -> ShowS
$cshowList :: [RuntimeStackTraceId] -> ShowS
show :: RuntimeStackTraceId -> String
$cshow :: RuntimeStackTraceId -> String
showsPrec :: Int -> RuntimeStackTraceId -> ShowS
$cshowsPrec :: Int -> RuntimeStackTraceId -> ShowS
Show)
instance FromJSON RuntimeStackTraceId where
  parseJSON :: Value -> Parser RuntimeStackTraceId
parseJSON = String
-> (Object -> Parser RuntimeStackTraceId)
-> Value
-> Parser RuntimeStackTraceId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeStackTraceId" ((Object -> Parser RuntimeStackTraceId)
 -> Value -> Parser RuntimeStackTraceId)
-> (Object -> Parser RuntimeStackTraceId)
-> Value
-> Parser RuntimeStackTraceId
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Maybe Text -> RuntimeStackTraceId
RuntimeStackTraceId
    (Text -> Maybe Text -> RuntimeStackTraceId)
-> Parser Text -> Parser (Maybe Text -> RuntimeStackTraceId)
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
"id"
    Parser (Maybe Text -> RuntimeStackTraceId)
-> Parser (Maybe Text) -> Parser RuntimeStackTraceId
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
"debuggerId"
instance ToJSON RuntimeStackTraceId where
  toJSON :: RuntimeStackTraceId -> Value
toJSON RuntimeStackTraceId
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
"id" 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 (RuntimeStackTraceId -> Text
runtimeStackTraceIdId RuntimeStackTraceId
p),
    (Text
"debuggerId" 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
<$> (RuntimeStackTraceId -> Maybe Text
runtimeStackTraceIdDebuggerId RuntimeStackTraceId
p)
    ]

-- | Type of the 'Runtime.bindingCalled' event.
data RuntimeBindingCalled = RuntimeBindingCalled
  {
    RuntimeBindingCalled -> Text
runtimeBindingCalledName :: T.Text,
    RuntimeBindingCalled -> Text
runtimeBindingCalledPayload :: T.Text,
    -- | Identifier of the context where the call was made.
    RuntimeBindingCalled -> Int
runtimeBindingCalledExecutionContextId :: RuntimeExecutionContextId
  }
  deriving (RuntimeBindingCalled -> RuntimeBindingCalled -> Bool
(RuntimeBindingCalled -> RuntimeBindingCalled -> Bool)
-> (RuntimeBindingCalled -> RuntimeBindingCalled -> Bool)
-> Eq RuntimeBindingCalled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeBindingCalled -> RuntimeBindingCalled -> Bool
$c/= :: RuntimeBindingCalled -> RuntimeBindingCalled -> Bool
== :: RuntimeBindingCalled -> RuntimeBindingCalled -> Bool
$c== :: RuntimeBindingCalled -> RuntimeBindingCalled -> Bool
Eq, Int -> RuntimeBindingCalled -> ShowS
[RuntimeBindingCalled] -> ShowS
RuntimeBindingCalled -> String
(Int -> RuntimeBindingCalled -> ShowS)
-> (RuntimeBindingCalled -> String)
-> ([RuntimeBindingCalled] -> ShowS)
-> Show RuntimeBindingCalled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeBindingCalled] -> ShowS
$cshowList :: [RuntimeBindingCalled] -> ShowS
show :: RuntimeBindingCalled -> String
$cshow :: RuntimeBindingCalled -> String
showsPrec :: Int -> RuntimeBindingCalled -> ShowS
$cshowsPrec :: Int -> RuntimeBindingCalled -> ShowS
Show)
instance FromJSON RuntimeBindingCalled where
  parseJSON :: Value -> Parser RuntimeBindingCalled
parseJSON = String
-> (Object -> Parser RuntimeBindingCalled)
-> Value
-> Parser RuntimeBindingCalled
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeBindingCalled" ((Object -> Parser RuntimeBindingCalled)
 -> Value -> Parser RuntimeBindingCalled)
-> (Object -> Parser RuntimeBindingCalled)
-> Value
-> Parser RuntimeBindingCalled
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Int -> RuntimeBindingCalled
RuntimeBindingCalled
    (Text -> Text -> Int -> RuntimeBindingCalled)
-> Parser Text -> Parser (Text -> Int -> RuntimeBindingCalled)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"name"
    Parser (Text -> Int -> RuntimeBindingCalled)
-> Parser Text -> Parser (Int -> RuntimeBindingCalled)
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
"payload"
    Parser (Int -> RuntimeBindingCalled)
-> Parser Int -> Parser RuntimeBindingCalled
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
"executionContextId"
instance Event RuntimeBindingCalled where
  eventName :: Proxy RuntimeBindingCalled -> String
eventName Proxy RuntimeBindingCalled
_ = String
"Runtime.bindingCalled"

-- | Type of the 'Runtime.consoleAPICalled' event.
data RuntimeConsoleAPICalledType = RuntimeConsoleAPICalledTypeLog | RuntimeConsoleAPICalledTypeDebug | RuntimeConsoleAPICalledTypeInfo | RuntimeConsoleAPICalledTypeError | RuntimeConsoleAPICalledTypeWarning | RuntimeConsoleAPICalledTypeDir | RuntimeConsoleAPICalledTypeDirxml | RuntimeConsoleAPICalledTypeTable | RuntimeConsoleAPICalledTypeTrace | RuntimeConsoleAPICalledTypeClear | RuntimeConsoleAPICalledTypeStartGroup | RuntimeConsoleAPICalledTypeStartGroupCollapsed | RuntimeConsoleAPICalledTypeEndGroup | RuntimeConsoleAPICalledTypeAssert | RuntimeConsoleAPICalledTypeProfile | RuntimeConsoleAPICalledTypeProfileEnd | RuntimeConsoleAPICalledTypeCount | RuntimeConsoleAPICalledTypeTimeEnd
  deriving (Eq RuntimeConsoleAPICalledType
Eq RuntimeConsoleAPICalledType
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> Ordering)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> Bool)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> Bool)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> Bool)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> Bool)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType)
-> Ord RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> Ordering
RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType
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 :: RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType
$cmin :: RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType
max :: RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType
$cmax :: RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType
>= :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
$c>= :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
> :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
$c> :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
<= :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
$c<= :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
< :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
$c< :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
compare :: RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> Ordering
$ccompare :: RuntimeConsoleAPICalledType
-> RuntimeConsoleAPICalledType -> Ordering
$cp1Ord :: Eq RuntimeConsoleAPICalledType
Ord, RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
(RuntimeConsoleAPICalledType
 -> RuntimeConsoleAPICalledType -> Bool)
-> (RuntimeConsoleAPICalledType
    -> RuntimeConsoleAPICalledType -> Bool)
-> Eq RuntimeConsoleAPICalledType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
$c/= :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
== :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
$c== :: RuntimeConsoleAPICalledType -> RuntimeConsoleAPICalledType -> Bool
Eq, Int -> RuntimeConsoleAPICalledType -> ShowS
[RuntimeConsoleAPICalledType] -> ShowS
RuntimeConsoleAPICalledType -> String
(Int -> RuntimeConsoleAPICalledType -> ShowS)
-> (RuntimeConsoleAPICalledType -> String)
-> ([RuntimeConsoleAPICalledType] -> ShowS)
-> Show RuntimeConsoleAPICalledType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeConsoleAPICalledType] -> ShowS
$cshowList :: [RuntimeConsoleAPICalledType] -> ShowS
show :: RuntimeConsoleAPICalledType -> String
$cshow :: RuntimeConsoleAPICalledType -> String
showsPrec :: Int -> RuntimeConsoleAPICalledType -> ShowS
$cshowsPrec :: Int -> RuntimeConsoleAPICalledType -> ShowS
Show, ReadPrec [RuntimeConsoleAPICalledType]
ReadPrec RuntimeConsoleAPICalledType
Int -> ReadS RuntimeConsoleAPICalledType
ReadS [RuntimeConsoleAPICalledType]
(Int -> ReadS RuntimeConsoleAPICalledType)
-> ReadS [RuntimeConsoleAPICalledType]
-> ReadPrec RuntimeConsoleAPICalledType
-> ReadPrec [RuntimeConsoleAPICalledType]
-> Read RuntimeConsoleAPICalledType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RuntimeConsoleAPICalledType]
$creadListPrec :: ReadPrec [RuntimeConsoleAPICalledType]
readPrec :: ReadPrec RuntimeConsoleAPICalledType
$creadPrec :: ReadPrec RuntimeConsoleAPICalledType
readList :: ReadS [RuntimeConsoleAPICalledType]
$creadList :: ReadS [RuntimeConsoleAPICalledType]
readsPrec :: Int -> ReadS RuntimeConsoleAPICalledType
$creadsPrec :: Int -> ReadS RuntimeConsoleAPICalledType
Read)
instance FromJSON RuntimeConsoleAPICalledType where
  parseJSON :: Value -> Parser RuntimeConsoleAPICalledType
parseJSON = String
-> (Text -> Parser RuntimeConsoleAPICalledType)
-> Value
-> Parser RuntimeConsoleAPICalledType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RuntimeConsoleAPICalledType" ((Text -> Parser RuntimeConsoleAPICalledType)
 -> Value -> Parser RuntimeConsoleAPICalledType)
-> (Text -> Parser RuntimeConsoleAPICalledType)
-> Value
-> Parser RuntimeConsoleAPICalledType
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"log" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeLog
    Text
"debug" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeDebug
    Text
"info" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeInfo
    Text
"error" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeError
    Text
"warning" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeWarning
    Text
"dir" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeDir
    Text
"dirxml" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeDirxml
    Text
"table" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeTable
    Text
"trace" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeTrace
    Text
"clear" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeClear
    Text
"startGroup" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeStartGroup
    Text
"startGroupCollapsed" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeStartGroupCollapsed
    Text
"endGroup" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeEndGroup
    Text
"assert" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeAssert
    Text
"profile" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeProfile
    Text
"profileEnd" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeProfileEnd
    Text
"count" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeCount
    Text
"timeEnd" -> RuntimeConsoleAPICalledType -> Parser RuntimeConsoleAPICalledType
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeTimeEnd
    Text
"_" -> String -> Parser RuntimeConsoleAPICalledType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse RuntimeConsoleAPICalledType"
instance ToJSON RuntimeConsoleAPICalledType where
  toJSON :: RuntimeConsoleAPICalledType -> Value
toJSON RuntimeConsoleAPICalledType
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case RuntimeConsoleAPICalledType
v of
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeLog -> Text
"log"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeDebug -> Text
"debug"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeInfo -> Text
"info"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeError -> Text
"error"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeWarning -> Text
"warning"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeDir -> Text
"dir"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeDirxml -> Text
"dirxml"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeTable -> Text
"table"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeTrace -> Text
"trace"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeClear -> Text
"clear"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeStartGroup -> Text
"startGroup"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeStartGroupCollapsed -> Text
"startGroupCollapsed"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeEndGroup -> Text
"endGroup"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeAssert -> Text
"assert"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeProfile -> Text
"profile"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeProfileEnd -> Text
"profileEnd"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeCount -> Text
"count"
    RuntimeConsoleAPICalledType
RuntimeConsoleAPICalledTypeTimeEnd -> Text
"timeEnd"
data RuntimeConsoleAPICalled = RuntimeConsoleAPICalled
  {
    -- | Type of the call.
    RuntimeConsoleAPICalled -> RuntimeConsoleAPICalledType
runtimeConsoleAPICalledType :: RuntimeConsoleAPICalledType,
    -- | Call arguments.
    RuntimeConsoleAPICalled -> [RuntimeRemoteObject]
runtimeConsoleAPICalledArgs :: [RuntimeRemoteObject],
    -- | Identifier of the context where the call was made.
    RuntimeConsoleAPICalled -> Int
runtimeConsoleAPICalledExecutionContextId :: RuntimeExecutionContextId,
    -- | Call timestamp.
    RuntimeConsoleAPICalled -> RuntimeTimestamp
runtimeConsoleAPICalledTimestamp :: RuntimeTimestamp,
    -- | Stack trace captured when the call was made. The async stack chain is automatically reported for
    --   the following call types: `assert`, `error`, `trace`, `warning`. For other types the async call
    --   chain can be retrieved using `Debugger.getStackTrace` and `stackTrace.parentId` field.
    RuntimeConsoleAPICalled -> Maybe RuntimeStackTrace
runtimeConsoleAPICalledStackTrace :: Maybe RuntimeStackTrace,
    -- | Console context descriptor for calls on non-default console context (not console.*):
    --   'anonymous#unique-logger-id' for call on unnamed context, 'name#unique-logger-id' for call
    --   on named context.
    RuntimeConsoleAPICalled -> Maybe Text
runtimeConsoleAPICalledContext :: Maybe T.Text
  }
  deriving (RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool
(RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool)
-> (RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool)
-> Eq RuntimeConsoleAPICalled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool
$c/= :: RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool
== :: RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool
$c== :: RuntimeConsoleAPICalled -> RuntimeConsoleAPICalled -> Bool
Eq, Int -> RuntimeConsoleAPICalled -> ShowS
[RuntimeConsoleAPICalled] -> ShowS
RuntimeConsoleAPICalled -> String
(Int -> RuntimeConsoleAPICalled -> ShowS)
-> (RuntimeConsoleAPICalled -> String)
-> ([RuntimeConsoleAPICalled] -> ShowS)
-> Show RuntimeConsoleAPICalled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeConsoleAPICalled] -> ShowS
$cshowList :: [RuntimeConsoleAPICalled] -> ShowS
show :: RuntimeConsoleAPICalled -> String
$cshow :: RuntimeConsoleAPICalled -> String
showsPrec :: Int -> RuntimeConsoleAPICalled -> ShowS
$cshowsPrec :: Int -> RuntimeConsoleAPICalled -> ShowS
Show)
instance FromJSON RuntimeConsoleAPICalled where
  parseJSON :: Value -> Parser RuntimeConsoleAPICalled
parseJSON = String
-> (Object -> Parser RuntimeConsoleAPICalled)
-> Value
-> Parser RuntimeConsoleAPICalled
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeConsoleAPICalled" ((Object -> Parser RuntimeConsoleAPICalled)
 -> Value -> Parser RuntimeConsoleAPICalled)
-> (Object -> Parser RuntimeConsoleAPICalled)
-> Value
-> Parser RuntimeConsoleAPICalled
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeConsoleAPICalledType
-> [RuntimeRemoteObject]
-> Int
-> RuntimeTimestamp
-> Maybe RuntimeStackTrace
-> Maybe Text
-> RuntimeConsoleAPICalled
RuntimeConsoleAPICalled
    (RuntimeConsoleAPICalledType
 -> [RuntimeRemoteObject]
 -> Int
 -> RuntimeTimestamp
 -> Maybe RuntimeStackTrace
 -> Maybe Text
 -> RuntimeConsoleAPICalled)
-> Parser RuntimeConsoleAPICalledType
-> Parser
     ([RuntimeRemoteObject]
      -> Int
      -> RuntimeTimestamp
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> RuntimeConsoleAPICalled)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeConsoleAPICalledType
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"type"
    Parser
  ([RuntimeRemoteObject]
   -> Int
   -> RuntimeTimestamp
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> RuntimeConsoleAPICalled)
-> Parser [RuntimeRemoteObject]
-> Parser
     (Int
      -> RuntimeTimestamp
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> RuntimeConsoleAPICalled)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [RuntimeRemoteObject]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"args"
    Parser
  (Int
   -> RuntimeTimestamp
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> RuntimeConsoleAPICalled)
-> Parser Int
-> Parser
     (RuntimeTimestamp
      -> Maybe RuntimeStackTrace
      -> Maybe Text
      -> RuntimeConsoleAPICalled)
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
"executionContextId"
    Parser
  (RuntimeTimestamp
   -> Maybe RuntimeStackTrace
   -> Maybe Text
   -> RuntimeConsoleAPICalled)
-> Parser RuntimeTimestamp
-> Parser
     (Maybe RuntimeStackTrace -> Maybe Text -> RuntimeConsoleAPICalled)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeTimestamp
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"timestamp"
    Parser
  (Maybe RuntimeStackTrace -> Maybe Text -> RuntimeConsoleAPICalled)
-> Parser (Maybe RuntimeStackTrace)
-> Parser (Maybe Text -> RuntimeConsoleAPICalled)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeStackTrace)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"stackTrace"
    Parser (Maybe Text -> RuntimeConsoleAPICalled)
-> Parser (Maybe Text) -> Parser RuntimeConsoleAPICalled
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
"context"
instance Event RuntimeConsoleAPICalled where
  eventName :: Proxy RuntimeConsoleAPICalled -> String
eventName Proxy RuntimeConsoleAPICalled
_ = String
"Runtime.consoleAPICalled"

-- | Type of the 'Runtime.exceptionRevoked' event.
data RuntimeExceptionRevoked = RuntimeExceptionRevoked
  {
    -- | Reason describing why exception was revoked.
    RuntimeExceptionRevoked -> Text
runtimeExceptionRevokedReason :: T.Text,
    -- | The id of revoked exception, as reported in `exceptionThrown`.
    RuntimeExceptionRevoked -> Int
runtimeExceptionRevokedExceptionId :: Int
  }
  deriving (RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool
(RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool)
-> (RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool)
-> Eq RuntimeExceptionRevoked
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool
$c/= :: RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool
== :: RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool
$c== :: RuntimeExceptionRevoked -> RuntimeExceptionRevoked -> Bool
Eq, Int -> RuntimeExceptionRevoked -> ShowS
[RuntimeExceptionRevoked] -> ShowS
RuntimeExceptionRevoked -> String
(Int -> RuntimeExceptionRevoked -> ShowS)
-> (RuntimeExceptionRevoked -> String)
-> ([RuntimeExceptionRevoked] -> ShowS)
-> Show RuntimeExceptionRevoked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeExceptionRevoked] -> ShowS
$cshowList :: [RuntimeExceptionRevoked] -> ShowS
show :: RuntimeExceptionRevoked -> String
$cshow :: RuntimeExceptionRevoked -> String
showsPrec :: Int -> RuntimeExceptionRevoked -> ShowS
$cshowsPrec :: Int -> RuntimeExceptionRevoked -> ShowS
Show)
instance FromJSON RuntimeExceptionRevoked where
  parseJSON :: Value -> Parser RuntimeExceptionRevoked
parseJSON = String
-> (Object -> Parser RuntimeExceptionRevoked)
-> Value
-> Parser RuntimeExceptionRevoked
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeExceptionRevoked" ((Object -> Parser RuntimeExceptionRevoked)
 -> Value -> Parser RuntimeExceptionRevoked)
-> (Object -> Parser RuntimeExceptionRevoked)
-> Value
-> Parser RuntimeExceptionRevoked
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Int -> RuntimeExceptionRevoked
RuntimeExceptionRevoked
    (Text -> Int -> RuntimeExceptionRevoked)
-> Parser Text -> Parser (Int -> RuntimeExceptionRevoked)
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
"reason"
    Parser (Int -> RuntimeExceptionRevoked)
-> Parser Int -> Parser RuntimeExceptionRevoked
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
"exceptionId"
instance Event RuntimeExceptionRevoked where
  eventName :: Proxy RuntimeExceptionRevoked -> String
eventName Proxy RuntimeExceptionRevoked
_ = String
"Runtime.exceptionRevoked"

-- | Type of the 'Runtime.exceptionThrown' event.
data RuntimeExceptionThrown = RuntimeExceptionThrown
  {
    -- | Timestamp of the exception.
    RuntimeExceptionThrown -> RuntimeTimestamp
runtimeExceptionThrownTimestamp :: RuntimeTimestamp,
    RuntimeExceptionThrown -> RuntimeExceptionDetails
runtimeExceptionThrownExceptionDetails :: RuntimeExceptionDetails
  }
  deriving (RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool
(RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool)
-> (RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool)
-> Eq RuntimeExceptionThrown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool
$c/= :: RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool
== :: RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool
$c== :: RuntimeExceptionThrown -> RuntimeExceptionThrown -> Bool
Eq, Int -> RuntimeExceptionThrown -> ShowS
[RuntimeExceptionThrown] -> ShowS
RuntimeExceptionThrown -> String
(Int -> RuntimeExceptionThrown -> ShowS)
-> (RuntimeExceptionThrown -> String)
-> ([RuntimeExceptionThrown] -> ShowS)
-> Show RuntimeExceptionThrown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeExceptionThrown] -> ShowS
$cshowList :: [RuntimeExceptionThrown] -> ShowS
show :: RuntimeExceptionThrown -> String
$cshow :: RuntimeExceptionThrown -> String
showsPrec :: Int -> RuntimeExceptionThrown -> ShowS
$cshowsPrec :: Int -> RuntimeExceptionThrown -> ShowS
Show)
instance FromJSON RuntimeExceptionThrown where
  parseJSON :: Value -> Parser RuntimeExceptionThrown
parseJSON = String
-> (Object -> Parser RuntimeExceptionThrown)
-> Value
-> Parser RuntimeExceptionThrown
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeExceptionThrown" ((Object -> Parser RuntimeExceptionThrown)
 -> Value -> Parser RuntimeExceptionThrown)
-> (Object -> Parser RuntimeExceptionThrown)
-> Value
-> Parser RuntimeExceptionThrown
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeTimestamp
-> RuntimeExceptionDetails -> RuntimeExceptionThrown
RuntimeExceptionThrown
    (RuntimeTimestamp
 -> RuntimeExceptionDetails -> RuntimeExceptionThrown)
-> Parser RuntimeTimestamp
-> Parser (RuntimeExceptionDetails -> RuntimeExceptionThrown)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeTimestamp
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"timestamp"
    Parser (RuntimeExceptionDetails -> RuntimeExceptionThrown)
-> Parser RuntimeExceptionDetails -> Parser RuntimeExceptionThrown
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeExceptionDetails
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"exceptionDetails"
instance Event RuntimeExceptionThrown where
  eventName :: Proxy RuntimeExceptionThrown -> String
eventName Proxy RuntimeExceptionThrown
_ = String
"Runtime.exceptionThrown"

-- | Type of the 'Runtime.executionContextCreated' event.
data RuntimeExecutionContextCreated = RuntimeExecutionContextCreated
  {
    -- | A newly created execution context.
    RuntimeExecutionContextCreated
-> RuntimeExecutionContextDescription
runtimeExecutionContextCreatedContext :: RuntimeExecutionContextDescription
  }
  deriving (RuntimeExecutionContextCreated
-> RuntimeExecutionContextCreated -> Bool
(RuntimeExecutionContextCreated
 -> RuntimeExecutionContextCreated -> Bool)
-> (RuntimeExecutionContextCreated
    -> RuntimeExecutionContextCreated -> Bool)
-> Eq RuntimeExecutionContextCreated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeExecutionContextCreated
-> RuntimeExecutionContextCreated -> Bool
$c/= :: RuntimeExecutionContextCreated
-> RuntimeExecutionContextCreated -> Bool
== :: RuntimeExecutionContextCreated
-> RuntimeExecutionContextCreated -> Bool
$c== :: RuntimeExecutionContextCreated
-> RuntimeExecutionContextCreated -> Bool
Eq, Int -> RuntimeExecutionContextCreated -> ShowS
[RuntimeExecutionContextCreated] -> ShowS
RuntimeExecutionContextCreated -> String
(Int -> RuntimeExecutionContextCreated -> ShowS)
-> (RuntimeExecutionContextCreated -> String)
-> ([RuntimeExecutionContextCreated] -> ShowS)
-> Show RuntimeExecutionContextCreated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeExecutionContextCreated] -> ShowS
$cshowList :: [RuntimeExecutionContextCreated] -> ShowS
show :: RuntimeExecutionContextCreated -> String
$cshow :: RuntimeExecutionContextCreated -> String
showsPrec :: Int -> RuntimeExecutionContextCreated -> ShowS
$cshowsPrec :: Int -> RuntimeExecutionContextCreated -> ShowS
Show)
instance FromJSON RuntimeExecutionContextCreated where
  parseJSON :: Value -> Parser RuntimeExecutionContextCreated
parseJSON = String
-> (Object -> Parser RuntimeExecutionContextCreated)
-> Value
-> Parser RuntimeExecutionContextCreated
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeExecutionContextCreated" ((Object -> Parser RuntimeExecutionContextCreated)
 -> Value -> Parser RuntimeExecutionContextCreated)
-> (Object -> Parser RuntimeExecutionContextCreated)
-> Value
-> Parser RuntimeExecutionContextCreated
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeExecutionContextDescription
-> RuntimeExecutionContextCreated
RuntimeExecutionContextCreated
    (RuntimeExecutionContextDescription
 -> RuntimeExecutionContextCreated)
-> Parser RuntimeExecutionContextDescription
-> Parser RuntimeExecutionContextCreated
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeExecutionContextDescription
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"context"
instance Event RuntimeExecutionContextCreated where
  eventName :: Proxy RuntimeExecutionContextCreated -> String
eventName Proxy RuntimeExecutionContextCreated
_ = String
"Runtime.executionContextCreated"

-- | Type of the 'Runtime.executionContextDestroyed' event.
data RuntimeExecutionContextDestroyed = RuntimeExecutionContextDestroyed
  {
    -- | Id of the destroyed context
    RuntimeExecutionContextDestroyed -> Int
runtimeExecutionContextDestroyedExecutionContextId :: RuntimeExecutionContextId
  }
  deriving (RuntimeExecutionContextDestroyed
-> RuntimeExecutionContextDestroyed -> Bool
(RuntimeExecutionContextDestroyed
 -> RuntimeExecutionContextDestroyed -> Bool)
-> (RuntimeExecutionContextDestroyed
    -> RuntimeExecutionContextDestroyed -> Bool)
-> Eq RuntimeExecutionContextDestroyed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeExecutionContextDestroyed
-> RuntimeExecutionContextDestroyed -> Bool
$c/= :: RuntimeExecutionContextDestroyed
-> RuntimeExecutionContextDestroyed -> Bool
== :: RuntimeExecutionContextDestroyed
-> RuntimeExecutionContextDestroyed -> Bool
$c== :: RuntimeExecutionContextDestroyed
-> RuntimeExecutionContextDestroyed -> Bool
Eq, Int -> RuntimeExecutionContextDestroyed -> ShowS
[RuntimeExecutionContextDestroyed] -> ShowS
RuntimeExecutionContextDestroyed -> String
(Int -> RuntimeExecutionContextDestroyed -> ShowS)
-> (RuntimeExecutionContextDestroyed -> String)
-> ([RuntimeExecutionContextDestroyed] -> ShowS)
-> Show RuntimeExecutionContextDestroyed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeExecutionContextDestroyed] -> ShowS
$cshowList :: [RuntimeExecutionContextDestroyed] -> ShowS
show :: RuntimeExecutionContextDestroyed -> String
$cshow :: RuntimeExecutionContextDestroyed -> String
showsPrec :: Int -> RuntimeExecutionContextDestroyed -> ShowS
$cshowsPrec :: Int -> RuntimeExecutionContextDestroyed -> ShowS
Show)
instance FromJSON RuntimeExecutionContextDestroyed where
  parseJSON :: Value -> Parser RuntimeExecutionContextDestroyed
parseJSON = String
-> (Object -> Parser RuntimeExecutionContextDestroyed)
-> Value
-> Parser RuntimeExecutionContextDestroyed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeExecutionContextDestroyed" ((Object -> Parser RuntimeExecutionContextDestroyed)
 -> Value -> Parser RuntimeExecutionContextDestroyed)
-> (Object -> Parser RuntimeExecutionContextDestroyed)
-> Value
-> Parser RuntimeExecutionContextDestroyed
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> RuntimeExecutionContextDestroyed
RuntimeExecutionContextDestroyed
    (Int -> RuntimeExecutionContextDestroyed)
-> Parser Int -> Parser RuntimeExecutionContextDestroyed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"executionContextId"
instance Event RuntimeExecutionContextDestroyed where
  eventName :: Proxy RuntimeExecutionContextDestroyed -> String
eventName Proxy RuntimeExecutionContextDestroyed
_ = String
"Runtime.executionContextDestroyed"

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

-- | Type of the 'Runtime.inspectRequested' event.
data RuntimeInspectRequested = RuntimeInspectRequested
  {
    RuntimeInspectRequested -> RuntimeRemoteObject
runtimeInspectRequestedObject :: RuntimeRemoteObject,
    RuntimeInspectRequested -> [(Text, Text)]
runtimeInspectRequestedHints :: [(T.Text, T.Text)],
    -- | Identifier of the context where the call was made.
    RuntimeInspectRequested -> Maybe Int
runtimeInspectRequestedExecutionContextId :: Maybe RuntimeExecutionContextId
  }
  deriving (RuntimeInspectRequested -> RuntimeInspectRequested -> Bool
(RuntimeInspectRequested -> RuntimeInspectRequested -> Bool)
-> (RuntimeInspectRequested -> RuntimeInspectRequested -> Bool)
-> Eq RuntimeInspectRequested
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeInspectRequested -> RuntimeInspectRequested -> Bool
$c/= :: RuntimeInspectRequested -> RuntimeInspectRequested -> Bool
== :: RuntimeInspectRequested -> RuntimeInspectRequested -> Bool
$c== :: RuntimeInspectRequested -> RuntimeInspectRequested -> Bool
Eq, Int -> RuntimeInspectRequested -> ShowS
[RuntimeInspectRequested] -> ShowS
RuntimeInspectRequested -> String
(Int -> RuntimeInspectRequested -> ShowS)
-> (RuntimeInspectRequested -> String)
-> ([RuntimeInspectRequested] -> ShowS)
-> Show RuntimeInspectRequested
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeInspectRequested] -> ShowS
$cshowList :: [RuntimeInspectRequested] -> ShowS
show :: RuntimeInspectRequested -> String
$cshow :: RuntimeInspectRequested -> String
showsPrec :: Int -> RuntimeInspectRequested -> ShowS
$cshowsPrec :: Int -> RuntimeInspectRequested -> ShowS
Show)
instance FromJSON RuntimeInspectRequested where
  parseJSON :: Value -> Parser RuntimeInspectRequested
parseJSON = String
-> (Object -> Parser RuntimeInspectRequested)
-> Value
-> Parser RuntimeInspectRequested
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeInspectRequested" ((Object -> Parser RuntimeInspectRequested)
 -> Value -> Parser RuntimeInspectRequested)
-> (Object -> Parser RuntimeInspectRequested)
-> Value
-> Parser RuntimeInspectRequested
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> [(Text, Text)] -> Maybe Int -> RuntimeInspectRequested
RuntimeInspectRequested
    (RuntimeRemoteObject
 -> [(Text, Text)] -> Maybe Int -> RuntimeInspectRequested)
-> Parser RuntimeRemoteObject
-> Parser ([(Text, Text)] -> Maybe Int -> RuntimeInspectRequested)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"object"
    Parser ([(Text, Text)] -> Maybe Int -> RuntimeInspectRequested)
-> Parser [(Text, Text)]
-> Parser (Maybe Int -> RuntimeInspectRequested)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [(Text, Text)]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"hints"
    Parser (Maybe Int -> RuntimeInspectRequested)
-> Parser (Maybe Int) -> Parser RuntimeInspectRequested
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
"executionContextId"
instance Event RuntimeInspectRequested where
  eventName :: Proxy RuntimeInspectRequested -> String
eventName Proxy RuntimeInspectRequested
_ = String
"Runtime.inspectRequested"

-- | Add handler to promise with given promise object id.

-- | Parameters of the 'Runtime.awaitPromise' command.
data PRuntimeAwaitPromise = PRuntimeAwaitPromise
  {
    -- | Identifier of the promise.
    PRuntimeAwaitPromise -> Text
pRuntimeAwaitPromisePromiseObjectId :: RuntimeRemoteObjectId,
    -- | Whether the result is expected to be a JSON object that should be sent by value.
    PRuntimeAwaitPromise -> Maybe Bool
pRuntimeAwaitPromiseReturnByValue :: Maybe Bool,
    -- | Whether preview should be generated for the result.
    PRuntimeAwaitPromise -> Maybe Bool
pRuntimeAwaitPromiseGeneratePreview :: Maybe Bool
  }
  deriving (PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool
(PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool)
-> (PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool)
-> Eq PRuntimeAwaitPromise
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool
$c/= :: PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool
== :: PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool
$c== :: PRuntimeAwaitPromise -> PRuntimeAwaitPromise -> Bool
Eq, Int -> PRuntimeAwaitPromise -> ShowS
[PRuntimeAwaitPromise] -> ShowS
PRuntimeAwaitPromise -> String
(Int -> PRuntimeAwaitPromise -> ShowS)
-> (PRuntimeAwaitPromise -> String)
-> ([PRuntimeAwaitPromise] -> ShowS)
-> Show PRuntimeAwaitPromise
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeAwaitPromise] -> ShowS
$cshowList :: [PRuntimeAwaitPromise] -> ShowS
show :: PRuntimeAwaitPromise -> String
$cshow :: PRuntimeAwaitPromise -> String
showsPrec :: Int -> PRuntimeAwaitPromise -> ShowS
$cshowsPrec :: Int -> PRuntimeAwaitPromise -> ShowS
Show)
pRuntimeAwaitPromise
  {-
  -- | Identifier of the promise.
  -}
  :: RuntimeRemoteObjectId
  -> PRuntimeAwaitPromise
pRuntimeAwaitPromise :: Text -> PRuntimeAwaitPromise
pRuntimeAwaitPromise
  Text
arg_pRuntimeAwaitPromisePromiseObjectId
  = Text -> Maybe Bool -> Maybe Bool -> PRuntimeAwaitPromise
PRuntimeAwaitPromise
    Text
arg_pRuntimeAwaitPromisePromiseObjectId
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PRuntimeAwaitPromise where
  toJSON :: PRuntimeAwaitPromise -> Value
toJSON PRuntimeAwaitPromise
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
"promiseObjectId" 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 (PRuntimeAwaitPromise -> Text
pRuntimeAwaitPromisePromiseObjectId PRuntimeAwaitPromise
p),
    (Text
"returnByValue" 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
<$> (PRuntimeAwaitPromise -> Maybe Bool
pRuntimeAwaitPromiseReturnByValue PRuntimeAwaitPromise
p),
    (Text
"generatePreview" 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
<$> (PRuntimeAwaitPromise -> Maybe Bool
pRuntimeAwaitPromiseGeneratePreview PRuntimeAwaitPromise
p)
    ]
data RuntimeAwaitPromise = RuntimeAwaitPromise
  {
    -- | Promise result. Will contain rejected value if promise was rejected.
    RuntimeAwaitPromise -> RuntimeRemoteObject
runtimeAwaitPromiseResult :: RuntimeRemoteObject,
    -- | Exception details if stack strace is available.
    RuntimeAwaitPromise -> Maybe RuntimeExceptionDetails
runtimeAwaitPromiseExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool
(RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool)
-> (RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool)
-> Eq RuntimeAwaitPromise
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool
$c/= :: RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool
== :: RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool
$c== :: RuntimeAwaitPromise -> RuntimeAwaitPromise -> Bool
Eq, Int -> RuntimeAwaitPromise -> ShowS
[RuntimeAwaitPromise] -> ShowS
RuntimeAwaitPromise -> String
(Int -> RuntimeAwaitPromise -> ShowS)
-> (RuntimeAwaitPromise -> String)
-> ([RuntimeAwaitPromise] -> ShowS)
-> Show RuntimeAwaitPromise
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeAwaitPromise] -> ShowS
$cshowList :: [RuntimeAwaitPromise] -> ShowS
show :: RuntimeAwaitPromise -> String
$cshow :: RuntimeAwaitPromise -> String
showsPrec :: Int -> RuntimeAwaitPromise -> ShowS
$cshowsPrec :: Int -> RuntimeAwaitPromise -> ShowS
Show)
instance FromJSON RuntimeAwaitPromise where
  parseJSON :: Value -> Parser RuntimeAwaitPromise
parseJSON = String
-> (Object -> Parser RuntimeAwaitPromise)
-> Value
-> Parser RuntimeAwaitPromise
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeAwaitPromise" ((Object -> Parser RuntimeAwaitPromise)
 -> Value -> Parser RuntimeAwaitPromise)
-> (Object -> Parser RuntimeAwaitPromise)
-> Value
-> Parser RuntimeAwaitPromise
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> Maybe RuntimeExceptionDetails -> RuntimeAwaitPromise
RuntimeAwaitPromise
    (RuntimeRemoteObject
 -> Maybe RuntimeExceptionDetails -> RuntimeAwaitPromise)
-> Parser RuntimeRemoteObject
-> Parser (Maybe RuntimeExceptionDetails -> RuntimeAwaitPromise)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
    Parser (Maybe RuntimeExceptionDetails -> RuntimeAwaitPromise)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser RuntimeAwaitPromise
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeAwaitPromise where
  type CommandResponse PRuntimeAwaitPromise = RuntimeAwaitPromise
  commandName :: Proxy PRuntimeAwaitPromise -> String
commandName Proxy PRuntimeAwaitPromise
_ = String
"Runtime.awaitPromise"

-- | Calls function with given declaration on the given object. Object group of the result is
--   inherited from the target object.

-- | Parameters of the 'Runtime.callFunctionOn' command.
data PRuntimeCallFunctionOn = PRuntimeCallFunctionOn
  {
    -- | Declaration of the function to call.
    PRuntimeCallFunctionOn -> Text
pRuntimeCallFunctionOnFunctionDeclaration :: T.Text,
    -- | Identifier of the object to call function on. Either objectId or executionContextId should
    --   be specified.
    PRuntimeCallFunctionOn -> Maybe Text
pRuntimeCallFunctionOnObjectId :: Maybe RuntimeRemoteObjectId,
    -- | Call arguments. All call arguments must belong to the same JavaScript world as the target
    --   object.
    PRuntimeCallFunctionOn -> Maybe [RuntimeCallArgument]
pRuntimeCallFunctionOnArguments :: Maybe [RuntimeCallArgument],
    -- | In silent mode exceptions thrown during evaluation are not reported and do not pause
    --   execution. Overrides `setPauseOnException` state.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnSilent :: Maybe Bool,
    -- | Whether the result is expected to be a JSON object which should be sent by value.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnReturnByValue :: Maybe Bool,
    -- | Whether preview should be generated for the result.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnGeneratePreview :: Maybe Bool,
    -- | Whether execution should be treated as initiated by user in the UI.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnUserGesture :: Maybe Bool,
    -- | Whether execution should `await` for resulting value and return once awaited promise is
    --   resolved.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnAwaitPromise :: Maybe Bool,
    -- | Specifies execution context which global object will be used to call function on. Either
    --   executionContextId or objectId should be specified.
    PRuntimeCallFunctionOn -> Maybe Int
pRuntimeCallFunctionOnExecutionContextId :: Maybe RuntimeExecutionContextId,
    -- | Symbolic group name that can be used to release multiple objects. If objectGroup is not
    --   specified and objectId is, objectGroup will be inherited from object.
    PRuntimeCallFunctionOn -> Maybe Text
pRuntimeCallFunctionOnObjectGroup :: Maybe T.Text,
    -- | Whether to throw an exception if side effect cannot be ruled out during evaluation.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnThrowOnSideEffect :: Maybe Bool,
    -- | Whether the result should contain `webDriverValue`, serialized according to
    --   https://w3c.github.io/webdriver-bidi. This is mutually exclusive with `returnByValue`, but
    --   resulting `objectId` is still provided.
    PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnGenerateWebDriverValue :: Maybe Bool
  }
  deriving (PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool
(PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool)
-> (PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool)
-> Eq PRuntimeCallFunctionOn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool
$c/= :: PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool
== :: PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool
$c== :: PRuntimeCallFunctionOn -> PRuntimeCallFunctionOn -> Bool
Eq, Int -> PRuntimeCallFunctionOn -> ShowS
[PRuntimeCallFunctionOn] -> ShowS
PRuntimeCallFunctionOn -> String
(Int -> PRuntimeCallFunctionOn -> ShowS)
-> (PRuntimeCallFunctionOn -> String)
-> ([PRuntimeCallFunctionOn] -> ShowS)
-> Show PRuntimeCallFunctionOn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeCallFunctionOn] -> ShowS
$cshowList :: [PRuntimeCallFunctionOn] -> ShowS
show :: PRuntimeCallFunctionOn -> String
$cshow :: PRuntimeCallFunctionOn -> String
showsPrec :: Int -> PRuntimeCallFunctionOn -> ShowS
$cshowsPrec :: Int -> PRuntimeCallFunctionOn -> ShowS
Show)
pRuntimeCallFunctionOn
  {-
  -- | Declaration of the function to call.
  -}
  :: T.Text
  -> PRuntimeCallFunctionOn
pRuntimeCallFunctionOn :: Text -> PRuntimeCallFunctionOn
pRuntimeCallFunctionOn
  Text
arg_pRuntimeCallFunctionOnFunctionDeclaration
  = Text
-> Maybe Text
-> Maybe [RuntimeCallArgument]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> PRuntimeCallFunctionOn
PRuntimeCallFunctionOn
    Text
arg_pRuntimeCallFunctionOnFunctionDeclaration
    Maybe Text
forall a. Maybe a
Nothing
    Maybe [RuntimeCallArgument]
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PRuntimeCallFunctionOn where
  toJSON :: PRuntimeCallFunctionOn -> Value
toJSON PRuntimeCallFunctionOn
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
"functionDeclaration" 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 (PRuntimeCallFunctionOn -> Text
pRuntimeCallFunctionOnFunctionDeclaration PRuntimeCallFunctionOn
p),
    (Text
"objectId" 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
<$> (PRuntimeCallFunctionOn -> Maybe Text
pRuntimeCallFunctionOnObjectId PRuntimeCallFunctionOn
p),
    (Text
"arguments" Text -> [RuntimeCallArgument] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([RuntimeCallArgument] -> Pair)
-> Maybe [RuntimeCallArgument] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PRuntimeCallFunctionOn -> Maybe [RuntimeCallArgument]
pRuntimeCallFunctionOnArguments PRuntimeCallFunctionOn
p),
    (Text
"silent" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnSilent PRuntimeCallFunctionOn
p),
    (Text
"returnByValue" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnReturnByValue PRuntimeCallFunctionOn
p),
    (Text
"generatePreview" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnGeneratePreview PRuntimeCallFunctionOn
p),
    (Text
"userGesture" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnUserGesture PRuntimeCallFunctionOn
p),
    (Text
"awaitPromise" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnAwaitPromise PRuntimeCallFunctionOn
p),
    (Text
"executionContextId" 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
<$> (PRuntimeCallFunctionOn -> Maybe Int
pRuntimeCallFunctionOnExecutionContextId PRuntimeCallFunctionOn
p),
    (Text
"objectGroup" 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
<$> (PRuntimeCallFunctionOn -> Maybe Text
pRuntimeCallFunctionOnObjectGroup PRuntimeCallFunctionOn
p),
    (Text
"throwOnSideEffect" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnThrowOnSideEffect PRuntimeCallFunctionOn
p),
    (Text
"generateWebDriverValue" 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
<$> (PRuntimeCallFunctionOn -> Maybe Bool
pRuntimeCallFunctionOnGenerateWebDriverValue PRuntimeCallFunctionOn
p)
    ]
data RuntimeCallFunctionOn = RuntimeCallFunctionOn
  {
    -- | Call result.
    RuntimeCallFunctionOn -> RuntimeRemoteObject
runtimeCallFunctionOnResult :: RuntimeRemoteObject,
    -- | Exception details.
    RuntimeCallFunctionOn -> Maybe RuntimeExceptionDetails
runtimeCallFunctionOnExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool
(RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool)
-> (RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool)
-> Eq RuntimeCallFunctionOn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool
$c/= :: RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool
== :: RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool
$c== :: RuntimeCallFunctionOn -> RuntimeCallFunctionOn -> Bool
Eq, Int -> RuntimeCallFunctionOn -> ShowS
[RuntimeCallFunctionOn] -> ShowS
RuntimeCallFunctionOn -> String
(Int -> RuntimeCallFunctionOn -> ShowS)
-> (RuntimeCallFunctionOn -> String)
-> ([RuntimeCallFunctionOn] -> ShowS)
-> Show RuntimeCallFunctionOn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCallFunctionOn] -> ShowS
$cshowList :: [RuntimeCallFunctionOn] -> ShowS
show :: RuntimeCallFunctionOn -> String
$cshow :: RuntimeCallFunctionOn -> String
showsPrec :: Int -> RuntimeCallFunctionOn -> ShowS
$cshowsPrec :: Int -> RuntimeCallFunctionOn -> ShowS
Show)
instance FromJSON RuntimeCallFunctionOn where
  parseJSON :: Value -> Parser RuntimeCallFunctionOn
parseJSON = String
-> (Object -> Parser RuntimeCallFunctionOn)
-> Value
-> Parser RuntimeCallFunctionOn
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeCallFunctionOn" ((Object -> Parser RuntimeCallFunctionOn)
 -> Value -> Parser RuntimeCallFunctionOn)
-> (Object -> Parser RuntimeCallFunctionOn)
-> Value
-> Parser RuntimeCallFunctionOn
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> Maybe RuntimeExceptionDetails -> RuntimeCallFunctionOn
RuntimeCallFunctionOn
    (RuntimeRemoteObject
 -> Maybe RuntimeExceptionDetails -> RuntimeCallFunctionOn)
-> Parser RuntimeRemoteObject
-> Parser (Maybe RuntimeExceptionDetails -> RuntimeCallFunctionOn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
    Parser (Maybe RuntimeExceptionDetails -> RuntimeCallFunctionOn)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser RuntimeCallFunctionOn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeCallFunctionOn where
  type CommandResponse PRuntimeCallFunctionOn = RuntimeCallFunctionOn
  commandName :: Proxy PRuntimeCallFunctionOn -> String
commandName Proxy PRuntimeCallFunctionOn
_ = String
"Runtime.callFunctionOn"

-- | Compiles expression.

-- | Parameters of the 'Runtime.compileScript' command.
data PRuntimeCompileScript = PRuntimeCompileScript
  {
    -- | Expression to compile.
    PRuntimeCompileScript -> Text
pRuntimeCompileScriptExpression :: T.Text,
    -- | Source url to be set for the script.
    PRuntimeCompileScript -> Text
pRuntimeCompileScriptSourceURL :: T.Text,
    -- | Specifies whether the compiled script should be persisted.
    PRuntimeCompileScript -> Bool
pRuntimeCompileScriptPersistScript :: Bool,
    -- | Specifies in which execution context to perform script run. If the parameter is omitted the
    --   evaluation will be performed in the context of the inspected page.
    PRuntimeCompileScript -> Maybe Int
pRuntimeCompileScriptExecutionContextId :: Maybe RuntimeExecutionContextId
  }
  deriving (PRuntimeCompileScript -> PRuntimeCompileScript -> Bool
(PRuntimeCompileScript -> PRuntimeCompileScript -> Bool)
-> (PRuntimeCompileScript -> PRuntimeCompileScript -> Bool)
-> Eq PRuntimeCompileScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeCompileScript -> PRuntimeCompileScript -> Bool
$c/= :: PRuntimeCompileScript -> PRuntimeCompileScript -> Bool
== :: PRuntimeCompileScript -> PRuntimeCompileScript -> Bool
$c== :: PRuntimeCompileScript -> PRuntimeCompileScript -> Bool
Eq, Int -> PRuntimeCompileScript -> ShowS
[PRuntimeCompileScript] -> ShowS
PRuntimeCompileScript -> String
(Int -> PRuntimeCompileScript -> ShowS)
-> (PRuntimeCompileScript -> String)
-> ([PRuntimeCompileScript] -> ShowS)
-> Show PRuntimeCompileScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeCompileScript] -> ShowS
$cshowList :: [PRuntimeCompileScript] -> ShowS
show :: PRuntimeCompileScript -> String
$cshow :: PRuntimeCompileScript -> String
showsPrec :: Int -> PRuntimeCompileScript -> ShowS
$cshowsPrec :: Int -> PRuntimeCompileScript -> ShowS
Show)
pRuntimeCompileScript
  {-
  -- | Expression to compile.
  -}
  :: T.Text
  {-
  -- | Source url to be set for the script.
  -}
  -> T.Text
  {-
  -- | Specifies whether the compiled script should be persisted.
  -}
  -> Bool
  -> PRuntimeCompileScript
pRuntimeCompileScript :: Text -> Text -> Bool -> PRuntimeCompileScript
pRuntimeCompileScript
  Text
arg_pRuntimeCompileScriptExpression
  Text
arg_pRuntimeCompileScriptSourceURL
  Bool
arg_pRuntimeCompileScriptPersistScript
  = Text -> Text -> Bool -> Maybe Int -> PRuntimeCompileScript
PRuntimeCompileScript
    Text
arg_pRuntimeCompileScriptExpression
    Text
arg_pRuntimeCompileScriptSourceURL
    Bool
arg_pRuntimeCompileScriptPersistScript
    Maybe Int
forall a. Maybe a
Nothing
instance ToJSON PRuntimeCompileScript where
  toJSON :: PRuntimeCompileScript -> Value
toJSON PRuntimeCompileScript
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
"expression" 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 (PRuntimeCompileScript -> Text
pRuntimeCompileScriptExpression PRuntimeCompileScript
p),
    (Text
"sourceURL" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PRuntimeCompileScript -> Text
pRuntimeCompileScriptSourceURL PRuntimeCompileScript
p),
    (Text
"persistScript" 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 (PRuntimeCompileScript -> Bool
pRuntimeCompileScriptPersistScript PRuntimeCompileScript
p),
    (Text
"executionContextId" 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
<$> (PRuntimeCompileScript -> Maybe Int
pRuntimeCompileScriptExecutionContextId PRuntimeCompileScript
p)
    ]
data RuntimeCompileScript = RuntimeCompileScript
  {
    -- | Id of the script.
    RuntimeCompileScript -> Maybe Text
runtimeCompileScriptScriptId :: Maybe RuntimeScriptId,
    -- | Exception details.
    RuntimeCompileScript -> Maybe RuntimeExceptionDetails
runtimeCompileScriptExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeCompileScript -> RuntimeCompileScript -> Bool
(RuntimeCompileScript -> RuntimeCompileScript -> Bool)
-> (RuntimeCompileScript -> RuntimeCompileScript -> Bool)
-> Eq RuntimeCompileScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCompileScript -> RuntimeCompileScript -> Bool
$c/= :: RuntimeCompileScript -> RuntimeCompileScript -> Bool
== :: RuntimeCompileScript -> RuntimeCompileScript -> Bool
$c== :: RuntimeCompileScript -> RuntimeCompileScript -> Bool
Eq, Int -> RuntimeCompileScript -> ShowS
[RuntimeCompileScript] -> ShowS
RuntimeCompileScript -> String
(Int -> RuntimeCompileScript -> ShowS)
-> (RuntimeCompileScript -> String)
-> ([RuntimeCompileScript] -> ShowS)
-> Show RuntimeCompileScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCompileScript] -> ShowS
$cshowList :: [RuntimeCompileScript] -> ShowS
show :: RuntimeCompileScript -> String
$cshow :: RuntimeCompileScript -> String
showsPrec :: Int -> RuntimeCompileScript -> ShowS
$cshowsPrec :: Int -> RuntimeCompileScript -> ShowS
Show)
instance FromJSON RuntimeCompileScript where
  parseJSON :: Value -> Parser RuntimeCompileScript
parseJSON = String
-> (Object -> Parser RuntimeCompileScript)
-> Value
-> Parser RuntimeCompileScript
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeCompileScript" ((Object -> Parser RuntimeCompileScript)
 -> Value -> Parser RuntimeCompileScript)
-> (Object -> Parser RuntimeCompileScript)
-> Value
-> Parser RuntimeCompileScript
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text -> Maybe RuntimeExceptionDetails -> RuntimeCompileScript
RuntimeCompileScript
    (Maybe Text
 -> Maybe RuntimeExceptionDetails -> RuntimeCompileScript)
-> Parser (Maybe Text)
-> Parser (Maybe RuntimeExceptionDetails -> RuntimeCompileScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"scriptId"
    Parser (Maybe RuntimeExceptionDetails -> RuntimeCompileScript)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser RuntimeCompileScript
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeCompileScript where
  type CommandResponse PRuntimeCompileScript = RuntimeCompileScript
  commandName :: Proxy PRuntimeCompileScript -> String
commandName Proxy PRuntimeCompileScript
_ = String
"Runtime.compileScript"

-- | Disables reporting of execution contexts creation.

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

-- | Discards collected exceptions and console API calls.

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

-- | Enables reporting of execution contexts creation by means of `executionContextCreated` event.
--   When the reporting gets enabled the event will be sent immediately for each existing execution
--   context.

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

-- | Evaluates expression on global object.

-- | Parameters of the 'Runtime.evaluate' command.
data PRuntimeEvaluate = PRuntimeEvaluate
  {
    -- | Expression to evaluate.
    PRuntimeEvaluate -> Text
pRuntimeEvaluateExpression :: T.Text,
    -- | Symbolic group name that can be used to release multiple objects.
    PRuntimeEvaluate -> Maybe Text
pRuntimeEvaluateObjectGroup :: Maybe T.Text,
    -- | Determines whether Command Line API should be available during the evaluation.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateIncludeCommandLineAPI :: Maybe Bool,
    -- | In silent mode exceptions thrown during evaluation are not reported and do not pause
    --   execution. Overrides `setPauseOnException` state.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateSilent :: Maybe Bool,
    -- | Specifies in which execution context to perform evaluation. If the parameter is omitted the
    --   evaluation will be performed in the context of the inspected page.
    --   This is mutually exclusive with `uniqueContextId`, which offers an
    --   alternative way to identify the execution context that is more reliable
    --   in a multi-process environment.
    PRuntimeEvaluate -> Maybe Int
pRuntimeEvaluateContextId :: Maybe RuntimeExecutionContextId,
    -- | Whether the result is expected to be a JSON object that should be sent by value.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateReturnByValue :: Maybe Bool,
    -- | Whether preview should be generated for the result.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateGeneratePreview :: Maybe Bool,
    -- | Whether execution should be treated as initiated by user in the UI.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateUserGesture :: Maybe Bool,
    -- | Whether execution should `await` for resulting value and return once awaited promise is
    --   resolved.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateAwaitPromise :: Maybe Bool,
    -- | Whether to throw an exception if side effect cannot be ruled out during evaluation.
    --   This implies `disableBreaks` below.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateThrowOnSideEffect :: Maybe Bool,
    -- | Terminate execution after timing out (number of milliseconds).
    PRuntimeEvaluate -> Maybe RuntimeTimestamp
pRuntimeEvaluateTimeout :: Maybe RuntimeTimeDelta,
    -- | Disable breakpoints during execution.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateDisableBreaks :: Maybe Bool,
    -- | Setting this flag to true enables `let` re-declaration and top-level `await`.
    --   Note that `let` variables can only be re-declared if they originate from
    --   `replMode` themselves.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateReplMode :: Maybe Bool,
    -- | The Content Security Policy (CSP) for the target might block 'unsafe-eval'
    --   which includes eval(), Function(), setTimeout() and setInterval()
    --   when called with non-callable arguments. This flag bypasses CSP for this
    --   evaluation and allows unsafe-eval. Defaults to true.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateAllowUnsafeEvalBlockedByCSP :: Maybe Bool,
    -- | An alternative way to specify the execution context to evaluate in.
    --   Compared to contextId that may be reused across processes, this is guaranteed to be
    --   system-unique, so it can be used to prevent accidental evaluation of the expression
    --   in context different than intended (e.g. as a result of navigation across process
    --   boundaries).
    --   This is mutually exclusive with `contextId`.
    PRuntimeEvaluate -> Maybe Text
pRuntimeEvaluateUniqueContextId :: Maybe T.Text,
    -- | Whether the result should be serialized according to https://w3c.github.io/webdriver-bidi.
    PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateGenerateWebDriverValue :: Maybe Bool
  }
  deriving (PRuntimeEvaluate -> PRuntimeEvaluate -> Bool
(PRuntimeEvaluate -> PRuntimeEvaluate -> Bool)
-> (PRuntimeEvaluate -> PRuntimeEvaluate -> Bool)
-> Eq PRuntimeEvaluate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeEvaluate -> PRuntimeEvaluate -> Bool
$c/= :: PRuntimeEvaluate -> PRuntimeEvaluate -> Bool
== :: PRuntimeEvaluate -> PRuntimeEvaluate -> Bool
$c== :: PRuntimeEvaluate -> PRuntimeEvaluate -> Bool
Eq, Int -> PRuntimeEvaluate -> ShowS
[PRuntimeEvaluate] -> ShowS
PRuntimeEvaluate -> String
(Int -> PRuntimeEvaluate -> ShowS)
-> (PRuntimeEvaluate -> String)
-> ([PRuntimeEvaluate] -> ShowS)
-> Show PRuntimeEvaluate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeEvaluate] -> ShowS
$cshowList :: [PRuntimeEvaluate] -> ShowS
show :: PRuntimeEvaluate -> String
$cshow :: PRuntimeEvaluate -> String
showsPrec :: Int -> PRuntimeEvaluate -> ShowS
$cshowsPrec :: Int -> PRuntimeEvaluate -> ShowS
Show)
pRuntimeEvaluate
  {-
  -- | Expression to evaluate.
  -}
  :: T.Text
  -> PRuntimeEvaluate
pRuntimeEvaluate :: Text -> PRuntimeEvaluate
pRuntimeEvaluate
  Text
arg_pRuntimeEvaluateExpression
  = Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RuntimeTimestamp
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> PRuntimeEvaluate
PRuntimeEvaluate
    Text
arg_pRuntimeEvaluateExpression
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe RuntimeTimestamp
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PRuntimeEvaluate where
  toJSON :: PRuntimeEvaluate -> Value
toJSON PRuntimeEvaluate
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
"expression" 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 (PRuntimeEvaluate -> Text
pRuntimeEvaluateExpression PRuntimeEvaluate
p),
    (Text
"objectGroup" 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
<$> (PRuntimeEvaluate -> Maybe Text
pRuntimeEvaluateObjectGroup PRuntimeEvaluate
p),
    (Text
"includeCommandLineAPI" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateIncludeCommandLineAPI PRuntimeEvaluate
p),
    (Text
"silent" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateSilent PRuntimeEvaluate
p),
    (Text
"contextId" 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
<$> (PRuntimeEvaluate -> Maybe Int
pRuntimeEvaluateContextId PRuntimeEvaluate
p),
    (Text
"returnByValue" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateReturnByValue PRuntimeEvaluate
p),
    (Text
"generatePreview" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateGeneratePreview PRuntimeEvaluate
p),
    (Text
"userGesture" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateUserGesture PRuntimeEvaluate
p),
    (Text
"awaitPromise" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateAwaitPromise PRuntimeEvaluate
p),
    (Text
"throwOnSideEffect" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateThrowOnSideEffect PRuntimeEvaluate
p),
    (Text
"timeout" Text -> RuntimeTimestamp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (RuntimeTimestamp -> Pair) -> Maybe RuntimeTimestamp -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PRuntimeEvaluate -> Maybe RuntimeTimestamp
pRuntimeEvaluateTimeout PRuntimeEvaluate
p),
    (Text
"disableBreaks" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateDisableBreaks PRuntimeEvaluate
p),
    (Text
"replMode" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateReplMode PRuntimeEvaluate
p),
    (Text
"allowUnsafeEvalBlockedByCSP" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateAllowUnsafeEvalBlockedByCSP PRuntimeEvaluate
p),
    (Text
"uniqueContextId" 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
<$> (PRuntimeEvaluate -> Maybe Text
pRuntimeEvaluateUniqueContextId PRuntimeEvaluate
p),
    (Text
"generateWebDriverValue" 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
<$> (PRuntimeEvaluate -> Maybe Bool
pRuntimeEvaluateGenerateWebDriverValue PRuntimeEvaluate
p)
    ]
data RuntimeEvaluate = RuntimeEvaluate
  {
    -- | Evaluation result.
    RuntimeEvaluate -> RuntimeRemoteObject
runtimeEvaluateResult :: RuntimeRemoteObject,
    -- | Exception details.
    RuntimeEvaluate -> Maybe RuntimeExceptionDetails
runtimeEvaluateExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeEvaluate -> RuntimeEvaluate -> Bool
(RuntimeEvaluate -> RuntimeEvaluate -> Bool)
-> (RuntimeEvaluate -> RuntimeEvaluate -> Bool)
-> Eq RuntimeEvaluate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeEvaluate -> RuntimeEvaluate -> Bool
$c/= :: RuntimeEvaluate -> RuntimeEvaluate -> Bool
== :: RuntimeEvaluate -> RuntimeEvaluate -> Bool
$c== :: RuntimeEvaluate -> RuntimeEvaluate -> Bool
Eq, Int -> RuntimeEvaluate -> ShowS
[RuntimeEvaluate] -> ShowS
RuntimeEvaluate -> String
(Int -> RuntimeEvaluate -> ShowS)
-> (RuntimeEvaluate -> String)
-> ([RuntimeEvaluate] -> ShowS)
-> Show RuntimeEvaluate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeEvaluate] -> ShowS
$cshowList :: [RuntimeEvaluate] -> ShowS
show :: RuntimeEvaluate -> String
$cshow :: RuntimeEvaluate -> String
showsPrec :: Int -> RuntimeEvaluate -> ShowS
$cshowsPrec :: Int -> RuntimeEvaluate -> ShowS
Show)
instance FromJSON RuntimeEvaluate where
  parseJSON :: Value -> Parser RuntimeEvaluate
parseJSON = String
-> (Object -> Parser RuntimeEvaluate)
-> Value
-> Parser RuntimeEvaluate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeEvaluate" ((Object -> Parser RuntimeEvaluate)
 -> Value -> Parser RuntimeEvaluate)
-> (Object -> Parser RuntimeEvaluate)
-> Value
-> Parser RuntimeEvaluate
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> Maybe RuntimeExceptionDetails -> RuntimeEvaluate
RuntimeEvaluate
    (RuntimeRemoteObject
 -> Maybe RuntimeExceptionDetails -> RuntimeEvaluate)
-> Parser RuntimeRemoteObject
-> Parser (Maybe RuntimeExceptionDetails -> RuntimeEvaluate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
    Parser (Maybe RuntimeExceptionDetails -> RuntimeEvaluate)
-> Parser (Maybe RuntimeExceptionDetails) -> Parser RuntimeEvaluate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeEvaluate where
  type CommandResponse PRuntimeEvaluate = RuntimeEvaluate
  commandName :: Proxy PRuntimeEvaluate -> String
commandName Proxy PRuntimeEvaluate
_ = String
"Runtime.evaluate"

-- | Returns the isolate id.

-- | Parameters of the 'Runtime.getIsolateId' command.
data PRuntimeGetIsolateId = PRuntimeGetIsolateId
  deriving (PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool
(PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool)
-> (PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool)
-> Eq PRuntimeGetIsolateId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool
$c/= :: PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool
== :: PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool
$c== :: PRuntimeGetIsolateId -> PRuntimeGetIsolateId -> Bool
Eq, Int -> PRuntimeGetIsolateId -> ShowS
[PRuntimeGetIsolateId] -> ShowS
PRuntimeGetIsolateId -> String
(Int -> PRuntimeGetIsolateId -> ShowS)
-> (PRuntimeGetIsolateId -> String)
-> ([PRuntimeGetIsolateId] -> ShowS)
-> Show PRuntimeGetIsolateId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeGetIsolateId] -> ShowS
$cshowList :: [PRuntimeGetIsolateId] -> ShowS
show :: PRuntimeGetIsolateId -> String
$cshow :: PRuntimeGetIsolateId -> String
showsPrec :: Int -> PRuntimeGetIsolateId -> ShowS
$cshowsPrec :: Int -> PRuntimeGetIsolateId -> ShowS
Show)
pRuntimeGetIsolateId
  :: PRuntimeGetIsolateId
pRuntimeGetIsolateId :: PRuntimeGetIsolateId
pRuntimeGetIsolateId
  = PRuntimeGetIsolateId
PRuntimeGetIsolateId
instance ToJSON PRuntimeGetIsolateId where
  toJSON :: PRuntimeGetIsolateId -> Value
toJSON PRuntimeGetIsolateId
_ = Value
A.Null
data RuntimeGetIsolateId = RuntimeGetIsolateId
  {
    -- | The isolate id.
    RuntimeGetIsolateId -> Text
runtimeGetIsolateIdId :: T.Text
  }
  deriving (RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool
(RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool)
-> (RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool)
-> Eq RuntimeGetIsolateId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool
$c/= :: RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool
== :: RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool
$c== :: RuntimeGetIsolateId -> RuntimeGetIsolateId -> Bool
Eq, Int -> RuntimeGetIsolateId -> ShowS
[RuntimeGetIsolateId] -> ShowS
RuntimeGetIsolateId -> String
(Int -> RuntimeGetIsolateId -> ShowS)
-> (RuntimeGetIsolateId -> String)
-> ([RuntimeGetIsolateId] -> ShowS)
-> Show RuntimeGetIsolateId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeGetIsolateId] -> ShowS
$cshowList :: [RuntimeGetIsolateId] -> ShowS
show :: RuntimeGetIsolateId -> String
$cshow :: RuntimeGetIsolateId -> String
showsPrec :: Int -> RuntimeGetIsolateId -> ShowS
$cshowsPrec :: Int -> RuntimeGetIsolateId -> ShowS
Show)
instance FromJSON RuntimeGetIsolateId where
  parseJSON :: Value -> Parser RuntimeGetIsolateId
parseJSON = String
-> (Object -> Parser RuntimeGetIsolateId)
-> Value
-> Parser RuntimeGetIsolateId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeGetIsolateId" ((Object -> Parser RuntimeGetIsolateId)
 -> Value -> Parser RuntimeGetIsolateId)
-> (Object -> Parser RuntimeGetIsolateId)
-> Value
-> Parser RuntimeGetIsolateId
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> RuntimeGetIsolateId
RuntimeGetIsolateId
    (Text -> RuntimeGetIsolateId)
-> Parser Text -> Parser RuntimeGetIsolateId
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
"id"
instance Command PRuntimeGetIsolateId where
  type CommandResponse PRuntimeGetIsolateId = RuntimeGetIsolateId
  commandName :: Proxy PRuntimeGetIsolateId -> String
commandName Proxy PRuntimeGetIsolateId
_ = String
"Runtime.getIsolateId"

-- | Returns the JavaScript heap usage.
--   It is the total usage of the corresponding isolate not scoped to a particular Runtime.

-- | Parameters of the 'Runtime.getHeapUsage' command.
data PRuntimeGetHeapUsage = PRuntimeGetHeapUsage
  deriving (PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool
(PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool)
-> (PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool)
-> Eq PRuntimeGetHeapUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool
$c/= :: PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool
== :: PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool
$c== :: PRuntimeGetHeapUsage -> PRuntimeGetHeapUsage -> Bool
Eq, Int -> PRuntimeGetHeapUsage -> ShowS
[PRuntimeGetHeapUsage] -> ShowS
PRuntimeGetHeapUsage -> String
(Int -> PRuntimeGetHeapUsage -> ShowS)
-> (PRuntimeGetHeapUsage -> String)
-> ([PRuntimeGetHeapUsage] -> ShowS)
-> Show PRuntimeGetHeapUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeGetHeapUsage] -> ShowS
$cshowList :: [PRuntimeGetHeapUsage] -> ShowS
show :: PRuntimeGetHeapUsage -> String
$cshow :: PRuntimeGetHeapUsage -> String
showsPrec :: Int -> PRuntimeGetHeapUsage -> ShowS
$cshowsPrec :: Int -> PRuntimeGetHeapUsage -> ShowS
Show)
pRuntimeGetHeapUsage
  :: PRuntimeGetHeapUsage
pRuntimeGetHeapUsage :: PRuntimeGetHeapUsage
pRuntimeGetHeapUsage
  = PRuntimeGetHeapUsage
PRuntimeGetHeapUsage
instance ToJSON PRuntimeGetHeapUsage where
  toJSON :: PRuntimeGetHeapUsage -> Value
toJSON PRuntimeGetHeapUsage
_ = Value
A.Null
data RuntimeGetHeapUsage = RuntimeGetHeapUsage
  {
    -- | Used heap size in bytes.
    RuntimeGetHeapUsage -> RuntimeTimestamp
runtimeGetHeapUsageUsedSize :: Double,
    -- | Allocated heap size in bytes.
    RuntimeGetHeapUsage -> RuntimeTimestamp
runtimeGetHeapUsageTotalSize :: Double
  }
  deriving (RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool
(RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool)
-> (RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool)
-> Eq RuntimeGetHeapUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool
$c/= :: RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool
== :: RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool
$c== :: RuntimeGetHeapUsage -> RuntimeGetHeapUsage -> Bool
Eq, Int -> RuntimeGetHeapUsage -> ShowS
[RuntimeGetHeapUsage] -> ShowS
RuntimeGetHeapUsage -> String
(Int -> RuntimeGetHeapUsage -> ShowS)
-> (RuntimeGetHeapUsage -> String)
-> ([RuntimeGetHeapUsage] -> ShowS)
-> Show RuntimeGetHeapUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeGetHeapUsage] -> ShowS
$cshowList :: [RuntimeGetHeapUsage] -> ShowS
show :: RuntimeGetHeapUsage -> String
$cshow :: RuntimeGetHeapUsage -> String
showsPrec :: Int -> RuntimeGetHeapUsage -> ShowS
$cshowsPrec :: Int -> RuntimeGetHeapUsage -> ShowS
Show)
instance FromJSON RuntimeGetHeapUsage where
  parseJSON :: Value -> Parser RuntimeGetHeapUsage
parseJSON = String
-> (Object -> Parser RuntimeGetHeapUsage)
-> Value
-> Parser RuntimeGetHeapUsage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeGetHeapUsage" ((Object -> Parser RuntimeGetHeapUsage)
 -> Value -> Parser RuntimeGetHeapUsage)
-> (Object -> Parser RuntimeGetHeapUsage)
-> Value
-> Parser RuntimeGetHeapUsage
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeTimestamp -> RuntimeTimestamp -> RuntimeGetHeapUsage
RuntimeGetHeapUsage
    (RuntimeTimestamp -> RuntimeTimestamp -> RuntimeGetHeapUsage)
-> Parser RuntimeTimestamp
-> Parser (RuntimeTimestamp -> RuntimeGetHeapUsage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeTimestamp
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"usedSize"
    Parser (RuntimeTimestamp -> RuntimeGetHeapUsage)
-> Parser RuntimeTimestamp -> Parser RuntimeGetHeapUsage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeTimestamp
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"totalSize"
instance Command PRuntimeGetHeapUsage where
  type CommandResponse PRuntimeGetHeapUsage = RuntimeGetHeapUsage
  commandName :: Proxy PRuntimeGetHeapUsage -> String
commandName Proxy PRuntimeGetHeapUsage
_ = String
"Runtime.getHeapUsage"

-- | Returns properties of a given object. Object group of the result is inherited from the target
--   object.

-- | Parameters of the 'Runtime.getProperties' command.
data PRuntimeGetProperties = PRuntimeGetProperties
  {
    -- | Identifier of the object to return properties for.
    PRuntimeGetProperties -> Text
pRuntimeGetPropertiesObjectId :: RuntimeRemoteObjectId,
    -- | If true, returns properties belonging only to the element itself, not to its prototype
    --   chain.
    PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesOwnProperties :: Maybe Bool,
    -- | If true, returns accessor properties (with getter/setter) only; internal properties are not
    --   returned either.
    PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesAccessorPropertiesOnly :: Maybe Bool,
    -- | Whether preview should be generated for the results.
    PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesGeneratePreview :: Maybe Bool,
    -- | If true, returns non-indexed properties only.
    PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesNonIndexedPropertiesOnly :: Maybe Bool
  }
  deriving (PRuntimeGetProperties -> PRuntimeGetProperties -> Bool
(PRuntimeGetProperties -> PRuntimeGetProperties -> Bool)
-> (PRuntimeGetProperties -> PRuntimeGetProperties -> Bool)
-> Eq PRuntimeGetProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeGetProperties -> PRuntimeGetProperties -> Bool
$c/= :: PRuntimeGetProperties -> PRuntimeGetProperties -> Bool
== :: PRuntimeGetProperties -> PRuntimeGetProperties -> Bool
$c== :: PRuntimeGetProperties -> PRuntimeGetProperties -> Bool
Eq, Int -> PRuntimeGetProperties -> ShowS
[PRuntimeGetProperties] -> ShowS
PRuntimeGetProperties -> String
(Int -> PRuntimeGetProperties -> ShowS)
-> (PRuntimeGetProperties -> String)
-> ([PRuntimeGetProperties] -> ShowS)
-> Show PRuntimeGetProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeGetProperties] -> ShowS
$cshowList :: [PRuntimeGetProperties] -> ShowS
show :: PRuntimeGetProperties -> String
$cshow :: PRuntimeGetProperties -> String
showsPrec :: Int -> PRuntimeGetProperties -> ShowS
$cshowsPrec :: Int -> PRuntimeGetProperties -> ShowS
Show)
pRuntimeGetProperties
  {-
  -- | Identifier of the object to return properties for.
  -}
  :: RuntimeRemoteObjectId
  -> PRuntimeGetProperties
pRuntimeGetProperties :: Text -> PRuntimeGetProperties
pRuntimeGetProperties
  Text
arg_pRuntimeGetPropertiesObjectId
  = Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> PRuntimeGetProperties
PRuntimeGetProperties
    Text
arg_pRuntimeGetPropertiesObjectId
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PRuntimeGetProperties where
  toJSON :: PRuntimeGetProperties -> Value
toJSON PRuntimeGetProperties
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
"objectId" 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 (PRuntimeGetProperties -> Text
pRuntimeGetPropertiesObjectId PRuntimeGetProperties
p),
    (Text
"ownProperties" 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
<$> (PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesOwnProperties PRuntimeGetProperties
p),
    (Text
"accessorPropertiesOnly" 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
<$> (PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesAccessorPropertiesOnly PRuntimeGetProperties
p),
    (Text
"generatePreview" 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
<$> (PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesGeneratePreview PRuntimeGetProperties
p),
    (Text
"nonIndexedPropertiesOnly" 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
<$> (PRuntimeGetProperties -> Maybe Bool
pRuntimeGetPropertiesNonIndexedPropertiesOnly PRuntimeGetProperties
p)
    ]
data RuntimeGetProperties = RuntimeGetProperties
  {
    -- | Object properties.
    RuntimeGetProperties -> [RuntimePropertyDescriptor]
runtimeGetPropertiesResult :: [RuntimePropertyDescriptor],
    -- | Internal object properties (only of the element itself).
    RuntimeGetProperties -> Maybe [RuntimeInternalPropertyDescriptor]
runtimeGetPropertiesInternalProperties :: Maybe [RuntimeInternalPropertyDescriptor],
    -- | Object private properties.
    RuntimeGetProperties -> Maybe [RuntimePrivatePropertyDescriptor]
runtimeGetPropertiesPrivateProperties :: Maybe [RuntimePrivatePropertyDescriptor],
    -- | Exception details.
    RuntimeGetProperties -> Maybe RuntimeExceptionDetails
runtimeGetPropertiesExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeGetProperties -> RuntimeGetProperties -> Bool
(RuntimeGetProperties -> RuntimeGetProperties -> Bool)
-> (RuntimeGetProperties -> RuntimeGetProperties -> Bool)
-> Eq RuntimeGetProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeGetProperties -> RuntimeGetProperties -> Bool
$c/= :: RuntimeGetProperties -> RuntimeGetProperties -> Bool
== :: RuntimeGetProperties -> RuntimeGetProperties -> Bool
$c== :: RuntimeGetProperties -> RuntimeGetProperties -> Bool
Eq, Int -> RuntimeGetProperties -> ShowS
[RuntimeGetProperties] -> ShowS
RuntimeGetProperties -> String
(Int -> RuntimeGetProperties -> ShowS)
-> (RuntimeGetProperties -> String)
-> ([RuntimeGetProperties] -> ShowS)
-> Show RuntimeGetProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeGetProperties] -> ShowS
$cshowList :: [RuntimeGetProperties] -> ShowS
show :: RuntimeGetProperties -> String
$cshow :: RuntimeGetProperties -> String
showsPrec :: Int -> RuntimeGetProperties -> ShowS
$cshowsPrec :: Int -> RuntimeGetProperties -> ShowS
Show)
instance FromJSON RuntimeGetProperties where
  parseJSON :: Value -> Parser RuntimeGetProperties
parseJSON = String
-> (Object -> Parser RuntimeGetProperties)
-> Value
-> Parser RuntimeGetProperties
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeGetProperties" ((Object -> Parser RuntimeGetProperties)
 -> Value -> Parser RuntimeGetProperties)
-> (Object -> Parser RuntimeGetProperties)
-> Value
-> Parser RuntimeGetProperties
forall a b. (a -> b) -> a -> b
$ \Object
o -> [RuntimePropertyDescriptor]
-> Maybe [RuntimeInternalPropertyDescriptor]
-> Maybe [RuntimePrivatePropertyDescriptor]
-> Maybe RuntimeExceptionDetails
-> RuntimeGetProperties
RuntimeGetProperties
    ([RuntimePropertyDescriptor]
 -> Maybe [RuntimeInternalPropertyDescriptor]
 -> Maybe [RuntimePrivatePropertyDescriptor]
 -> Maybe RuntimeExceptionDetails
 -> RuntimeGetProperties)
-> Parser [RuntimePropertyDescriptor]
-> Parser
     (Maybe [RuntimeInternalPropertyDescriptor]
      -> Maybe [RuntimePrivatePropertyDescriptor]
      -> Maybe RuntimeExceptionDetails
      -> RuntimeGetProperties)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [RuntimePropertyDescriptor]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
    Parser
  (Maybe [RuntimeInternalPropertyDescriptor]
   -> Maybe [RuntimePrivatePropertyDescriptor]
   -> Maybe RuntimeExceptionDetails
   -> RuntimeGetProperties)
-> Parser (Maybe [RuntimeInternalPropertyDescriptor])
-> Parser
     (Maybe [RuntimePrivatePropertyDescriptor]
      -> Maybe RuntimeExceptionDetails -> RuntimeGetProperties)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Text -> Parser (Maybe [RuntimeInternalPropertyDescriptor])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"internalProperties"
    Parser
  (Maybe [RuntimePrivatePropertyDescriptor]
   -> Maybe RuntimeExceptionDetails -> RuntimeGetProperties)
-> Parser (Maybe [RuntimePrivatePropertyDescriptor])
-> Parser (Maybe RuntimeExceptionDetails -> RuntimeGetProperties)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [RuntimePrivatePropertyDescriptor])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"privateProperties"
    Parser (Maybe RuntimeExceptionDetails -> RuntimeGetProperties)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser RuntimeGetProperties
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeGetProperties where
  type CommandResponse PRuntimeGetProperties = RuntimeGetProperties
  commandName :: Proxy PRuntimeGetProperties -> String
commandName Proxy PRuntimeGetProperties
_ = String
"Runtime.getProperties"

-- | Returns all let, const and class variables from global scope.

-- | Parameters of the 'Runtime.globalLexicalScopeNames' command.
data PRuntimeGlobalLexicalScopeNames = PRuntimeGlobalLexicalScopeNames
  {
    -- | Specifies in which execution context to lookup global scope variables.
    PRuntimeGlobalLexicalScopeNames -> Maybe Int
pRuntimeGlobalLexicalScopeNamesExecutionContextId :: Maybe RuntimeExecutionContextId
  }
  deriving (PRuntimeGlobalLexicalScopeNames
-> PRuntimeGlobalLexicalScopeNames -> Bool
(PRuntimeGlobalLexicalScopeNames
 -> PRuntimeGlobalLexicalScopeNames -> Bool)
-> (PRuntimeGlobalLexicalScopeNames
    -> PRuntimeGlobalLexicalScopeNames -> Bool)
-> Eq PRuntimeGlobalLexicalScopeNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeGlobalLexicalScopeNames
-> PRuntimeGlobalLexicalScopeNames -> Bool
$c/= :: PRuntimeGlobalLexicalScopeNames
-> PRuntimeGlobalLexicalScopeNames -> Bool
== :: PRuntimeGlobalLexicalScopeNames
-> PRuntimeGlobalLexicalScopeNames -> Bool
$c== :: PRuntimeGlobalLexicalScopeNames
-> PRuntimeGlobalLexicalScopeNames -> Bool
Eq, Int -> PRuntimeGlobalLexicalScopeNames -> ShowS
[PRuntimeGlobalLexicalScopeNames] -> ShowS
PRuntimeGlobalLexicalScopeNames -> String
(Int -> PRuntimeGlobalLexicalScopeNames -> ShowS)
-> (PRuntimeGlobalLexicalScopeNames -> String)
-> ([PRuntimeGlobalLexicalScopeNames] -> ShowS)
-> Show PRuntimeGlobalLexicalScopeNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeGlobalLexicalScopeNames] -> ShowS
$cshowList :: [PRuntimeGlobalLexicalScopeNames] -> ShowS
show :: PRuntimeGlobalLexicalScopeNames -> String
$cshow :: PRuntimeGlobalLexicalScopeNames -> String
showsPrec :: Int -> PRuntimeGlobalLexicalScopeNames -> ShowS
$cshowsPrec :: Int -> PRuntimeGlobalLexicalScopeNames -> ShowS
Show)
pRuntimeGlobalLexicalScopeNames
  :: PRuntimeGlobalLexicalScopeNames
pRuntimeGlobalLexicalScopeNames :: PRuntimeGlobalLexicalScopeNames
pRuntimeGlobalLexicalScopeNames
  = Maybe Int -> PRuntimeGlobalLexicalScopeNames
PRuntimeGlobalLexicalScopeNames
    Maybe Int
forall a. Maybe a
Nothing
instance ToJSON PRuntimeGlobalLexicalScopeNames where
  toJSON :: PRuntimeGlobalLexicalScopeNames -> Value
toJSON PRuntimeGlobalLexicalScopeNames
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
"executionContextId" 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
<$> (PRuntimeGlobalLexicalScopeNames -> Maybe Int
pRuntimeGlobalLexicalScopeNamesExecutionContextId PRuntimeGlobalLexicalScopeNames
p)
    ]
data RuntimeGlobalLexicalScopeNames = RuntimeGlobalLexicalScopeNames
  {
    RuntimeGlobalLexicalScopeNames -> [Text]
runtimeGlobalLexicalScopeNamesNames :: [T.Text]
  }
  deriving (RuntimeGlobalLexicalScopeNames
-> RuntimeGlobalLexicalScopeNames -> Bool
(RuntimeGlobalLexicalScopeNames
 -> RuntimeGlobalLexicalScopeNames -> Bool)
-> (RuntimeGlobalLexicalScopeNames
    -> RuntimeGlobalLexicalScopeNames -> Bool)
-> Eq RuntimeGlobalLexicalScopeNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeGlobalLexicalScopeNames
-> RuntimeGlobalLexicalScopeNames -> Bool
$c/= :: RuntimeGlobalLexicalScopeNames
-> RuntimeGlobalLexicalScopeNames -> Bool
== :: RuntimeGlobalLexicalScopeNames
-> RuntimeGlobalLexicalScopeNames -> Bool
$c== :: RuntimeGlobalLexicalScopeNames
-> RuntimeGlobalLexicalScopeNames -> Bool
Eq, Int -> RuntimeGlobalLexicalScopeNames -> ShowS
[RuntimeGlobalLexicalScopeNames] -> ShowS
RuntimeGlobalLexicalScopeNames -> String
(Int -> RuntimeGlobalLexicalScopeNames -> ShowS)
-> (RuntimeGlobalLexicalScopeNames -> String)
-> ([RuntimeGlobalLexicalScopeNames] -> ShowS)
-> Show RuntimeGlobalLexicalScopeNames
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeGlobalLexicalScopeNames] -> ShowS
$cshowList :: [RuntimeGlobalLexicalScopeNames] -> ShowS
show :: RuntimeGlobalLexicalScopeNames -> String
$cshow :: RuntimeGlobalLexicalScopeNames -> String
showsPrec :: Int -> RuntimeGlobalLexicalScopeNames -> ShowS
$cshowsPrec :: Int -> RuntimeGlobalLexicalScopeNames -> ShowS
Show)
instance FromJSON RuntimeGlobalLexicalScopeNames where
  parseJSON :: Value -> Parser RuntimeGlobalLexicalScopeNames
parseJSON = String
-> (Object -> Parser RuntimeGlobalLexicalScopeNames)
-> Value
-> Parser RuntimeGlobalLexicalScopeNames
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeGlobalLexicalScopeNames" ((Object -> Parser RuntimeGlobalLexicalScopeNames)
 -> Value -> Parser RuntimeGlobalLexicalScopeNames)
-> (Object -> Parser RuntimeGlobalLexicalScopeNames)
-> Value
-> Parser RuntimeGlobalLexicalScopeNames
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Text] -> RuntimeGlobalLexicalScopeNames
RuntimeGlobalLexicalScopeNames
    ([Text] -> RuntimeGlobalLexicalScopeNames)
-> Parser [Text] -> Parser RuntimeGlobalLexicalScopeNames
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
"names"
instance Command PRuntimeGlobalLexicalScopeNames where
  type CommandResponse PRuntimeGlobalLexicalScopeNames = RuntimeGlobalLexicalScopeNames
  commandName :: Proxy PRuntimeGlobalLexicalScopeNames -> String
commandName Proxy PRuntimeGlobalLexicalScopeNames
_ = String
"Runtime.globalLexicalScopeNames"


-- | Parameters of the 'Runtime.queryObjects' command.
data PRuntimeQueryObjects = PRuntimeQueryObjects
  {
    -- | Identifier of the prototype to return objects for.
    PRuntimeQueryObjects -> Text
pRuntimeQueryObjectsPrototypeObjectId :: RuntimeRemoteObjectId,
    -- | Symbolic group name that can be used to release the results.
    PRuntimeQueryObjects -> Maybe Text
pRuntimeQueryObjectsObjectGroup :: Maybe T.Text
  }
  deriving (PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool
(PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool)
-> (PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool)
-> Eq PRuntimeQueryObjects
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool
$c/= :: PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool
== :: PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool
$c== :: PRuntimeQueryObjects -> PRuntimeQueryObjects -> Bool
Eq, Int -> PRuntimeQueryObjects -> ShowS
[PRuntimeQueryObjects] -> ShowS
PRuntimeQueryObjects -> String
(Int -> PRuntimeQueryObjects -> ShowS)
-> (PRuntimeQueryObjects -> String)
-> ([PRuntimeQueryObjects] -> ShowS)
-> Show PRuntimeQueryObjects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeQueryObjects] -> ShowS
$cshowList :: [PRuntimeQueryObjects] -> ShowS
show :: PRuntimeQueryObjects -> String
$cshow :: PRuntimeQueryObjects -> String
showsPrec :: Int -> PRuntimeQueryObjects -> ShowS
$cshowsPrec :: Int -> PRuntimeQueryObjects -> ShowS
Show)
pRuntimeQueryObjects
  {-
  -- | Identifier of the prototype to return objects for.
  -}
  :: RuntimeRemoteObjectId
  -> PRuntimeQueryObjects
pRuntimeQueryObjects :: Text -> PRuntimeQueryObjects
pRuntimeQueryObjects
  Text
arg_pRuntimeQueryObjectsPrototypeObjectId
  = Text -> Maybe Text -> PRuntimeQueryObjects
PRuntimeQueryObjects
    Text
arg_pRuntimeQueryObjectsPrototypeObjectId
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PRuntimeQueryObjects where
  toJSON :: PRuntimeQueryObjects -> Value
toJSON PRuntimeQueryObjects
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
"prototypeObjectId" 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 (PRuntimeQueryObjects -> Text
pRuntimeQueryObjectsPrototypeObjectId PRuntimeQueryObjects
p),
    (Text
"objectGroup" 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
<$> (PRuntimeQueryObjects -> Maybe Text
pRuntimeQueryObjectsObjectGroup PRuntimeQueryObjects
p)
    ]
data RuntimeQueryObjects = RuntimeQueryObjects
  {
    -- | Array with objects.
    RuntimeQueryObjects -> RuntimeRemoteObject
runtimeQueryObjectsObjects :: RuntimeRemoteObject
  }
  deriving (RuntimeQueryObjects -> RuntimeQueryObjects -> Bool
(RuntimeQueryObjects -> RuntimeQueryObjects -> Bool)
-> (RuntimeQueryObjects -> RuntimeQueryObjects -> Bool)
-> Eq RuntimeQueryObjects
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeQueryObjects -> RuntimeQueryObjects -> Bool
$c/= :: RuntimeQueryObjects -> RuntimeQueryObjects -> Bool
== :: RuntimeQueryObjects -> RuntimeQueryObjects -> Bool
$c== :: RuntimeQueryObjects -> RuntimeQueryObjects -> Bool
Eq, Int -> RuntimeQueryObjects -> ShowS
[RuntimeQueryObjects] -> ShowS
RuntimeQueryObjects -> String
(Int -> RuntimeQueryObjects -> ShowS)
-> (RuntimeQueryObjects -> String)
-> ([RuntimeQueryObjects] -> ShowS)
-> Show RuntimeQueryObjects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeQueryObjects] -> ShowS
$cshowList :: [RuntimeQueryObjects] -> ShowS
show :: RuntimeQueryObjects -> String
$cshow :: RuntimeQueryObjects -> String
showsPrec :: Int -> RuntimeQueryObjects -> ShowS
$cshowsPrec :: Int -> RuntimeQueryObjects -> ShowS
Show)
instance FromJSON RuntimeQueryObjects where
  parseJSON :: Value -> Parser RuntimeQueryObjects
parseJSON = String
-> (Object -> Parser RuntimeQueryObjects)
-> Value
-> Parser RuntimeQueryObjects
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeQueryObjects" ((Object -> Parser RuntimeQueryObjects)
 -> Value -> Parser RuntimeQueryObjects)
-> (Object -> Parser RuntimeQueryObjects)
-> Value
-> Parser RuntimeQueryObjects
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject -> RuntimeQueryObjects
RuntimeQueryObjects
    (RuntimeRemoteObject -> RuntimeQueryObjects)
-> Parser RuntimeRemoteObject -> Parser RuntimeQueryObjects
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"objects"
instance Command PRuntimeQueryObjects where
  type CommandResponse PRuntimeQueryObjects = RuntimeQueryObjects
  commandName :: Proxy PRuntimeQueryObjects -> String
commandName Proxy PRuntimeQueryObjects
_ = String
"Runtime.queryObjects"

-- | Releases remote object with given id.

-- | Parameters of the 'Runtime.releaseObject' command.
data PRuntimeReleaseObject = PRuntimeReleaseObject
  {
    -- | Identifier of the object to release.
    PRuntimeReleaseObject -> Text
pRuntimeReleaseObjectObjectId :: RuntimeRemoteObjectId
  }
  deriving (PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool
(PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool)
-> (PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool)
-> Eq PRuntimeReleaseObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool
$c/= :: PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool
== :: PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool
$c== :: PRuntimeReleaseObject -> PRuntimeReleaseObject -> Bool
Eq, Int -> PRuntimeReleaseObject -> ShowS
[PRuntimeReleaseObject] -> ShowS
PRuntimeReleaseObject -> String
(Int -> PRuntimeReleaseObject -> ShowS)
-> (PRuntimeReleaseObject -> String)
-> ([PRuntimeReleaseObject] -> ShowS)
-> Show PRuntimeReleaseObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeReleaseObject] -> ShowS
$cshowList :: [PRuntimeReleaseObject] -> ShowS
show :: PRuntimeReleaseObject -> String
$cshow :: PRuntimeReleaseObject -> String
showsPrec :: Int -> PRuntimeReleaseObject -> ShowS
$cshowsPrec :: Int -> PRuntimeReleaseObject -> ShowS
Show)
pRuntimeReleaseObject
  {-
  -- | Identifier of the object to release.
  -}
  :: RuntimeRemoteObjectId
  -> PRuntimeReleaseObject
pRuntimeReleaseObject :: Text -> PRuntimeReleaseObject
pRuntimeReleaseObject
  Text
arg_pRuntimeReleaseObjectObjectId
  = Text -> PRuntimeReleaseObject
PRuntimeReleaseObject
    Text
arg_pRuntimeReleaseObjectObjectId
instance ToJSON PRuntimeReleaseObject where
  toJSON :: PRuntimeReleaseObject -> Value
toJSON PRuntimeReleaseObject
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
"objectId" 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 (PRuntimeReleaseObject -> Text
pRuntimeReleaseObjectObjectId PRuntimeReleaseObject
p)
    ]
instance Command PRuntimeReleaseObject where
  type CommandResponse PRuntimeReleaseObject = ()
  commandName :: Proxy PRuntimeReleaseObject -> String
commandName Proxy PRuntimeReleaseObject
_ = String
"Runtime.releaseObject"
  fromJSON :: Proxy PRuntimeReleaseObject
-> Value -> Result (CommandResponse PRuntimeReleaseObject)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeReleaseObject -> Result ())
-> Proxy PRuntimeReleaseObject
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeReleaseObject -> ())
-> Proxy PRuntimeReleaseObject
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeReleaseObject -> ()
forall a b. a -> b -> a
const ()

-- | Releases all remote objects that belong to a given group.

-- | Parameters of the 'Runtime.releaseObjectGroup' command.
data PRuntimeReleaseObjectGroup = PRuntimeReleaseObjectGroup
  {
    -- | Symbolic object group name.
    PRuntimeReleaseObjectGroup -> Text
pRuntimeReleaseObjectGroupObjectGroup :: T.Text
  }
  deriving (PRuntimeReleaseObjectGroup -> PRuntimeReleaseObjectGroup -> Bool
(PRuntimeReleaseObjectGroup -> PRuntimeReleaseObjectGroup -> Bool)
-> (PRuntimeReleaseObjectGroup
    -> PRuntimeReleaseObjectGroup -> Bool)
-> Eq PRuntimeReleaseObjectGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeReleaseObjectGroup -> PRuntimeReleaseObjectGroup -> Bool
$c/= :: PRuntimeReleaseObjectGroup -> PRuntimeReleaseObjectGroup -> Bool
== :: PRuntimeReleaseObjectGroup -> PRuntimeReleaseObjectGroup -> Bool
$c== :: PRuntimeReleaseObjectGroup -> PRuntimeReleaseObjectGroup -> Bool
Eq, Int -> PRuntimeReleaseObjectGroup -> ShowS
[PRuntimeReleaseObjectGroup] -> ShowS
PRuntimeReleaseObjectGroup -> String
(Int -> PRuntimeReleaseObjectGroup -> ShowS)
-> (PRuntimeReleaseObjectGroup -> String)
-> ([PRuntimeReleaseObjectGroup] -> ShowS)
-> Show PRuntimeReleaseObjectGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeReleaseObjectGroup] -> ShowS
$cshowList :: [PRuntimeReleaseObjectGroup] -> ShowS
show :: PRuntimeReleaseObjectGroup -> String
$cshow :: PRuntimeReleaseObjectGroup -> String
showsPrec :: Int -> PRuntimeReleaseObjectGroup -> ShowS
$cshowsPrec :: Int -> PRuntimeReleaseObjectGroup -> ShowS
Show)
pRuntimeReleaseObjectGroup
  {-
  -- | Symbolic object group name.
  -}
  :: T.Text
  -> PRuntimeReleaseObjectGroup
pRuntimeReleaseObjectGroup :: Text -> PRuntimeReleaseObjectGroup
pRuntimeReleaseObjectGroup
  Text
arg_pRuntimeReleaseObjectGroupObjectGroup
  = Text -> PRuntimeReleaseObjectGroup
PRuntimeReleaseObjectGroup
    Text
arg_pRuntimeReleaseObjectGroupObjectGroup
instance ToJSON PRuntimeReleaseObjectGroup where
  toJSON :: PRuntimeReleaseObjectGroup -> Value
toJSON PRuntimeReleaseObjectGroup
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
"objectGroup" 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 (PRuntimeReleaseObjectGroup -> Text
pRuntimeReleaseObjectGroupObjectGroup PRuntimeReleaseObjectGroup
p)
    ]
instance Command PRuntimeReleaseObjectGroup where
  type CommandResponse PRuntimeReleaseObjectGroup = ()
  commandName :: Proxy PRuntimeReleaseObjectGroup -> String
commandName Proxy PRuntimeReleaseObjectGroup
_ = String
"Runtime.releaseObjectGroup"
  fromJSON :: Proxy PRuntimeReleaseObjectGroup
-> Value -> Result (CommandResponse PRuntimeReleaseObjectGroup)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeReleaseObjectGroup -> Result ())
-> Proxy PRuntimeReleaseObjectGroup
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeReleaseObjectGroup -> ())
-> Proxy PRuntimeReleaseObjectGroup
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeReleaseObjectGroup -> ()
forall a b. a -> b -> a
const ()

-- | Tells inspected instance to run if it was waiting for debugger to attach.

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

-- | Runs script with given id in a given context.

-- | Parameters of the 'Runtime.runScript' command.
data PRuntimeRunScript = PRuntimeRunScript
  {
    -- | Id of the script to run.
    PRuntimeRunScript -> Text
pRuntimeRunScriptScriptId :: RuntimeScriptId,
    -- | Specifies in which execution context to perform script run. If the parameter is omitted the
    --   evaluation will be performed in the context of the inspected page.
    PRuntimeRunScript -> Maybe Int
pRuntimeRunScriptExecutionContextId :: Maybe RuntimeExecutionContextId,
    -- | Symbolic group name that can be used to release multiple objects.
    PRuntimeRunScript -> Maybe Text
pRuntimeRunScriptObjectGroup :: Maybe T.Text,
    -- | In silent mode exceptions thrown during evaluation are not reported and do not pause
    --   execution. Overrides `setPauseOnException` state.
    PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptSilent :: Maybe Bool,
    -- | Determines whether Command Line API should be available during the evaluation.
    PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptIncludeCommandLineAPI :: Maybe Bool,
    -- | Whether the result is expected to be a JSON object which should be sent by value.
    PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptReturnByValue :: Maybe Bool,
    -- | Whether preview should be generated for the result.
    PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptGeneratePreview :: Maybe Bool,
    -- | Whether execution should `await` for resulting value and return once awaited promise is
    --   resolved.
    PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptAwaitPromise :: Maybe Bool
  }
  deriving (PRuntimeRunScript -> PRuntimeRunScript -> Bool
(PRuntimeRunScript -> PRuntimeRunScript -> Bool)
-> (PRuntimeRunScript -> PRuntimeRunScript -> Bool)
-> Eq PRuntimeRunScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeRunScript -> PRuntimeRunScript -> Bool
$c/= :: PRuntimeRunScript -> PRuntimeRunScript -> Bool
== :: PRuntimeRunScript -> PRuntimeRunScript -> Bool
$c== :: PRuntimeRunScript -> PRuntimeRunScript -> Bool
Eq, Int -> PRuntimeRunScript -> ShowS
[PRuntimeRunScript] -> ShowS
PRuntimeRunScript -> String
(Int -> PRuntimeRunScript -> ShowS)
-> (PRuntimeRunScript -> String)
-> ([PRuntimeRunScript] -> ShowS)
-> Show PRuntimeRunScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeRunScript] -> ShowS
$cshowList :: [PRuntimeRunScript] -> ShowS
show :: PRuntimeRunScript -> String
$cshow :: PRuntimeRunScript -> String
showsPrec :: Int -> PRuntimeRunScript -> ShowS
$cshowsPrec :: Int -> PRuntimeRunScript -> ShowS
Show)
pRuntimeRunScript
  {-
  -- | Id of the script to run.
  -}
  :: RuntimeScriptId
  -> PRuntimeRunScript
pRuntimeRunScript :: Text -> PRuntimeRunScript
pRuntimeRunScript
  Text
arg_pRuntimeRunScriptScriptId
  = Text
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> PRuntimeRunScript
PRuntimeRunScript
    Text
arg_pRuntimeRunScriptScriptId
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Text
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PRuntimeRunScript where
  toJSON :: PRuntimeRunScript -> Value
toJSON PRuntimeRunScript
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
"scriptId" 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 (PRuntimeRunScript -> Text
pRuntimeRunScriptScriptId PRuntimeRunScript
p),
    (Text
"executionContextId" 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
<$> (PRuntimeRunScript -> Maybe Int
pRuntimeRunScriptExecutionContextId PRuntimeRunScript
p),
    (Text
"objectGroup" 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
<$> (PRuntimeRunScript -> Maybe Text
pRuntimeRunScriptObjectGroup PRuntimeRunScript
p),
    (Text
"silent" 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
<$> (PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptSilent PRuntimeRunScript
p),
    (Text
"includeCommandLineAPI" 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
<$> (PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptIncludeCommandLineAPI PRuntimeRunScript
p),
    (Text
"returnByValue" 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
<$> (PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptReturnByValue PRuntimeRunScript
p),
    (Text
"generatePreview" 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
<$> (PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptGeneratePreview PRuntimeRunScript
p),
    (Text
"awaitPromise" 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
<$> (PRuntimeRunScript -> Maybe Bool
pRuntimeRunScriptAwaitPromise PRuntimeRunScript
p)
    ]
data RuntimeRunScript = RuntimeRunScript
  {
    -- | Run result.
    RuntimeRunScript -> RuntimeRemoteObject
runtimeRunScriptResult :: RuntimeRemoteObject,
    -- | Exception details.
    RuntimeRunScript -> Maybe RuntimeExceptionDetails
runtimeRunScriptExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeRunScript -> RuntimeRunScript -> Bool
(RuntimeRunScript -> RuntimeRunScript -> Bool)
-> (RuntimeRunScript -> RuntimeRunScript -> Bool)
-> Eq RuntimeRunScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeRunScript -> RuntimeRunScript -> Bool
$c/= :: RuntimeRunScript -> RuntimeRunScript -> Bool
== :: RuntimeRunScript -> RuntimeRunScript -> Bool
$c== :: RuntimeRunScript -> RuntimeRunScript -> Bool
Eq, Int -> RuntimeRunScript -> ShowS
[RuntimeRunScript] -> ShowS
RuntimeRunScript -> String
(Int -> RuntimeRunScript -> ShowS)
-> (RuntimeRunScript -> String)
-> ([RuntimeRunScript] -> ShowS)
-> Show RuntimeRunScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeRunScript] -> ShowS
$cshowList :: [RuntimeRunScript] -> ShowS
show :: RuntimeRunScript -> String
$cshow :: RuntimeRunScript -> String
showsPrec :: Int -> RuntimeRunScript -> ShowS
$cshowsPrec :: Int -> RuntimeRunScript -> ShowS
Show)
instance FromJSON RuntimeRunScript where
  parseJSON :: Value -> Parser RuntimeRunScript
parseJSON = String
-> (Object -> Parser RuntimeRunScript)
-> Value
-> Parser RuntimeRunScript
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeRunScript" ((Object -> Parser RuntimeRunScript)
 -> Value -> Parser RuntimeRunScript)
-> (Object -> Parser RuntimeRunScript)
-> Value
-> Parser RuntimeRunScript
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject
-> Maybe RuntimeExceptionDetails -> RuntimeRunScript
RuntimeRunScript
    (RuntimeRemoteObject
 -> Maybe RuntimeExceptionDetails -> RuntimeRunScript)
-> Parser RuntimeRemoteObject
-> Parser (Maybe RuntimeExceptionDetails -> RuntimeRunScript)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeRemoteObject
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
    Parser (Maybe RuntimeExceptionDetails -> RuntimeRunScript)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser RuntimeRunScript
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeRunScript where
  type CommandResponse PRuntimeRunScript = RuntimeRunScript
  commandName :: Proxy PRuntimeRunScript -> String
commandName Proxy PRuntimeRunScript
_ = String
"Runtime.runScript"

-- | Enables or disables async call stacks tracking.

-- | Parameters of the 'Runtime.setAsyncCallStackDepth' command.
data PRuntimeSetAsyncCallStackDepth = PRuntimeSetAsyncCallStackDepth
  {
    -- | Maximum depth of async call stacks. Setting to `0` will effectively disable collecting async
    --   call stacks (default).
    PRuntimeSetAsyncCallStackDepth -> Int
pRuntimeSetAsyncCallStackDepthMaxDepth :: Int
  }
  deriving (PRuntimeSetAsyncCallStackDepth
-> PRuntimeSetAsyncCallStackDepth -> Bool
(PRuntimeSetAsyncCallStackDepth
 -> PRuntimeSetAsyncCallStackDepth -> Bool)
-> (PRuntimeSetAsyncCallStackDepth
    -> PRuntimeSetAsyncCallStackDepth -> Bool)
-> Eq PRuntimeSetAsyncCallStackDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeSetAsyncCallStackDepth
-> PRuntimeSetAsyncCallStackDepth -> Bool
$c/= :: PRuntimeSetAsyncCallStackDepth
-> PRuntimeSetAsyncCallStackDepth -> Bool
== :: PRuntimeSetAsyncCallStackDepth
-> PRuntimeSetAsyncCallStackDepth -> Bool
$c== :: PRuntimeSetAsyncCallStackDepth
-> PRuntimeSetAsyncCallStackDepth -> Bool
Eq, Int -> PRuntimeSetAsyncCallStackDepth -> ShowS
[PRuntimeSetAsyncCallStackDepth] -> ShowS
PRuntimeSetAsyncCallStackDepth -> String
(Int -> PRuntimeSetAsyncCallStackDepth -> ShowS)
-> (PRuntimeSetAsyncCallStackDepth -> String)
-> ([PRuntimeSetAsyncCallStackDepth] -> ShowS)
-> Show PRuntimeSetAsyncCallStackDepth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeSetAsyncCallStackDepth] -> ShowS
$cshowList :: [PRuntimeSetAsyncCallStackDepth] -> ShowS
show :: PRuntimeSetAsyncCallStackDepth -> String
$cshow :: PRuntimeSetAsyncCallStackDepth -> String
showsPrec :: Int -> PRuntimeSetAsyncCallStackDepth -> ShowS
$cshowsPrec :: Int -> PRuntimeSetAsyncCallStackDepth -> ShowS
Show)
pRuntimeSetAsyncCallStackDepth
  {-
  -- | Maximum depth of async call stacks. Setting to `0` will effectively disable collecting async
  --   call stacks (default).
  -}
  :: Int
  -> PRuntimeSetAsyncCallStackDepth
pRuntimeSetAsyncCallStackDepth :: Int -> PRuntimeSetAsyncCallStackDepth
pRuntimeSetAsyncCallStackDepth
  Int
arg_pRuntimeSetAsyncCallStackDepthMaxDepth
  = Int -> PRuntimeSetAsyncCallStackDepth
PRuntimeSetAsyncCallStackDepth
    Int
arg_pRuntimeSetAsyncCallStackDepthMaxDepth
instance ToJSON PRuntimeSetAsyncCallStackDepth where
  toJSON :: PRuntimeSetAsyncCallStackDepth -> Value
toJSON PRuntimeSetAsyncCallStackDepth
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
"maxDepth" 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 (PRuntimeSetAsyncCallStackDepth -> Int
pRuntimeSetAsyncCallStackDepthMaxDepth PRuntimeSetAsyncCallStackDepth
p)
    ]
instance Command PRuntimeSetAsyncCallStackDepth where
  type CommandResponse PRuntimeSetAsyncCallStackDepth = ()
  commandName :: Proxy PRuntimeSetAsyncCallStackDepth -> String
commandName Proxy PRuntimeSetAsyncCallStackDepth
_ = String
"Runtime.setAsyncCallStackDepth"
  fromJSON :: Proxy PRuntimeSetAsyncCallStackDepth
-> Value -> Result (CommandResponse PRuntimeSetAsyncCallStackDepth)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeSetAsyncCallStackDepth -> Result ())
-> Proxy PRuntimeSetAsyncCallStackDepth
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeSetAsyncCallStackDepth -> ())
-> Proxy PRuntimeSetAsyncCallStackDepth
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeSetAsyncCallStackDepth -> ()
forall a b. a -> b -> a
const ()


-- | Parameters of the 'Runtime.setCustomObjectFormatterEnabled' command.
data PRuntimeSetCustomObjectFormatterEnabled = PRuntimeSetCustomObjectFormatterEnabled
  {
    PRuntimeSetCustomObjectFormatterEnabled -> Bool
pRuntimeSetCustomObjectFormatterEnabledEnabled :: Bool
  }
  deriving (PRuntimeSetCustomObjectFormatterEnabled
-> PRuntimeSetCustomObjectFormatterEnabled -> Bool
(PRuntimeSetCustomObjectFormatterEnabled
 -> PRuntimeSetCustomObjectFormatterEnabled -> Bool)
-> (PRuntimeSetCustomObjectFormatterEnabled
    -> PRuntimeSetCustomObjectFormatterEnabled -> Bool)
-> Eq PRuntimeSetCustomObjectFormatterEnabled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeSetCustomObjectFormatterEnabled
-> PRuntimeSetCustomObjectFormatterEnabled -> Bool
$c/= :: PRuntimeSetCustomObjectFormatterEnabled
-> PRuntimeSetCustomObjectFormatterEnabled -> Bool
== :: PRuntimeSetCustomObjectFormatterEnabled
-> PRuntimeSetCustomObjectFormatterEnabled -> Bool
$c== :: PRuntimeSetCustomObjectFormatterEnabled
-> PRuntimeSetCustomObjectFormatterEnabled -> Bool
Eq, Int -> PRuntimeSetCustomObjectFormatterEnabled -> ShowS
[PRuntimeSetCustomObjectFormatterEnabled] -> ShowS
PRuntimeSetCustomObjectFormatterEnabled -> String
(Int -> PRuntimeSetCustomObjectFormatterEnabled -> ShowS)
-> (PRuntimeSetCustomObjectFormatterEnabled -> String)
-> ([PRuntimeSetCustomObjectFormatterEnabled] -> ShowS)
-> Show PRuntimeSetCustomObjectFormatterEnabled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeSetCustomObjectFormatterEnabled] -> ShowS
$cshowList :: [PRuntimeSetCustomObjectFormatterEnabled] -> ShowS
show :: PRuntimeSetCustomObjectFormatterEnabled -> String
$cshow :: PRuntimeSetCustomObjectFormatterEnabled -> String
showsPrec :: Int -> PRuntimeSetCustomObjectFormatterEnabled -> ShowS
$cshowsPrec :: Int -> PRuntimeSetCustomObjectFormatterEnabled -> ShowS
Show)
pRuntimeSetCustomObjectFormatterEnabled
  :: Bool
  -> PRuntimeSetCustomObjectFormatterEnabled
pRuntimeSetCustomObjectFormatterEnabled :: Bool -> PRuntimeSetCustomObjectFormatterEnabled
pRuntimeSetCustomObjectFormatterEnabled
  Bool
arg_pRuntimeSetCustomObjectFormatterEnabledEnabled
  = Bool -> PRuntimeSetCustomObjectFormatterEnabled
PRuntimeSetCustomObjectFormatterEnabled
    Bool
arg_pRuntimeSetCustomObjectFormatterEnabledEnabled
instance ToJSON PRuntimeSetCustomObjectFormatterEnabled where
  toJSON :: PRuntimeSetCustomObjectFormatterEnabled -> Value
toJSON PRuntimeSetCustomObjectFormatterEnabled
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"enabled" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Bool -> Pair) -> Maybe Bool -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (PRuntimeSetCustomObjectFormatterEnabled -> Bool
pRuntimeSetCustomObjectFormatterEnabledEnabled PRuntimeSetCustomObjectFormatterEnabled
p)
    ]
instance Command PRuntimeSetCustomObjectFormatterEnabled where
  type CommandResponse PRuntimeSetCustomObjectFormatterEnabled = ()
  commandName :: Proxy PRuntimeSetCustomObjectFormatterEnabled -> String
commandName Proxy PRuntimeSetCustomObjectFormatterEnabled
_ = String
"Runtime.setCustomObjectFormatterEnabled"
  fromJSON :: Proxy PRuntimeSetCustomObjectFormatterEnabled
-> Value
-> Result (CommandResponse PRuntimeSetCustomObjectFormatterEnabled)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeSetCustomObjectFormatterEnabled -> Result ())
-> Proxy PRuntimeSetCustomObjectFormatterEnabled
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeSetCustomObjectFormatterEnabled -> ())
-> Proxy PRuntimeSetCustomObjectFormatterEnabled
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeSetCustomObjectFormatterEnabled -> ()
forall a b. a -> b -> a
const ()


-- | Parameters of the 'Runtime.setMaxCallStackSizeToCapture' command.
data PRuntimeSetMaxCallStackSizeToCapture = PRuntimeSetMaxCallStackSizeToCapture
  {
    PRuntimeSetMaxCallStackSizeToCapture -> Int
pRuntimeSetMaxCallStackSizeToCaptureSize :: Int
  }
  deriving (PRuntimeSetMaxCallStackSizeToCapture
-> PRuntimeSetMaxCallStackSizeToCapture -> Bool
(PRuntimeSetMaxCallStackSizeToCapture
 -> PRuntimeSetMaxCallStackSizeToCapture -> Bool)
-> (PRuntimeSetMaxCallStackSizeToCapture
    -> PRuntimeSetMaxCallStackSizeToCapture -> Bool)
-> Eq PRuntimeSetMaxCallStackSizeToCapture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeSetMaxCallStackSizeToCapture
-> PRuntimeSetMaxCallStackSizeToCapture -> Bool
$c/= :: PRuntimeSetMaxCallStackSizeToCapture
-> PRuntimeSetMaxCallStackSizeToCapture -> Bool
== :: PRuntimeSetMaxCallStackSizeToCapture
-> PRuntimeSetMaxCallStackSizeToCapture -> Bool
$c== :: PRuntimeSetMaxCallStackSizeToCapture
-> PRuntimeSetMaxCallStackSizeToCapture -> Bool
Eq, Int -> PRuntimeSetMaxCallStackSizeToCapture -> ShowS
[PRuntimeSetMaxCallStackSizeToCapture] -> ShowS
PRuntimeSetMaxCallStackSizeToCapture -> String
(Int -> PRuntimeSetMaxCallStackSizeToCapture -> ShowS)
-> (PRuntimeSetMaxCallStackSizeToCapture -> String)
-> ([PRuntimeSetMaxCallStackSizeToCapture] -> ShowS)
-> Show PRuntimeSetMaxCallStackSizeToCapture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeSetMaxCallStackSizeToCapture] -> ShowS
$cshowList :: [PRuntimeSetMaxCallStackSizeToCapture] -> ShowS
show :: PRuntimeSetMaxCallStackSizeToCapture -> String
$cshow :: PRuntimeSetMaxCallStackSizeToCapture -> String
showsPrec :: Int -> PRuntimeSetMaxCallStackSizeToCapture -> ShowS
$cshowsPrec :: Int -> PRuntimeSetMaxCallStackSizeToCapture -> ShowS
Show)
pRuntimeSetMaxCallStackSizeToCapture
  :: Int
  -> PRuntimeSetMaxCallStackSizeToCapture
pRuntimeSetMaxCallStackSizeToCapture :: Int -> PRuntimeSetMaxCallStackSizeToCapture
pRuntimeSetMaxCallStackSizeToCapture
  Int
arg_pRuntimeSetMaxCallStackSizeToCaptureSize
  = Int -> PRuntimeSetMaxCallStackSizeToCapture
PRuntimeSetMaxCallStackSizeToCapture
    Int
arg_pRuntimeSetMaxCallStackSizeToCaptureSize
instance ToJSON PRuntimeSetMaxCallStackSizeToCapture where
  toJSON :: PRuntimeSetMaxCallStackSizeToCapture -> Value
toJSON PRuntimeSetMaxCallStackSizeToCapture
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
"size" 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 (PRuntimeSetMaxCallStackSizeToCapture -> Int
pRuntimeSetMaxCallStackSizeToCaptureSize PRuntimeSetMaxCallStackSizeToCapture
p)
    ]
instance Command PRuntimeSetMaxCallStackSizeToCapture where
  type CommandResponse PRuntimeSetMaxCallStackSizeToCapture = ()
  commandName :: Proxy PRuntimeSetMaxCallStackSizeToCapture -> String
commandName Proxy PRuntimeSetMaxCallStackSizeToCapture
_ = String
"Runtime.setMaxCallStackSizeToCapture"
  fromJSON :: Proxy PRuntimeSetMaxCallStackSizeToCapture
-> Value
-> Result (CommandResponse PRuntimeSetMaxCallStackSizeToCapture)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeSetMaxCallStackSizeToCapture -> Result ())
-> Proxy PRuntimeSetMaxCallStackSizeToCapture
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeSetMaxCallStackSizeToCapture -> ())
-> Proxy PRuntimeSetMaxCallStackSizeToCapture
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeSetMaxCallStackSizeToCapture -> ()
forall a b. a -> b -> a
const ()

-- | Terminate current or next JavaScript execution.
--   Will cancel the termination when the outer-most script execution ends.

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

-- | If executionContextId is empty, adds binding with the given name on the
--   global objects of all inspected contexts, including those created later,
--   bindings survive reloads.
--   Binding function takes exactly one argument, this argument should be string,
--   in case of any other input, function throws an exception.
--   Each binding function call produces Runtime.bindingCalled notification.

-- | Parameters of the 'Runtime.addBinding' command.
data PRuntimeAddBinding = PRuntimeAddBinding
  {
    PRuntimeAddBinding -> Text
pRuntimeAddBindingName :: T.Text,
    -- | If specified, the binding is exposed to the executionContext with
    --   matching name, even for contexts created after the binding is added.
    --   See also `ExecutionContext.name` and `worldName` parameter to
    --   `Page.addScriptToEvaluateOnNewDocument`.
    --   This parameter is mutually exclusive with `executionContextId`.
    PRuntimeAddBinding -> Maybe Text
pRuntimeAddBindingExecutionContextName :: Maybe T.Text
  }
  deriving (PRuntimeAddBinding -> PRuntimeAddBinding -> Bool
(PRuntimeAddBinding -> PRuntimeAddBinding -> Bool)
-> (PRuntimeAddBinding -> PRuntimeAddBinding -> Bool)
-> Eq PRuntimeAddBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeAddBinding -> PRuntimeAddBinding -> Bool
$c/= :: PRuntimeAddBinding -> PRuntimeAddBinding -> Bool
== :: PRuntimeAddBinding -> PRuntimeAddBinding -> Bool
$c== :: PRuntimeAddBinding -> PRuntimeAddBinding -> Bool
Eq, Int -> PRuntimeAddBinding -> ShowS
[PRuntimeAddBinding] -> ShowS
PRuntimeAddBinding -> String
(Int -> PRuntimeAddBinding -> ShowS)
-> (PRuntimeAddBinding -> String)
-> ([PRuntimeAddBinding] -> ShowS)
-> Show PRuntimeAddBinding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeAddBinding] -> ShowS
$cshowList :: [PRuntimeAddBinding] -> ShowS
show :: PRuntimeAddBinding -> String
$cshow :: PRuntimeAddBinding -> String
showsPrec :: Int -> PRuntimeAddBinding -> ShowS
$cshowsPrec :: Int -> PRuntimeAddBinding -> ShowS
Show)
pRuntimeAddBinding
  :: T.Text
  -> PRuntimeAddBinding
pRuntimeAddBinding :: Text -> PRuntimeAddBinding
pRuntimeAddBinding
  Text
arg_pRuntimeAddBindingName
  = Text -> Maybe Text -> PRuntimeAddBinding
PRuntimeAddBinding
    Text
arg_pRuntimeAddBindingName
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PRuntimeAddBinding where
  toJSON :: PRuntimeAddBinding -> Value
toJSON PRuntimeAddBinding
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PRuntimeAddBinding -> Text
pRuntimeAddBindingName PRuntimeAddBinding
p),
    (Text
"executionContextName" 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
<$> (PRuntimeAddBinding -> Maybe Text
pRuntimeAddBindingExecutionContextName PRuntimeAddBinding
p)
    ]
instance Command PRuntimeAddBinding where
  type CommandResponse PRuntimeAddBinding = ()
  commandName :: Proxy PRuntimeAddBinding -> String
commandName Proxy PRuntimeAddBinding
_ = String
"Runtime.addBinding"
  fromJSON :: Proxy PRuntimeAddBinding
-> Value -> Result (CommandResponse PRuntimeAddBinding)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeAddBinding -> Result ())
-> Proxy PRuntimeAddBinding
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeAddBinding -> ())
-> Proxy PRuntimeAddBinding
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeAddBinding -> ()
forall a b. a -> b -> a
const ()

-- | This method does not remove binding function from global object but
--   unsubscribes current runtime agent from Runtime.bindingCalled notifications.

-- | Parameters of the 'Runtime.removeBinding' command.
data PRuntimeRemoveBinding = PRuntimeRemoveBinding
  {
    PRuntimeRemoveBinding -> Text
pRuntimeRemoveBindingName :: T.Text
  }
  deriving (PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool
(PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool)
-> (PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool)
-> Eq PRuntimeRemoveBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool
$c/= :: PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool
== :: PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool
$c== :: PRuntimeRemoveBinding -> PRuntimeRemoveBinding -> Bool
Eq, Int -> PRuntimeRemoveBinding -> ShowS
[PRuntimeRemoveBinding] -> ShowS
PRuntimeRemoveBinding -> String
(Int -> PRuntimeRemoveBinding -> ShowS)
-> (PRuntimeRemoveBinding -> String)
-> ([PRuntimeRemoveBinding] -> ShowS)
-> Show PRuntimeRemoveBinding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeRemoveBinding] -> ShowS
$cshowList :: [PRuntimeRemoveBinding] -> ShowS
show :: PRuntimeRemoveBinding -> String
$cshow :: PRuntimeRemoveBinding -> String
showsPrec :: Int -> PRuntimeRemoveBinding -> ShowS
$cshowsPrec :: Int -> PRuntimeRemoveBinding -> ShowS
Show)
pRuntimeRemoveBinding
  :: T.Text
  -> PRuntimeRemoveBinding
pRuntimeRemoveBinding :: Text -> PRuntimeRemoveBinding
pRuntimeRemoveBinding
  Text
arg_pRuntimeRemoveBindingName
  = Text -> PRuntimeRemoveBinding
PRuntimeRemoveBinding
    Text
arg_pRuntimeRemoveBindingName
instance ToJSON PRuntimeRemoveBinding where
  toJSON :: PRuntimeRemoveBinding -> Value
toJSON PRuntimeRemoveBinding
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (PRuntimeRemoveBinding -> Text
pRuntimeRemoveBindingName PRuntimeRemoveBinding
p)
    ]
instance Command PRuntimeRemoveBinding where
  type CommandResponse PRuntimeRemoveBinding = ()
  commandName :: Proxy PRuntimeRemoveBinding -> String
commandName Proxy PRuntimeRemoveBinding
_ = String
"Runtime.removeBinding"
  fromJSON :: Proxy PRuntimeRemoveBinding
-> Value -> Result (CommandResponse PRuntimeRemoveBinding)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PRuntimeRemoveBinding -> Result ())
-> Proxy PRuntimeRemoveBinding
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PRuntimeRemoveBinding -> ())
-> Proxy PRuntimeRemoveBinding
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PRuntimeRemoveBinding -> ()
forall a b. a -> b -> a
const ()

-- | This method tries to lookup and populate exception details for a
--   JavaScript Error object.
--   Note that the stackTrace portion of the resulting exceptionDetails will
--   only be populated if the Runtime domain was enabled at the time when the
--   Error was thrown.

-- | Parameters of the 'Runtime.getExceptionDetails' command.
data PRuntimeGetExceptionDetails = PRuntimeGetExceptionDetails
  {
    -- | The error object for which to resolve the exception details.
    PRuntimeGetExceptionDetails -> Text
pRuntimeGetExceptionDetailsErrorObjectId :: RuntimeRemoteObjectId
  }
  deriving (PRuntimeGetExceptionDetails -> PRuntimeGetExceptionDetails -> Bool
(PRuntimeGetExceptionDetails
 -> PRuntimeGetExceptionDetails -> Bool)
-> (PRuntimeGetExceptionDetails
    -> PRuntimeGetExceptionDetails -> Bool)
-> Eq PRuntimeGetExceptionDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PRuntimeGetExceptionDetails -> PRuntimeGetExceptionDetails -> Bool
$c/= :: PRuntimeGetExceptionDetails -> PRuntimeGetExceptionDetails -> Bool
== :: PRuntimeGetExceptionDetails -> PRuntimeGetExceptionDetails -> Bool
$c== :: PRuntimeGetExceptionDetails -> PRuntimeGetExceptionDetails -> Bool
Eq, Int -> PRuntimeGetExceptionDetails -> ShowS
[PRuntimeGetExceptionDetails] -> ShowS
PRuntimeGetExceptionDetails -> String
(Int -> PRuntimeGetExceptionDetails -> ShowS)
-> (PRuntimeGetExceptionDetails -> String)
-> ([PRuntimeGetExceptionDetails] -> ShowS)
-> Show PRuntimeGetExceptionDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PRuntimeGetExceptionDetails] -> ShowS
$cshowList :: [PRuntimeGetExceptionDetails] -> ShowS
show :: PRuntimeGetExceptionDetails -> String
$cshow :: PRuntimeGetExceptionDetails -> String
showsPrec :: Int -> PRuntimeGetExceptionDetails -> ShowS
$cshowsPrec :: Int -> PRuntimeGetExceptionDetails -> ShowS
Show)
pRuntimeGetExceptionDetails
  {-
  -- | The error object for which to resolve the exception details.
  -}
  :: RuntimeRemoteObjectId
  -> PRuntimeGetExceptionDetails
pRuntimeGetExceptionDetails :: Text -> PRuntimeGetExceptionDetails
pRuntimeGetExceptionDetails
  Text
arg_pRuntimeGetExceptionDetailsErrorObjectId
  = Text -> PRuntimeGetExceptionDetails
PRuntimeGetExceptionDetails
    Text
arg_pRuntimeGetExceptionDetailsErrorObjectId
instance ToJSON PRuntimeGetExceptionDetails where
  toJSON :: PRuntimeGetExceptionDetails -> Value
toJSON PRuntimeGetExceptionDetails
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
"errorObjectId" 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 (PRuntimeGetExceptionDetails -> Text
pRuntimeGetExceptionDetailsErrorObjectId PRuntimeGetExceptionDetails
p)
    ]
data RuntimeGetExceptionDetails = RuntimeGetExceptionDetails
  {
    RuntimeGetExceptionDetails -> Maybe RuntimeExceptionDetails
runtimeGetExceptionDetailsExceptionDetails :: Maybe RuntimeExceptionDetails
  }
  deriving (RuntimeGetExceptionDetails -> RuntimeGetExceptionDetails -> Bool
(RuntimeGetExceptionDetails -> RuntimeGetExceptionDetails -> Bool)
-> (RuntimeGetExceptionDetails
    -> RuntimeGetExceptionDetails -> Bool)
-> Eq RuntimeGetExceptionDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeGetExceptionDetails -> RuntimeGetExceptionDetails -> Bool
$c/= :: RuntimeGetExceptionDetails -> RuntimeGetExceptionDetails -> Bool
== :: RuntimeGetExceptionDetails -> RuntimeGetExceptionDetails -> Bool
$c== :: RuntimeGetExceptionDetails -> RuntimeGetExceptionDetails -> Bool
Eq, Int -> RuntimeGetExceptionDetails -> ShowS
[RuntimeGetExceptionDetails] -> ShowS
RuntimeGetExceptionDetails -> String
(Int -> RuntimeGetExceptionDetails -> ShowS)
-> (RuntimeGetExceptionDetails -> String)
-> ([RuntimeGetExceptionDetails] -> ShowS)
-> Show RuntimeGetExceptionDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeGetExceptionDetails] -> ShowS
$cshowList :: [RuntimeGetExceptionDetails] -> ShowS
show :: RuntimeGetExceptionDetails -> String
$cshow :: RuntimeGetExceptionDetails -> String
showsPrec :: Int -> RuntimeGetExceptionDetails -> ShowS
$cshowsPrec :: Int -> RuntimeGetExceptionDetails -> ShowS
Show)
instance FromJSON RuntimeGetExceptionDetails where
  parseJSON :: Value -> Parser RuntimeGetExceptionDetails
parseJSON = String
-> (Object -> Parser RuntimeGetExceptionDetails)
-> Value
-> Parser RuntimeGetExceptionDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"RuntimeGetExceptionDetails" ((Object -> Parser RuntimeGetExceptionDetails)
 -> Value -> Parser RuntimeGetExceptionDetails)
-> (Object -> Parser RuntimeGetExceptionDetails)
-> Value
-> Parser RuntimeGetExceptionDetails
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe RuntimeExceptionDetails -> RuntimeGetExceptionDetails
RuntimeGetExceptionDetails
    (Maybe RuntimeExceptionDetails -> RuntimeGetExceptionDetails)
-> Parser (Maybe RuntimeExceptionDetails)
-> Parser RuntimeGetExceptionDetails
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe RuntimeExceptionDetails)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"exceptionDetails"
instance Command PRuntimeGetExceptionDetails where
  type CommandResponse PRuntimeGetExceptionDetails = RuntimeGetExceptionDetails
  commandName :: Proxy PRuntimeGetExceptionDetails -> String
commandName Proxy PRuntimeGetExceptionDetails
_ = String
"Runtime.getExceptionDetails"