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


{- |
= HeapProfiler

-}


module CDP.Domains.HeapProfiler (module CDP.Domains.HeapProfiler) where

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

import CDP.Internal.Utils


import CDP.Domains.Runtime as Runtime


-- | Type 'HeapProfiler.HeapSnapshotObjectId'.
--   Heap snapshot object id.
type HeapProfilerHeapSnapshotObjectId = T.Text

-- | Type 'HeapProfiler.SamplingHeapProfileNode'.
--   Sampling Heap Profile node. Holds callsite information, allocation statistics and child nodes.
data HeapProfilerSamplingHeapProfileNode = HeapProfilerSamplingHeapProfileNode
  {
    -- | Function location.
    HeapProfilerSamplingHeapProfileNode -> RuntimeCallFrame
heapProfilerSamplingHeapProfileNodeCallFrame :: Runtime.RuntimeCallFrame,
    -- | Allocations size in bytes for the node excluding children.
    HeapProfilerSamplingHeapProfileNode -> Double
heapProfilerSamplingHeapProfileNodeSelfSize :: Double,
    -- | Node id. Ids are unique across all profiles collected between startSampling and stopSampling.
    HeapProfilerSamplingHeapProfileNode -> Int
heapProfilerSamplingHeapProfileNodeId :: Int,
    -- | Child nodes.
    HeapProfilerSamplingHeapProfileNode
-> [HeapProfilerSamplingHeapProfileNode]
heapProfilerSamplingHeapProfileNodeChildren :: [HeapProfilerSamplingHeapProfileNode]
  }
  deriving (HeapProfilerSamplingHeapProfileNode
-> HeapProfilerSamplingHeapProfileNode -> Bool
(HeapProfilerSamplingHeapProfileNode
 -> HeapProfilerSamplingHeapProfileNode -> Bool)
-> (HeapProfilerSamplingHeapProfileNode
    -> HeapProfilerSamplingHeapProfileNode -> Bool)
-> Eq HeapProfilerSamplingHeapProfileNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerSamplingHeapProfileNode
-> HeapProfilerSamplingHeapProfileNode -> Bool
$c/= :: HeapProfilerSamplingHeapProfileNode
-> HeapProfilerSamplingHeapProfileNode -> Bool
== :: HeapProfilerSamplingHeapProfileNode
-> HeapProfilerSamplingHeapProfileNode -> Bool
$c== :: HeapProfilerSamplingHeapProfileNode
-> HeapProfilerSamplingHeapProfileNode -> Bool
Eq, Int -> HeapProfilerSamplingHeapProfileNode -> ShowS
[HeapProfilerSamplingHeapProfileNode] -> ShowS
HeapProfilerSamplingHeapProfileNode -> String
(Int -> HeapProfilerSamplingHeapProfileNode -> ShowS)
-> (HeapProfilerSamplingHeapProfileNode -> String)
-> ([HeapProfilerSamplingHeapProfileNode] -> ShowS)
-> Show HeapProfilerSamplingHeapProfileNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerSamplingHeapProfileNode] -> ShowS
$cshowList :: [HeapProfilerSamplingHeapProfileNode] -> ShowS
show :: HeapProfilerSamplingHeapProfileNode -> String
$cshow :: HeapProfilerSamplingHeapProfileNode -> String
showsPrec :: Int -> HeapProfilerSamplingHeapProfileNode -> ShowS
$cshowsPrec :: Int -> HeapProfilerSamplingHeapProfileNode -> ShowS
Show)
instance FromJSON HeapProfilerSamplingHeapProfileNode where
  parseJSON :: Value -> Parser HeapProfilerSamplingHeapProfileNode
parseJSON = String
-> (Object -> Parser HeapProfilerSamplingHeapProfileNode)
-> Value
-> Parser HeapProfilerSamplingHeapProfileNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerSamplingHeapProfileNode" ((Object -> Parser HeapProfilerSamplingHeapProfileNode)
 -> Value -> Parser HeapProfilerSamplingHeapProfileNode)
-> (Object -> Parser HeapProfilerSamplingHeapProfileNode)
-> Value
-> Parser HeapProfilerSamplingHeapProfileNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeCallFrame
-> Double
-> Int
-> [HeapProfilerSamplingHeapProfileNode]
-> HeapProfilerSamplingHeapProfileNode
HeapProfilerSamplingHeapProfileNode
    (RuntimeCallFrame
 -> Double
 -> Int
 -> [HeapProfilerSamplingHeapProfileNode]
 -> HeapProfilerSamplingHeapProfileNode)
-> Parser RuntimeCallFrame
-> Parser
     (Double
      -> Int
      -> [HeapProfilerSamplingHeapProfileNode]
      -> HeapProfilerSamplingHeapProfileNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser RuntimeCallFrame
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"callFrame"
    Parser
  (Double
   -> Int
   -> [HeapProfilerSamplingHeapProfileNode]
   -> HeapProfilerSamplingHeapProfileNode)
-> Parser Double
-> Parser
     (Int
      -> [HeapProfilerSamplingHeapProfileNode]
      -> HeapProfilerSamplingHeapProfileNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"selfSize"
    Parser
  (Int
   -> [HeapProfilerSamplingHeapProfileNode]
   -> HeapProfilerSamplingHeapProfileNode)
-> Parser Int
-> Parser
     ([HeapProfilerSamplingHeapProfileNode]
      -> HeapProfilerSamplingHeapProfileNode)
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
"id"
    Parser
  ([HeapProfilerSamplingHeapProfileNode]
   -> HeapProfilerSamplingHeapProfileNode)
-> Parser [HeapProfilerSamplingHeapProfileNode]
-> Parser HeapProfilerSamplingHeapProfileNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [HeapProfilerSamplingHeapProfileNode]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"children"
instance ToJSON HeapProfilerSamplingHeapProfileNode where
  toJSON :: HeapProfilerSamplingHeapProfileNode -> Value
toJSON HeapProfilerSamplingHeapProfileNode
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
"callFrame" 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 (HeapProfilerSamplingHeapProfileNode -> RuntimeCallFrame
heapProfilerSamplingHeapProfileNodeCallFrame HeapProfilerSamplingHeapProfileNode
p),
    (Text
"selfSize" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfileNode -> Double
heapProfilerSamplingHeapProfileNodeSelfSize HeapProfilerSamplingHeapProfileNode
p),
    (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 (HeapProfilerSamplingHeapProfileNode -> Int
heapProfilerSamplingHeapProfileNodeId HeapProfilerSamplingHeapProfileNode
p),
    (Text
"children" Text -> [HeapProfilerSamplingHeapProfileNode] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([HeapProfilerSamplingHeapProfileNode] -> Pair)
-> Maybe [HeapProfilerSamplingHeapProfileNode] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HeapProfilerSamplingHeapProfileNode]
-> Maybe [HeapProfilerSamplingHeapProfileNode]
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfileNode
-> [HeapProfilerSamplingHeapProfileNode]
heapProfilerSamplingHeapProfileNodeChildren HeapProfilerSamplingHeapProfileNode
p)
    ]

-- | Type 'HeapProfiler.SamplingHeapProfileSample'.
--   A single sample from a sampling profile.
data HeapProfilerSamplingHeapProfileSample = HeapProfilerSamplingHeapProfileSample
  {
    -- | Allocation size in bytes attributed to the sample.
    HeapProfilerSamplingHeapProfileSample -> Double
heapProfilerSamplingHeapProfileSampleSize :: Double,
    -- | Id of the corresponding profile tree node.
    HeapProfilerSamplingHeapProfileSample -> Int
heapProfilerSamplingHeapProfileSampleNodeId :: Int,
    -- | Time-ordered sample ordinal number. It is unique across all profiles retrieved
    --   between startSampling and stopSampling.
    HeapProfilerSamplingHeapProfileSample -> Double
heapProfilerSamplingHeapProfileSampleOrdinal :: Double
  }
  deriving (HeapProfilerSamplingHeapProfileSample
-> HeapProfilerSamplingHeapProfileSample -> Bool
(HeapProfilerSamplingHeapProfileSample
 -> HeapProfilerSamplingHeapProfileSample -> Bool)
-> (HeapProfilerSamplingHeapProfileSample
    -> HeapProfilerSamplingHeapProfileSample -> Bool)
-> Eq HeapProfilerSamplingHeapProfileSample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerSamplingHeapProfileSample
-> HeapProfilerSamplingHeapProfileSample -> Bool
$c/= :: HeapProfilerSamplingHeapProfileSample
-> HeapProfilerSamplingHeapProfileSample -> Bool
== :: HeapProfilerSamplingHeapProfileSample
-> HeapProfilerSamplingHeapProfileSample -> Bool
$c== :: HeapProfilerSamplingHeapProfileSample
-> HeapProfilerSamplingHeapProfileSample -> Bool
Eq, Int -> HeapProfilerSamplingHeapProfileSample -> ShowS
[HeapProfilerSamplingHeapProfileSample] -> ShowS
HeapProfilerSamplingHeapProfileSample -> String
(Int -> HeapProfilerSamplingHeapProfileSample -> ShowS)
-> (HeapProfilerSamplingHeapProfileSample -> String)
-> ([HeapProfilerSamplingHeapProfileSample] -> ShowS)
-> Show HeapProfilerSamplingHeapProfileSample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerSamplingHeapProfileSample] -> ShowS
$cshowList :: [HeapProfilerSamplingHeapProfileSample] -> ShowS
show :: HeapProfilerSamplingHeapProfileSample -> String
$cshow :: HeapProfilerSamplingHeapProfileSample -> String
showsPrec :: Int -> HeapProfilerSamplingHeapProfileSample -> ShowS
$cshowsPrec :: Int -> HeapProfilerSamplingHeapProfileSample -> ShowS
Show)
instance FromJSON HeapProfilerSamplingHeapProfileSample where
  parseJSON :: Value -> Parser HeapProfilerSamplingHeapProfileSample
parseJSON = String
-> (Object -> Parser HeapProfilerSamplingHeapProfileSample)
-> Value
-> Parser HeapProfilerSamplingHeapProfileSample
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerSamplingHeapProfileSample" ((Object -> Parser HeapProfilerSamplingHeapProfileSample)
 -> Value -> Parser HeapProfilerSamplingHeapProfileSample)
-> (Object -> Parser HeapProfilerSamplingHeapProfileSample)
-> Value
-> Parser HeapProfilerSamplingHeapProfileSample
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> Int -> Double -> HeapProfilerSamplingHeapProfileSample
HeapProfilerSamplingHeapProfileSample
    (Double -> Int -> Double -> HeapProfilerSamplingHeapProfileSample)
-> Parser Double
-> Parser (Int -> Double -> HeapProfilerSamplingHeapProfileSample)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"size"
    Parser (Int -> Double -> HeapProfilerSamplingHeapProfileSample)
-> Parser Int
-> Parser (Double -> HeapProfilerSamplingHeapProfileSample)
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
"nodeId"
    Parser (Double -> HeapProfilerSamplingHeapProfileSample)
-> Parser Double -> Parser HeapProfilerSamplingHeapProfileSample
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"ordinal"
instance ToJSON HeapProfilerSamplingHeapProfileSample where
  toJSON :: HeapProfilerSamplingHeapProfileSample -> Value
toJSON HeapProfilerSamplingHeapProfileSample
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 -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfileSample -> Double
heapProfilerSamplingHeapProfileSampleSize HeapProfilerSamplingHeapProfileSample
p),
    (Text
"nodeId" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfileSample -> Int
heapProfilerSamplingHeapProfileSampleNodeId HeapProfilerSamplingHeapProfileSample
p),
    (Text
"ordinal" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Maybe Double
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfileSample -> Double
heapProfilerSamplingHeapProfileSampleOrdinal HeapProfilerSamplingHeapProfileSample
p)
    ]

-- | Type 'HeapProfiler.SamplingHeapProfile'.
--   Sampling profile.
data HeapProfilerSamplingHeapProfile = HeapProfilerSamplingHeapProfile
  {
    HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfileNode
heapProfilerSamplingHeapProfileHead :: HeapProfilerSamplingHeapProfileNode,
    HeapProfilerSamplingHeapProfile
-> [HeapProfilerSamplingHeapProfileSample]
heapProfilerSamplingHeapProfileSamples :: [HeapProfilerSamplingHeapProfileSample]
  }
  deriving (HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfile -> Bool
(HeapProfilerSamplingHeapProfile
 -> HeapProfilerSamplingHeapProfile -> Bool)
-> (HeapProfilerSamplingHeapProfile
    -> HeapProfilerSamplingHeapProfile -> Bool)
-> Eq HeapProfilerSamplingHeapProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfile -> Bool
$c/= :: HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfile -> Bool
== :: HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfile -> Bool
$c== :: HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfile -> Bool
Eq, Int -> HeapProfilerSamplingHeapProfile -> ShowS
[HeapProfilerSamplingHeapProfile] -> ShowS
HeapProfilerSamplingHeapProfile -> String
(Int -> HeapProfilerSamplingHeapProfile -> ShowS)
-> (HeapProfilerSamplingHeapProfile -> String)
-> ([HeapProfilerSamplingHeapProfile] -> ShowS)
-> Show HeapProfilerSamplingHeapProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerSamplingHeapProfile] -> ShowS
$cshowList :: [HeapProfilerSamplingHeapProfile] -> ShowS
show :: HeapProfilerSamplingHeapProfile -> String
$cshow :: HeapProfilerSamplingHeapProfile -> String
showsPrec :: Int -> HeapProfilerSamplingHeapProfile -> ShowS
$cshowsPrec :: Int -> HeapProfilerSamplingHeapProfile -> ShowS
Show)
instance FromJSON HeapProfilerSamplingHeapProfile where
  parseJSON :: Value -> Parser HeapProfilerSamplingHeapProfile
parseJSON = String
-> (Object -> Parser HeapProfilerSamplingHeapProfile)
-> Value
-> Parser HeapProfilerSamplingHeapProfile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerSamplingHeapProfile" ((Object -> Parser HeapProfilerSamplingHeapProfile)
 -> Value -> Parser HeapProfilerSamplingHeapProfile)
-> (Object -> Parser HeapProfilerSamplingHeapProfile)
-> Value
-> Parser HeapProfilerSamplingHeapProfile
forall a b. (a -> b) -> a -> b
$ \Object
o -> HeapProfilerSamplingHeapProfileNode
-> [HeapProfilerSamplingHeapProfileSample]
-> HeapProfilerSamplingHeapProfile
HeapProfilerSamplingHeapProfile
    (HeapProfilerSamplingHeapProfileNode
 -> [HeapProfilerSamplingHeapProfileSample]
 -> HeapProfilerSamplingHeapProfile)
-> Parser HeapProfilerSamplingHeapProfileNode
-> Parser
     ([HeapProfilerSamplingHeapProfileSample]
      -> HeapProfilerSamplingHeapProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser HeapProfilerSamplingHeapProfileNode
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"head"
    Parser
  ([HeapProfilerSamplingHeapProfileSample]
   -> HeapProfilerSamplingHeapProfile)
-> Parser [HeapProfilerSamplingHeapProfileSample]
-> Parser HeapProfilerSamplingHeapProfile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [HeapProfilerSamplingHeapProfileSample]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"samples"
instance ToJSON HeapProfilerSamplingHeapProfile where
  toJSON :: HeapProfilerSamplingHeapProfile -> Value
toJSON HeapProfilerSamplingHeapProfile
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
"head" Text -> HeapProfilerSamplingHeapProfileNode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (HeapProfilerSamplingHeapProfileNode -> Pair)
-> Maybe HeapProfilerSamplingHeapProfileNode -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeapProfilerSamplingHeapProfileNode
-> Maybe HeapProfilerSamplingHeapProfileNode
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfile
-> HeapProfilerSamplingHeapProfileNode
heapProfilerSamplingHeapProfileHead HeapProfilerSamplingHeapProfile
p),
    (Text
"samples" Text -> [HeapProfilerSamplingHeapProfileSample] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([HeapProfilerSamplingHeapProfileSample] -> Pair)
-> Maybe [HeapProfilerSamplingHeapProfileSample] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HeapProfilerSamplingHeapProfileSample]
-> Maybe [HeapProfilerSamplingHeapProfileSample]
forall a. a -> Maybe a
Just (HeapProfilerSamplingHeapProfile
-> [HeapProfilerSamplingHeapProfileSample]
heapProfilerSamplingHeapProfileSamples HeapProfilerSamplingHeapProfile
p)
    ]

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

-- | Type of the 'HeapProfiler.heapStatsUpdate' event.
data HeapProfilerHeapStatsUpdate = HeapProfilerHeapStatsUpdate
  {
    -- | An array of triplets. Each triplet describes a fragment. The first integer is the fragment
    --   index, the second integer is a total count of objects for the fragment, the third integer is
    --   a total size of the objects for the fragment.
    HeapProfilerHeapStatsUpdate -> [Int]
heapProfilerHeapStatsUpdateStatsUpdate :: [Int]
  }
  deriving (HeapProfilerHeapStatsUpdate -> HeapProfilerHeapStatsUpdate -> Bool
(HeapProfilerHeapStatsUpdate
 -> HeapProfilerHeapStatsUpdate -> Bool)
-> (HeapProfilerHeapStatsUpdate
    -> HeapProfilerHeapStatsUpdate -> Bool)
-> Eq HeapProfilerHeapStatsUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerHeapStatsUpdate -> HeapProfilerHeapStatsUpdate -> Bool
$c/= :: HeapProfilerHeapStatsUpdate -> HeapProfilerHeapStatsUpdate -> Bool
== :: HeapProfilerHeapStatsUpdate -> HeapProfilerHeapStatsUpdate -> Bool
$c== :: HeapProfilerHeapStatsUpdate -> HeapProfilerHeapStatsUpdate -> Bool
Eq, Int -> HeapProfilerHeapStatsUpdate -> ShowS
[HeapProfilerHeapStatsUpdate] -> ShowS
HeapProfilerHeapStatsUpdate -> String
(Int -> HeapProfilerHeapStatsUpdate -> ShowS)
-> (HeapProfilerHeapStatsUpdate -> String)
-> ([HeapProfilerHeapStatsUpdate] -> ShowS)
-> Show HeapProfilerHeapStatsUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerHeapStatsUpdate] -> ShowS
$cshowList :: [HeapProfilerHeapStatsUpdate] -> ShowS
show :: HeapProfilerHeapStatsUpdate -> String
$cshow :: HeapProfilerHeapStatsUpdate -> String
showsPrec :: Int -> HeapProfilerHeapStatsUpdate -> ShowS
$cshowsPrec :: Int -> HeapProfilerHeapStatsUpdate -> ShowS
Show)
instance FromJSON HeapProfilerHeapStatsUpdate where
  parseJSON :: Value -> Parser HeapProfilerHeapStatsUpdate
parseJSON = String
-> (Object -> Parser HeapProfilerHeapStatsUpdate)
-> Value
-> Parser HeapProfilerHeapStatsUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerHeapStatsUpdate" ((Object -> Parser HeapProfilerHeapStatsUpdate)
 -> Value -> Parser HeapProfilerHeapStatsUpdate)
-> (Object -> Parser HeapProfilerHeapStatsUpdate)
-> Value
-> Parser HeapProfilerHeapStatsUpdate
forall a b. (a -> b) -> a -> b
$ \Object
o -> [Int] -> HeapProfilerHeapStatsUpdate
HeapProfilerHeapStatsUpdate
    ([Int] -> HeapProfilerHeapStatsUpdate)
-> Parser [Int] -> Parser HeapProfilerHeapStatsUpdate
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
"statsUpdate"
instance Event HeapProfilerHeapStatsUpdate where
  eventName :: Proxy HeapProfilerHeapStatsUpdate -> String
eventName Proxy HeapProfilerHeapStatsUpdate
_ = String
"HeapProfiler.heapStatsUpdate"

-- | Type of the 'HeapProfiler.lastSeenObjectId' event.
data HeapProfilerLastSeenObjectId = HeapProfilerLastSeenObjectId
  {
    HeapProfilerLastSeenObjectId -> Int
heapProfilerLastSeenObjectIdLastSeenObjectId :: Int,
    HeapProfilerLastSeenObjectId -> Double
heapProfilerLastSeenObjectIdTimestamp :: Double
  }
  deriving (HeapProfilerLastSeenObjectId
-> HeapProfilerLastSeenObjectId -> Bool
(HeapProfilerLastSeenObjectId
 -> HeapProfilerLastSeenObjectId -> Bool)
-> (HeapProfilerLastSeenObjectId
    -> HeapProfilerLastSeenObjectId -> Bool)
-> Eq HeapProfilerLastSeenObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerLastSeenObjectId
-> HeapProfilerLastSeenObjectId -> Bool
$c/= :: HeapProfilerLastSeenObjectId
-> HeapProfilerLastSeenObjectId -> Bool
== :: HeapProfilerLastSeenObjectId
-> HeapProfilerLastSeenObjectId -> Bool
$c== :: HeapProfilerLastSeenObjectId
-> HeapProfilerLastSeenObjectId -> Bool
Eq, Int -> HeapProfilerLastSeenObjectId -> ShowS
[HeapProfilerLastSeenObjectId] -> ShowS
HeapProfilerLastSeenObjectId -> String
(Int -> HeapProfilerLastSeenObjectId -> ShowS)
-> (HeapProfilerLastSeenObjectId -> String)
-> ([HeapProfilerLastSeenObjectId] -> ShowS)
-> Show HeapProfilerLastSeenObjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerLastSeenObjectId] -> ShowS
$cshowList :: [HeapProfilerLastSeenObjectId] -> ShowS
show :: HeapProfilerLastSeenObjectId -> String
$cshow :: HeapProfilerLastSeenObjectId -> String
showsPrec :: Int -> HeapProfilerLastSeenObjectId -> ShowS
$cshowsPrec :: Int -> HeapProfilerLastSeenObjectId -> ShowS
Show)
instance FromJSON HeapProfilerLastSeenObjectId where
  parseJSON :: Value -> Parser HeapProfilerLastSeenObjectId
parseJSON = String
-> (Object -> Parser HeapProfilerLastSeenObjectId)
-> Value
-> Parser HeapProfilerLastSeenObjectId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerLastSeenObjectId" ((Object -> Parser HeapProfilerLastSeenObjectId)
 -> Value -> Parser HeapProfilerLastSeenObjectId)
-> (Object -> Parser HeapProfilerLastSeenObjectId)
-> Value
-> Parser HeapProfilerLastSeenObjectId
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Double -> HeapProfilerLastSeenObjectId
HeapProfilerLastSeenObjectId
    (Int -> Double -> HeapProfilerLastSeenObjectId)
-> Parser Int -> Parser (Double -> HeapProfilerLastSeenObjectId)
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
"lastSeenObjectId"
    Parser (Double -> HeapProfilerLastSeenObjectId)
-> Parser Double -> Parser HeapProfilerLastSeenObjectId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"timestamp"
instance Event HeapProfilerLastSeenObjectId where
  eventName :: Proxy HeapProfilerLastSeenObjectId -> String
eventName Proxy HeapProfilerLastSeenObjectId
_ = String
"HeapProfiler.lastSeenObjectId"

-- | Type of the 'HeapProfiler.reportHeapSnapshotProgress' event.
data HeapProfilerReportHeapSnapshotProgress = HeapProfilerReportHeapSnapshotProgress
  {
    HeapProfilerReportHeapSnapshotProgress -> Int
heapProfilerReportHeapSnapshotProgressDone :: Int,
    HeapProfilerReportHeapSnapshotProgress -> Int
heapProfilerReportHeapSnapshotProgressTotal :: Int,
    HeapProfilerReportHeapSnapshotProgress -> Maybe Bool
heapProfilerReportHeapSnapshotProgressFinished :: Maybe Bool
  }
  deriving (HeapProfilerReportHeapSnapshotProgress
-> HeapProfilerReportHeapSnapshotProgress -> Bool
(HeapProfilerReportHeapSnapshotProgress
 -> HeapProfilerReportHeapSnapshotProgress -> Bool)
-> (HeapProfilerReportHeapSnapshotProgress
    -> HeapProfilerReportHeapSnapshotProgress -> Bool)
-> Eq HeapProfilerReportHeapSnapshotProgress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerReportHeapSnapshotProgress
-> HeapProfilerReportHeapSnapshotProgress -> Bool
$c/= :: HeapProfilerReportHeapSnapshotProgress
-> HeapProfilerReportHeapSnapshotProgress -> Bool
== :: HeapProfilerReportHeapSnapshotProgress
-> HeapProfilerReportHeapSnapshotProgress -> Bool
$c== :: HeapProfilerReportHeapSnapshotProgress
-> HeapProfilerReportHeapSnapshotProgress -> Bool
Eq, Int -> HeapProfilerReportHeapSnapshotProgress -> ShowS
[HeapProfilerReportHeapSnapshotProgress] -> ShowS
HeapProfilerReportHeapSnapshotProgress -> String
(Int -> HeapProfilerReportHeapSnapshotProgress -> ShowS)
-> (HeapProfilerReportHeapSnapshotProgress -> String)
-> ([HeapProfilerReportHeapSnapshotProgress] -> ShowS)
-> Show HeapProfilerReportHeapSnapshotProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerReportHeapSnapshotProgress] -> ShowS
$cshowList :: [HeapProfilerReportHeapSnapshotProgress] -> ShowS
show :: HeapProfilerReportHeapSnapshotProgress -> String
$cshow :: HeapProfilerReportHeapSnapshotProgress -> String
showsPrec :: Int -> HeapProfilerReportHeapSnapshotProgress -> ShowS
$cshowsPrec :: Int -> HeapProfilerReportHeapSnapshotProgress -> ShowS
Show)
instance FromJSON HeapProfilerReportHeapSnapshotProgress where
  parseJSON :: Value -> Parser HeapProfilerReportHeapSnapshotProgress
parseJSON = String
-> (Object -> Parser HeapProfilerReportHeapSnapshotProgress)
-> Value
-> Parser HeapProfilerReportHeapSnapshotProgress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerReportHeapSnapshotProgress" ((Object -> Parser HeapProfilerReportHeapSnapshotProgress)
 -> Value -> Parser HeapProfilerReportHeapSnapshotProgress)
-> (Object -> Parser HeapProfilerReportHeapSnapshotProgress)
-> Value
-> Parser HeapProfilerReportHeapSnapshotProgress
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> Maybe Bool -> HeapProfilerReportHeapSnapshotProgress
HeapProfilerReportHeapSnapshotProgress
    (Int
 -> Int -> Maybe Bool -> HeapProfilerReportHeapSnapshotProgress)
-> Parser Int
-> Parser
     (Int -> Maybe Bool -> HeapProfilerReportHeapSnapshotProgress)
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
"done"
    Parser
  (Int -> Maybe Bool -> HeapProfilerReportHeapSnapshotProgress)
-> Parser Int
-> Parser (Maybe Bool -> HeapProfilerReportHeapSnapshotProgress)
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
"total"
    Parser (Maybe Bool -> HeapProfilerReportHeapSnapshotProgress)
-> Parser (Maybe Bool)
-> Parser HeapProfilerReportHeapSnapshotProgress
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
"finished"
instance Event HeapProfilerReportHeapSnapshotProgress where
  eventName :: Proxy HeapProfilerReportHeapSnapshotProgress -> String
eventName Proxy HeapProfilerReportHeapSnapshotProgress
_ = String
"HeapProfiler.reportHeapSnapshotProgress"

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

-- | Enables console to refer to the node with given id via $x (see Command Line API for more details
--   $x functions).

-- | Parameters of the 'HeapProfiler.addInspectedHeapObject' command.
data PHeapProfilerAddInspectedHeapObject = PHeapProfilerAddInspectedHeapObject
  {
    -- | Heap snapshot object id to be accessible by means of $x command line API.
    PHeapProfilerAddInspectedHeapObject -> Text
pHeapProfilerAddInspectedHeapObjectHeapObjectId :: HeapProfilerHeapSnapshotObjectId
  }
  deriving (PHeapProfilerAddInspectedHeapObject
-> PHeapProfilerAddInspectedHeapObject -> Bool
(PHeapProfilerAddInspectedHeapObject
 -> PHeapProfilerAddInspectedHeapObject -> Bool)
-> (PHeapProfilerAddInspectedHeapObject
    -> PHeapProfilerAddInspectedHeapObject -> Bool)
-> Eq PHeapProfilerAddInspectedHeapObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerAddInspectedHeapObject
-> PHeapProfilerAddInspectedHeapObject -> Bool
$c/= :: PHeapProfilerAddInspectedHeapObject
-> PHeapProfilerAddInspectedHeapObject -> Bool
== :: PHeapProfilerAddInspectedHeapObject
-> PHeapProfilerAddInspectedHeapObject -> Bool
$c== :: PHeapProfilerAddInspectedHeapObject
-> PHeapProfilerAddInspectedHeapObject -> Bool
Eq, Int -> PHeapProfilerAddInspectedHeapObject -> ShowS
[PHeapProfilerAddInspectedHeapObject] -> ShowS
PHeapProfilerAddInspectedHeapObject -> String
(Int -> PHeapProfilerAddInspectedHeapObject -> ShowS)
-> (PHeapProfilerAddInspectedHeapObject -> String)
-> ([PHeapProfilerAddInspectedHeapObject] -> ShowS)
-> Show PHeapProfilerAddInspectedHeapObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerAddInspectedHeapObject] -> ShowS
$cshowList :: [PHeapProfilerAddInspectedHeapObject] -> ShowS
show :: PHeapProfilerAddInspectedHeapObject -> String
$cshow :: PHeapProfilerAddInspectedHeapObject -> String
showsPrec :: Int -> PHeapProfilerAddInspectedHeapObject -> ShowS
$cshowsPrec :: Int -> PHeapProfilerAddInspectedHeapObject -> ShowS
Show)
pHeapProfilerAddInspectedHeapObject
  {-
  -- | Heap snapshot object id to be accessible by means of $x command line API.
  -}
  :: HeapProfilerHeapSnapshotObjectId
  -> PHeapProfilerAddInspectedHeapObject
pHeapProfilerAddInspectedHeapObject :: Text -> PHeapProfilerAddInspectedHeapObject
pHeapProfilerAddInspectedHeapObject
  Text
arg_pHeapProfilerAddInspectedHeapObjectHeapObjectId
  = Text -> PHeapProfilerAddInspectedHeapObject
PHeapProfilerAddInspectedHeapObject
    Text
arg_pHeapProfilerAddInspectedHeapObjectHeapObjectId
instance ToJSON PHeapProfilerAddInspectedHeapObject where
  toJSON :: PHeapProfilerAddInspectedHeapObject -> Value
toJSON PHeapProfilerAddInspectedHeapObject
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
"heapObjectId" 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 (PHeapProfilerAddInspectedHeapObject -> Text
pHeapProfilerAddInspectedHeapObjectHeapObjectId PHeapProfilerAddInspectedHeapObject
p)
    ]
instance Command PHeapProfilerAddInspectedHeapObject where
  type CommandResponse PHeapProfilerAddInspectedHeapObject = ()
  commandName :: Proxy PHeapProfilerAddInspectedHeapObject -> String
commandName Proxy PHeapProfilerAddInspectedHeapObject
_ = String
"HeapProfiler.addInspectedHeapObject"
  fromJSON :: Proxy PHeapProfilerAddInspectedHeapObject
-> Value
-> Result (CommandResponse PHeapProfilerAddInspectedHeapObject)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PHeapProfilerAddInspectedHeapObject -> Result ())
-> Proxy PHeapProfilerAddInspectedHeapObject
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PHeapProfilerAddInspectedHeapObject -> ())
-> Proxy PHeapProfilerAddInspectedHeapObject
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PHeapProfilerAddInspectedHeapObject -> ()
forall a b. a -> b -> a
const ()


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


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


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


-- | Parameters of the 'HeapProfiler.getHeapObjectId' command.
data PHeapProfilerGetHeapObjectId = PHeapProfilerGetHeapObjectId
  {
    -- | Identifier of the object to get heap object id for.
    PHeapProfilerGetHeapObjectId -> Text
pHeapProfilerGetHeapObjectIdObjectId :: Runtime.RuntimeRemoteObjectId
  }
  deriving (PHeapProfilerGetHeapObjectId
-> PHeapProfilerGetHeapObjectId -> Bool
(PHeapProfilerGetHeapObjectId
 -> PHeapProfilerGetHeapObjectId -> Bool)
-> (PHeapProfilerGetHeapObjectId
    -> PHeapProfilerGetHeapObjectId -> Bool)
-> Eq PHeapProfilerGetHeapObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerGetHeapObjectId
-> PHeapProfilerGetHeapObjectId -> Bool
$c/= :: PHeapProfilerGetHeapObjectId
-> PHeapProfilerGetHeapObjectId -> Bool
== :: PHeapProfilerGetHeapObjectId
-> PHeapProfilerGetHeapObjectId -> Bool
$c== :: PHeapProfilerGetHeapObjectId
-> PHeapProfilerGetHeapObjectId -> Bool
Eq, Int -> PHeapProfilerGetHeapObjectId -> ShowS
[PHeapProfilerGetHeapObjectId] -> ShowS
PHeapProfilerGetHeapObjectId -> String
(Int -> PHeapProfilerGetHeapObjectId -> ShowS)
-> (PHeapProfilerGetHeapObjectId -> String)
-> ([PHeapProfilerGetHeapObjectId] -> ShowS)
-> Show PHeapProfilerGetHeapObjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerGetHeapObjectId] -> ShowS
$cshowList :: [PHeapProfilerGetHeapObjectId] -> ShowS
show :: PHeapProfilerGetHeapObjectId -> String
$cshow :: PHeapProfilerGetHeapObjectId -> String
showsPrec :: Int -> PHeapProfilerGetHeapObjectId -> ShowS
$cshowsPrec :: Int -> PHeapProfilerGetHeapObjectId -> ShowS
Show)
pHeapProfilerGetHeapObjectId
  {-
  -- | Identifier of the object to get heap object id for.
  -}
  :: Runtime.RuntimeRemoteObjectId
  -> PHeapProfilerGetHeapObjectId
pHeapProfilerGetHeapObjectId :: Text -> PHeapProfilerGetHeapObjectId
pHeapProfilerGetHeapObjectId
  Text
arg_pHeapProfilerGetHeapObjectIdObjectId
  = Text -> PHeapProfilerGetHeapObjectId
PHeapProfilerGetHeapObjectId
    Text
arg_pHeapProfilerGetHeapObjectIdObjectId
instance ToJSON PHeapProfilerGetHeapObjectId where
  toJSON :: PHeapProfilerGetHeapObjectId -> Value
toJSON PHeapProfilerGetHeapObjectId
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 (PHeapProfilerGetHeapObjectId -> Text
pHeapProfilerGetHeapObjectIdObjectId PHeapProfilerGetHeapObjectId
p)
    ]
data HeapProfilerGetHeapObjectId = HeapProfilerGetHeapObjectId
  {
    -- | Id of the heap snapshot object corresponding to the passed remote object id.
    HeapProfilerGetHeapObjectId -> Text
heapProfilerGetHeapObjectIdHeapSnapshotObjectId :: HeapProfilerHeapSnapshotObjectId
  }
  deriving (HeapProfilerGetHeapObjectId -> HeapProfilerGetHeapObjectId -> Bool
(HeapProfilerGetHeapObjectId
 -> HeapProfilerGetHeapObjectId -> Bool)
-> (HeapProfilerGetHeapObjectId
    -> HeapProfilerGetHeapObjectId -> Bool)
-> Eq HeapProfilerGetHeapObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerGetHeapObjectId -> HeapProfilerGetHeapObjectId -> Bool
$c/= :: HeapProfilerGetHeapObjectId -> HeapProfilerGetHeapObjectId -> Bool
== :: HeapProfilerGetHeapObjectId -> HeapProfilerGetHeapObjectId -> Bool
$c== :: HeapProfilerGetHeapObjectId -> HeapProfilerGetHeapObjectId -> Bool
Eq, Int -> HeapProfilerGetHeapObjectId -> ShowS
[HeapProfilerGetHeapObjectId] -> ShowS
HeapProfilerGetHeapObjectId -> String
(Int -> HeapProfilerGetHeapObjectId -> ShowS)
-> (HeapProfilerGetHeapObjectId -> String)
-> ([HeapProfilerGetHeapObjectId] -> ShowS)
-> Show HeapProfilerGetHeapObjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerGetHeapObjectId] -> ShowS
$cshowList :: [HeapProfilerGetHeapObjectId] -> ShowS
show :: HeapProfilerGetHeapObjectId -> String
$cshow :: HeapProfilerGetHeapObjectId -> String
showsPrec :: Int -> HeapProfilerGetHeapObjectId -> ShowS
$cshowsPrec :: Int -> HeapProfilerGetHeapObjectId -> ShowS
Show)
instance FromJSON HeapProfilerGetHeapObjectId where
  parseJSON :: Value -> Parser HeapProfilerGetHeapObjectId
parseJSON = String
-> (Object -> Parser HeapProfilerGetHeapObjectId)
-> Value
-> Parser HeapProfilerGetHeapObjectId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerGetHeapObjectId" ((Object -> Parser HeapProfilerGetHeapObjectId)
 -> Value -> Parser HeapProfilerGetHeapObjectId)
-> (Object -> Parser HeapProfilerGetHeapObjectId)
-> Value
-> Parser HeapProfilerGetHeapObjectId
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> HeapProfilerGetHeapObjectId
HeapProfilerGetHeapObjectId
    (Text -> HeapProfilerGetHeapObjectId)
-> Parser Text -> Parser HeapProfilerGetHeapObjectId
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
"heapSnapshotObjectId"
instance Command PHeapProfilerGetHeapObjectId where
  type CommandResponse PHeapProfilerGetHeapObjectId = HeapProfilerGetHeapObjectId
  commandName :: Proxy PHeapProfilerGetHeapObjectId -> String
commandName Proxy PHeapProfilerGetHeapObjectId
_ = String
"HeapProfiler.getHeapObjectId"


-- | Parameters of the 'HeapProfiler.getObjectByHeapObjectId' command.
data PHeapProfilerGetObjectByHeapObjectId = PHeapProfilerGetObjectByHeapObjectId
  {
    PHeapProfilerGetObjectByHeapObjectId -> Text
pHeapProfilerGetObjectByHeapObjectIdObjectId :: HeapProfilerHeapSnapshotObjectId,
    -- | Symbolic group name that can be used to release multiple objects.
    PHeapProfilerGetObjectByHeapObjectId -> Maybe Text
pHeapProfilerGetObjectByHeapObjectIdObjectGroup :: Maybe T.Text
  }
  deriving (PHeapProfilerGetObjectByHeapObjectId
-> PHeapProfilerGetObjectByHeapObjectId -> Bool
(PHeapProfilerGetObjectByHeapObjectId
 -> PHeapProfilerGetObjectByHeapObjectId -> Bool)
-> (PHeapProfilerGetObjectByHeapObjectId
    -> PHeapProfilerGetObjectByHeapObjectId -> Bool)
-> Eq PHeapProfilerGetObjectByHeapObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerGetObjectByHeapObjectId
-> PHeapProfilerGetObjectByHeapObjectId -> Bool
$c/= :: PHeapProfilerGetObjectByHeapObjectId
-> PHeapProfilerGetObjectByHeapObjectId -> Bool
== :: PHeapProfilerGetObjectByHeapObjectId
-> PHeapProfilerGetObjectByHeapObjectId -> Bool
$c== :: PHeapProfilerGetObjectByHeapObjectId
-> PHeapProfilerGetObjectByHeapObjectId -> Bool
Eq, Int -> PHeapProfilerGetObjectByHeapObjectId -> ShowS
[PHeapProfilerGetObjectByHeapObjectId] -> ShowS
PHeapProfilerGetObjectByHeapObjectId -> String
(Int -> PHeapProfilerGetObjectByHeapObjectId -> ShowS)
-> (PHeapProfilerGetObjectByHeapObjectId -> String)
-> ([PHeapProfilerGetObjectByHeapObjectId] -> ShowS)
-> Show PHeapProfilerGetObjectByHeapObjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerGetObjectByHeapObjectId] -> ShowS
$cshowList :: [PHeapProfilerGetObjectByHeapObjectId] -> ShowS
show :: PHeapProfilerGetObjectByHeapObjectId -> String
$cshow :: PHeapProfilerGetObjectByHeapObjectId -> String
showsPrec :: Int -> PHeapProfilerGetObjectByHeapObjectId -> ShowS
$cshowsPrec :: Int -> PHeapProfilerGetObjectByHeapObjectId -> ShowS
Show)
pHeapProfilerGetObjectByHeapObjectId
  :: HeapProfilerHeapSnapshotObjectId
  -> PHeapProfilerGetObjectByHeapObjectId
pHeapProfilerGetObjectByHeapObjectId :: Text -> PHeapProfilerGetObjectByHeapObjectId
pHeapProfilerGetObjectByHeapObjectId
  Text
arg_pHeapProfilerGetObjectByHeapObjectIdObjectId
  = Text -> Maybe Text -> PHeapProfilerGetObjectByHeapObjectId
PHeapProfilerGetObjectByHeapObjectId
    Text
arg_pHeapProfilerGetObjectByHeapObjectIdObjectId
    Maybe Text
forall a. Maybe a
Nothing
instance ToJSON PHeapProfilerGetObjectByHeapObjectId where
  toJSON :: PHeapProfilerGetObjectByHeapObjectId -> Value
toJSON PHeapProfilerGetObjectByHeapObjectId
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 (PHeapProfilerGetObjectByHeapObjectId -> Text
pHeapProfilerGetObjectByHeapObjectIdObjectId PHeapProfilerGetObjectByHeapObjectId
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
<$> (PHeapProfilerGetObjectByHeapObjectId -> Maybe Text
pHeapProfilerGetObjectByHeapObjectIdObjectGroup PHeapProfilerGetObjectByHeapObjectId
p)
    ]
data HeapProfilerGetObjectByHeapObjectId = HeapProfilerGetObjectByHeapObjectId
  {
    -- | Evaluation result.
    HeapProfilerGetObjectByHeapObjectId -> RuntimeRemoteObject
heapProfilerGetObjectByHeapObjectIdResult :: Runtime.RuntimeRemoteObject
  }
  deriving (HeapProfilerGetObjectByHeapObjectId
-> HeapProfilerGetObjectByHeapObjectId -> Bool
(HeapProfilerGetObjectByHeapObjectId
 -> HeapProfilerGetObjectByHeapObjectId -> Bool)
-> (HeapProfilerGetObjectByHeapObjectId
    -> HeapProfilerGetObjectByHeapObjectId -> Bool)
-> Eq HeapProfilerGetObjectByHeapObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerGetObjectByHeapObjectId
-> HeapProfilerGetObjectByHeapObjectId -> Bool
$c/= :: HeapProfilerGetObjectByHeapObjectId
-> HeapProfilerGetObjectByHeapObjectId -> Bool
== :: HeapProfilerGetObjectByHeapObjectId
-> HeapProfilerGetObjectByHeapObjectId -> Bool
$c== :: HeapProfilerGetObjectByHeapObjectId
-> HeapProfilerGetObjectByHeapObjectId -> Bool
Eq, Int -> HeapProfilerGetObjectByHeapObjectId -> ShowS
[HeapProfilerGetObjectByHeapObjectId] -> ShowS
HeapProfilerGetObjectByHeapObjectId -> String
(Int -> HeapProfilerGetObjectByHeapObjectId -> ShowS)
-> (HeapProfilerGetObjectByHeapObjectId -> String)
-> ([HeapProfilerGetObjectByHeapObjectId] -> ShowS)
-> Show HeapProfilerGetObjectByHeapObjectId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerGetObjectByHeapObjectId] -> ShowS
$cshowList :: [HeapProfilerGetObjectByHeapObjectId] -> ShowS
show :: HeapProfilerGetObjectByHeapObjectId -> String
$cshow :: HeapProfilerGetObjectByHeapObjectId -> String
showsPrec :: Int -> HeapProfilerGetObjectByHeapObjectId -> ShowS
$cshowsPrec :: Int -> HeapProfilerGetObjectByHeapObjectId -> ShowS
Show)
instance FromJSON HeapProfilerGetObjectByHeapObjectId where
  parseJSON :: Value -> Parser HeapProfilerGetObjectByHeapObjectId
parseJSON = String
-> (Object -> Parser HeapProfilerGetObjectByHeapObjectId)
-> Value
-> Parser HeapProfilerGetObjectByHeapObjectId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerGetObjectByHeapObjectId" ((Object -> Parser HeapProfilerGetObjectByHeapObjectId)
 -> Value -> Parser HeapProfilerGetObjectByHeapObjectId)
-> (Object -> Parser HeapProfilerGetObjectByHeapObjectId)
-> Value
-> Parser HeapProfilerGetObjectByHeapObjectId
forall a b. (a -> b) -> a -> b
$ \Object
o -> RuntimeRemoteObject -> HeapProfilerGetObjectByHeapObjectId
HeapProfilerGetObjectByHeapObjectId
    (RuntimeRemoteObject -> HeapProfilerGetObjectByHeapObjectId)
-> Parser RuntimeRemoteObject
-> Parser HeapProfilerGetObjectByHeapObjectId
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"
instance Command PHeapProfilerGetObjectByHeapObjectId where
  type CommandResponse PHeapProfilerGetObjectByHeapObjectId = HeapProfilerGetObjectByHeapObjectId
  commandName :: Proxy PHeapProfilerGetObjectByHeapObjectId -> String
commandName Proxy PHeapProfilerGetObjectByHeapObjectId
_ = String
"HeapProfiler.getObjectByHeapObjectId"


-- | Parameters of the 'HeapProfiler.getSamplingProfile' command.
data PHeapProfilerGetSamplingProfile = PHeapProfilerGetSamplingProfile
  deriving (PHeapProfilerGetSamplingProfile
-> PHeapProfilerGetSamplingProfile -> Bool
(PHeapProfilerGetSamplingProfile
 -> PHeapProfilerGetSamplingProfile -> Bool)
-> (PHeapProfilerGetSamplingProfile
    -> PHeapProfilerGetSamplingProfile -> Bool)
-> Eq PHeapProfilerGetSamplingProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerGetSamplingProfile
-> PHeapProfilerGetSamplingProfile -> Bool
$c/= :: PHeapProfilerGetSamplingProfile
-> PHeapProfilerGetSamplingProfile -> Bool
== :: PHeapProfilerGetSamplingProfile
-> PHeapProfilerGetSamplingProfile -> Bool
$c== :: PHeapProfilerGetSamplingProfile
-> PHeapProfilerGetSamplingProfile -> Bool
Eq, Int -> PHeapProfilerGetSamplingProfile -> ShowS
[PHeapProfilerGetSamplingProfile] -> ShowS
PHeapProfilerGetSamplingProfile -> String
(Int -> PHeapProfilerGetSamplingProfile -> ShowS)
-> (PHeapProfilerGetSamplingProfile -> String)
-> ([PHeapProfilerGetSamplingProfile] -> ShowS)
-> Show PHeapProfilerGetSamplingProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerGetSamplingProfile] -> ShowS
$cshowList :: [PHeapProfilerGetSamplingProfile] -> ShowS
show :: PHeapProfilerGetSamplingProfile -> String
$cshow :: PHeapProfilerGetSamplingProfile -> String
showsPrec :: Int -> PHeapProfilerGetSamplingProfile -> ShowS
$cshowsPrec :: Int -> PHeapProfilerGetSamplingProfile -> ShowS
Show)
pHeapProfilerGetSamplingProfile
  :: PHeapProfilerGetSamplingProfile
pHeapProfilerGetSamplingProfile :: PHeapProfilerGetSamplingProfile
pHeapProfilerGetSamplingProfile
  = PHeapProfilerGetSamplingProfile
PHeapProfilerGetSamplingProfile
instance ToJSON PHeapProfilerGetSamplingProfile where
  toJSON :: PHeapProfilerGetSamplingProfile -> Value
toJSON PHeapProfilerGetSamplingProfile
_ = Value
A.Null
data HeapProfilerGetSamplingProfile = HeapProfilerGetSamplingProfile
  {
    -- | Return the sampling profile being collected.
    HeapProfilerGetSamplingProfile -> HeapProfilerSamplingHeapProfile
heapProfilerGetSamplingProfileProfile :: HeapProfilerSamplingHeapProfile
  }
  deriving (HeapProfilerGetSamplingProfile
-> HeapProfilerGetSamplingProfile -> Bool
(HeapProfilerGetSamplingProfile
 -> HeapProfilerGetSamplingProfile -> Bool)
-> (HeapProfilerGetSamplingProfile
    -> HeapProfilerGetSamplingProfile -> Bool)
-> Eq HeapProfilerGetSamplingProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerGetSamplingProfile
-> HeapProfilerGetSamplingProfile -> Bool
$c/= :: HeapProfilerGetSamplingProfile
-> HeapProfilerGetSamplingProfile -> Bool
== :: HeapProfilerGetSamplingProfile
-> HeapProfilerGetSamplingProfile -> Bool
$c== :: HeapProfilerGetSamplingProfile
-> HeapProfilerGetSamplingProfile -> Bool
Eq, Int -> HeapProfilerGetSamplingProfile -> ShowS
[HeapProfilerGetSamplingProfile] -> ShowS
HeapProfilerGetSamplingProfile -> String
(Int -> HeapProfilerGetSamplingProfile -> ShowS)
-> (HeapProfilerGetSamplingProfile -> String)
-> ([HeapProfilerGetSamplingProfile] -> ShowS)
-> Show HeapProfilerGetSamplingProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerGetSamplingProfile] -> ShowS
$cshowList :: [HeapProfilerGetSamplingProfile] -> ShowS
show :: HeapProfilerGetSamplingProfile -> String
$cshow :: HeapProfilerGetSamplingProfile -> String
showsPrec :: Int -> HeapProfilerGetSamplingProfile -> ShowS
$cshowsPrec :: Int -> HeapProfilerGetSamplingProfile -> ShowS
Show)
instance FromJSON HeapProfilerGetSamplingProfile where
  parseJSON :: Value -> Parser HeapProfilerGetSamplingProfile
parseJSON = String
-> (Object -> Parser HeapProfilerGetSamplingProfile)
-> Value
-> Parser HeapProfilerGetSamplingProfile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerGetSamplingProfile" ((Object -> Parser HeapProfilerGetSamplingProfile)
 -> Value -> Parser HeapProfilerGetSamplingProfile)
-> (Object -> Parser HeapProfilerGetSamplingProfile)
-> Value
-> Parser HeapProfilerGetSamplingProfile
forall a b. (a -> b) -> a -> b
$ \Object
o -> HeapProfilerSamplingHeapProfile -> HeapProfilerGetSamplingProfile
HeapProfilerGetSamplingProfile
    (HeapProfilerSamplingHeapProfile -> HeapProfilerGetSamplingProfile)
-> Parser HeapProfilerSamplingHeapProfile
-> Parser HeapProfilerGetSamplingProfile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser HeapProfilerSamplingHeapProfile
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"profile"
instance Command PHeapProfilerGetSamplingProfile where
  type CommandResponse PHeapProfilerGetSamplingProfile = HeapProfilerGetSamplingProfile
  commandName :: Proxy PHeapProfilerGetSamplingProfile -> String
commandName Proxy PHeapProfilerGetSamplingProfile
_ = String
"HeapProfiler.getSamplingProfile"


-- | Parameters of the 'HeapProfiler.startSampling' command.
data PHeapProfilerStartSampling = PHeapProfilerStartSampling
  {
    -- | Average sample interval in bytes. Poisson distribution is used for the intervals. The
    --   default value is 32768 bytes.
    PHeapProfilerStartSampling -> Maybe Double
pHeapProfilerStartSamplingSamplingInterval :: Maybe Double,
    -- | By default, the sampling heap profiler reports only objects which are
    --   still alive when the profile is returned via getSamplingProfile or
    --   stopSampling, which is useful for determining what functions contribute
    --   the most to steady-state memory usage. This flag instructs the sampling
    --   heap profiler to also include information about objects discarded by
    --   major GC, which will show which functions cause large temporary memory
    --   usage or long GC pauses.
    PHeapProfilerStartSampling -> Maybe Bool
pHeapProfilerStartSamplingIncludeObjectsCollectedByMajorGC :: Maybe Bool,
    -- | By default, the sampling heap profiler reports only objects which are
    --   still alive when the profile is returned via getSamplingProfile or
    --   stopSampling, which is useful for determining what functions contribute
    --   the most to steady-state memory usage. This flag instructs the sampling
    --   heap profiler to also include information about objects discarded by
    --   minor GC, which is useful when tuning a latency-sensitive application
    --   for minimal GC activity.
    PHeapProfilerStartSampling -> Maybe Bool
pHeapProfilerStartSamplingIncludeObjectsCollectedByMinorGC :: Maybe Bool
  }
  deriving (PHeapProfilerStartSampling -> PHeapProfilerStartSampling -> Bool
(PHeapProfilerStartSampling -> PHeapProfilerStartSampling -> Bool)
-> (PHeapProfilerStartSampling
    -> PHeapProfilerStartSampling -> Bool)
-> Eq PHeapProfilerStartSampling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerStartSampling -> PHeapProfilerStartSampling -> Bool
$c/= :: PHeapProfilerStartSampling -> PHeapProfilerStartSampling -> Bool
== :: PHeapProfilerStartSampling -> PHeapProfilerStartSampling -> Bool
$c== :: PHeapProfilerStartSampling -> PHeapProfilerStartSampling -> Bool
Eq, Int -> PHeapProfilerStartSampling -> ShowS
[PHeapProfilerStartSampling] -> ShowS
PHeapProfilerStartSampling -> String
(Int -> PHeapProfilerStartSampling -> ShowS)
-> (PHeapProfilerStartSampling -> String)
-> ([PHeapProfilerStartSampling] -> ShowS)
-> Show PHeapProfilerStartSampling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerStartSampling] -> ShowS
$cshowList :: [PHeapProfilerStartSampling] -> ShowS
show :: PHeapProfilerStartSampling -> String
$cshow :: PHeapProfilerStartSampling -> String
showsPrec :: Int -> PHeapProfilerStartSampling -> ShowS
$cshowsPrec :: Int -> PHeapProfilerStartSampling -> ShowS
Show)
pHeapProfilerStartSampling
  :: PHeapProfilerStartSampling
pHeapProfilerStartSampling :: PHeapProfilerStartSampling
pHeapProfilerStartSampling
  = Maybe Double
-> Maybe Bool -> Maybe Bool -> PHeapProfilerStartSampling
PHeapProfilerStartSampling
    Maybe Double
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PHeapProfilerStartSampling where
  toJSON :: PHeapProfilerStartSampling -> Value
toJSON PHeapProfilerStartSampling
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
"samplingInterval" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PHeapProfilerStartSampling -> Maybe Double
pHeapProfilerStartSamplingSamplingInterval PHeapProfilerStartSampling
p),
    (Text
"includeObjectsCollectedByMajorGC" 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
<$> (PHeapProfilerStartSampling -> Maybe Bool
pHeapProfilerStartSamplingIncludeObjectsCollectedByMajorGC PHeapProfilerStartSampling
p),
    (Text
"includeObjectsCollectedByMinorGC" 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
<$> (PHeapProfilerStartSampling -> Maybe Bool
pHeapProfilerStartSamplingIncludeObjectsCollectedByMinorGC PHeapProfilerStartSampling
p)
    ]
instance Command PHeapProfilerStartSampling where
  type CommandResponse PHeapProfilerStartSampling = ()
  commandName :: Proxy PHeapProfilerStartSampling -> String
commandName Proxy PHeapProfilerStartSampling
_ = String
"HeapProfiler.startSampling"
  fromJSON :: Proxy PHeapProfilerStartSampling
-> Value -> Result (CommandResponse PHeapProfilerStartSampling)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PHeapProfilerStartSampling -> Result ())
-> Proxy PHeapProfilerStartSampling
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PHeapProfilerStartSampling -> ())
-> Proxy PHeapProfilerStartSampling
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PHeapProfilerStartSampling -> ()
forall a b. a -> b -> a
const ()


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


-- | Parameters of the 'HeapProfiler.stopSampling' command.
data PHeapProfilerStopSampling = PHeapProfilerStopSampling
  deriving (PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool
(PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool)
-> (PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool)
-> Eq PHeapProfilerStopSampling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool
$c/= :: PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool
== :: PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool
$c== :: PHeapProfilerStopSampling -> PHeapProfilerStopSampling -> Bool
Eq, Int -> PHeapProfilerStopSampling -> ShowS
[PHeapProfilerStopSampling] -> ShowS
PHeapProfilerStopSampling -> String
(Int -> PHeapProfilerStopSampling -> ShowS)
-> (PHeapProfilerStopSampling -> String)
-> ([PHeapProfilerStopSampling] -> ShowS)
-> Show PHeapProfilerStopSampling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerStopSampling] -> ShowS
$cshowList :: [PHeapProfilerStopSampling] -> ShowS
show :: PHeapProfilerStopSampling -> String
$cshow :: PHeapProfilerStopSampling -> String
showsPrec :: Int -> PHeapProfilerStopSampling -> ShowS
$cshowsPrec :: Int -> PHeapProfilerStopSampling -> ShowS
Show)
pHeapProfilerStopSampling
  :: PHeapProfilerStopSampling
pHeapProfilerStopSampling :: PHeapProfilerStopSampling
pHeapProfilerStopSampling
  = PHeapProfilerStopSampling
PHeapProfilerStopSampling
instance ToJSON PHeapProfilerStopSampling where
  toJSON :: PHeapProfilerStopSampling -> Value
toJSON PHeapProfilerStopSampling
_ = Value
A.Null
data HeapProfilerStopSampling = HeapProfilerStopSampling
  {
    -- | Recorded sampling heap profile.
    HeapProfilerStopSampling -> HeapProfilerSamplingHeapProfile
heapProfilerStopSamplingProfile :: HeapProfilerSamplingHeapProfile
  }
  deriving (HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool
(HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool)
-> (HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool)
-> Eq HeapProfilerStopSampling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool
$c/= :: HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool
== :: HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool
$c== :: HeapProfilerStopSampling -> HeapProfilerStopSampling -> Bool
Eq, Int -> HeapProfilerStopSampling -> ShowS
[HeapProfilerStopSampling] -> ShowS
HeapProfilerStopSampling -> String
(Int -> HeapProfilerStopSampling -> ShowS)
-> (HeapProfilerStopSampling -> String)
-> ([HeapProfilerStopSampling] -> ShowS)
-> Show HeapProfilerStopSampling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeapProfilerStopSampling] -> ShowS
$cshowList :: [HeapProfilerStopSampling] -> ShowS
show :: HeapProfilerStopSampling -> String
$cshow :: HeapProfilerStopSampling -> String
showsPrec :: Int -> HeapProfilerStopSampling -> ShowS
$cshowsPrec :: Int -> HeapProfilerStopSampling -> ShowS
Show)
instance FromJSON HeapProfilerStopSampling where
  parseJSON :: Value -> Parser HeapProfilerStopSampling
parseJSON = String
-> (Object -> Parser HeapProfilerStopSampling)
-> Value
-> Parser HeapProfilerStopSampling
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HeapProfilerStopSampling" ((Object -> Parser HeapProfilerStopSampling)
 -> Value -> Parser HeapProfilerStopSampling)
-> (Object -> Parser HeapProfilerStopSampling)
-> Value
-> Parser HeapProfilerStopSampling
forall a b. (a -> b) -> a -> b
$ \Object
o -> HeapProfilerSamplingHeapProfile -> HeapProfilerStopSampling
HeapProfilerStopSampling
    (HeapProfilerSamplingHeapProfile -> HeapProfilerStopSampling)
-> Parser HeapProfilerSamplingHeapProfile
-> Parser HeapProfilerStopSampling
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser HeapProfilerSamplingHeapProfile
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"profile"
instance Command PHeapProfilerStopSampling where
  type CommandResponse PHeapProfilerStopSampling = HeapProfilerStopSampling
  commandName :: Proxy PHeapProfilerStopSampling -> String
commandName Proxy PHeapProfilerStopSampling
_ = String
"HeapProfiler.stopSampling"


-- | Parameters of the 'HeapProfiler.stopTrackingHeapObjects' command.
data PHeapProfilerStopTrackingHeapObjects = PHeapProfilerStopTrackingHeapObjects
  {
    -- | If true 'reportHeapSnapshotProgress' events will be generated while snapshot is being taken
    --   when the tracking is stopped.
    PHeapProfilerStopTrackingHeapObjects -> Maybe Bool
pHeapProfilerStopTrackingHeapObjectsReportProgress :: Maybe Bool,
    -- | If true, numerical values are included in the snapshot
    PHeapProfilerStopTrackingHeapObjects -> Maybe Bool
pHeapProfilerStopTrackingHeapObjectsCaptureNumericValue :: Maybe Bool,
    -- | If true, exposes internals of the snapshot.
    PHeapProfilerStopTrackingHeapObjects -> Maybe Bool
pHeapProfilerStopTrackingHeapObjectsExposeInternals :: Maybe Bool
  }
  deriving (PHeapProfilerStopTrackingHeapObjects
-> PHeapProfilerStopTrackingHeapObjects -> Bool
(PHeapProfilerStopTrackingHeapObjects
 -> PHeapProfilerStopTrackingHeapObjects -> Bool)
-> (PHeapProfilerStopTrackingHeapObjects
    -> PHeapProfilerStopTrackingHeapObjects -> Bool)
-> Eq PHeapProfilerStopTrackingHeapObjects
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerStopTrackingHeapObjects
-> PHeapProfilerStopTrackingHeapObjects -> Bool
$c/= :: PHeapProfilerStopTrackingHeapObjects
-> PHeapProfilerStopTrackingHeapObjects -> Bool
== :: PHeapProfilerStopTrackingHeapObjects
-> PHeapProfilerStopTrackingHeapObjects -> Bool
$c== :: PHeapProfilerStopTrackingHeapObjects
-> PHeapProfilerStopTrackingHeapObjects -> Bool
Eq, Int -> PHeapProfilerStopTrackingHeapObjects -> ShowS
[PHeapProfilerStopTrackingHeapObjects] -> ShowS
PHeapProfilerStopTrackingHeapObjects -> String
(Int -> PHeapProfilerStopTrackingHeapObjects -> ShowS)
-> (PHeapProfilerStopTrackingHeapObjects -> String)
-> ([PHeapProfilerStopTrackingHeapObjects] -> ShowS)
-> Show PHeapProfilerStopTrackingHeapObjects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerStopTrackingHeapObjects] -> ShowS
$cshowList :: [PHeapProfilerStopTrackingHeapObjects] -> ShowS
show :: PHeapProfilerStopTrackingHeapObjects -> String
$cshow :: PHeapProfilerStopTrackingHeapObjects -> String
showsPrec :: Int -> PHeapProfilerStopTrackingHeapObjects -> ShowS
$cshowsPrec :: Int -> PHeapProfilerStopTrackingHeapObjects -> ShowS
Show)
pHeapProfilerStopTrackingHeapObjects
  :: PHeapProfilerStopTrackingHeapObjects
pHeapProfilerStopTrackingHeapObjects :: PHeapProfilerStopTrackingHeapObjects
pHeapProfilerStopTrackingHeapObjects
  = Maybe Bool
-> Maybe Bool -> Maybe Bool -> PHeapProfilerStopTrackingHeapObjects
PHeapProfilerStopTrackingHeapObjects
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PHeapProfilerStopTrackingHeapObjects where
  toJSON :: PHeapProfilerStopTrackingHeapObjects -> Value
toJSON PHeapProfilerStopTrackingHeapObjects
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
"reportProgress" 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
<$> (PHeapProfilerStopTrackingHeapObjects -> Maybe Bool
pHeapProfilerStopTrackingHeapObjectsReportProgress PHeapProfilerStopTrackingHeapObjects
p),
    (Text
"captureNumericValue" 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
<$> (PHeapProfilerStopTrackingHeapObjects -> Maybe Bool
pHeapProfilerStopTrackingHeapObjectsCaptureNumericValue PHeapProfilerStopTrackingHeapObjects
p),
    (Text
"exposeInternals" 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
<$> (PHeapProfilerStopTrackingHeapObjects -> Maybe Bool
pHeapProfilerStopTrackingHeapObjectsExposeInternals PHeapProfilerStopTrackingHeapObjects
p)
    ]
instance Command PHeapProfilerStopTrackingHeapObjects where
  type CommandResponse PHeapProfilerStopTrackingHeapObjects = ()
  commandName :: Proxy PHeapProfilerStopTrackingHeapObjects -> String
commandName Proxy PHeapProfilerStopTrackingHeapObjects
_ = String
"HeapProfiler.stopTrackingHeapObjects"
  fromJSON :: Proxy PHeapProfilerStopTrackingHeapObjects
-> Value
-> Result (CommandResponse PHeapProfilerStopTrackingHeapObjects)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PHeapProfilerStopTrackingHeapObjects -> Result ())
-> Proxy PHeapProfilerStopTrackingHeapObjects
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PHeapProfilerStopTrackingHeapObjects -> ())
-> Proxy PHeapProfilerStopTrackingHeapObjects
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PHeapProfilerStopTrackingHeapObjects -> ()
forall a b. a -> b -> a
const ()


-- | Parameters of the 'HeapProfiler.takeHeapSnapshot' command.
data PHeapProfilerTakeHeapSnapshot = PHeapProfilerTakeHeapSnapshot
  {
    -- | If true 'reportHeapSnapshotProgress' events will be generated while snapshot is being taken.
    PHeapProfilerTakeHeapSnapshot -> Maybe Bool
pHeapProfilerTakeHeapSnapshotReportProgress :: Maybe Bool,
    -- | If true, numerical values are included in the snapshot
    PHeapProfilerTakeHeapSnapshot -> Maybe Bool
pHeapProfilerTakeHeapSnapshotCaptureNumericValue :: Maybe Bool,
    -- | If true, exposes internals of the snapshot.
    PHeapProfilerTakeHeapSnapshot -> Maybe Bool
pHeapProfilerTakeHeapSnapshotExposeInternals :: Maybe Bool
  }
  deriving (PHeapProfilerTakeHeapSnapshot
-> PHeapProfilerTakeHeapSnapshot -> Bool
(PHeapProfilerTakeHeapSnapshot
 -> PHeapProfilerTakeHeapSnapshot -> Bool)
-> (PHeapProfilerTakeHeapSnapshot
    -> PHeapProfilerTakeHeapSnapshot -> Bool)
-> Eq PHeapProfilerTakeHeapSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PHeapProfilerTakeHeapSnapshot
-> PHeapProfilerTakeHeapSnapshot -> Bool
$c/= :: PHeapProfilerTakeHeapSnapshot
-> PHeapProfilerTakeHeapSnapshot -> Bool
== :: PHeapProfilerTakeHeapSnapshot
-> PHeapProfilerTakeHeapSnapshot -> Bool
$c== :: PHeapProfilerTakeHeapSnapshot
-> PHeapProfilerTakeHeapSnapshot -> Bool
Eq, Int -> PHeapProfilerTakeHeapSnapshot -> ShowS
[PHeapProfilerTakeHeapSnapshot] -> ShowS
PHeapProfilerTakeHeapSnapshot -> String
(Int -> PHeapProfilerTakeHeapSnapshot -> ShowS)
-> (PHeapProfilerTakeHeapSnapshot -> String)
-> ([PHeapProfilerTakeHeapSnapshot] -> ShowS)
-> Show PHeapProfilerTakeHeapSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PHeapProfilerTakeHeapSnapshot] -> ShowS
$cshowList :: [PHeapProfilerTakeHeapSnapshot] -> ShowS
show :: PHeapProfilerTakeHeapSnapshot -> String
$cshow :: PHeapProfilerTakeHeapSnapshot -> String
showsPrec :: Int -> PHeapProfilerTakeHeapSnapshot -> ShowS
$cshowsPrec :: Int -> PHeapProfilerTakeHeapSnapshot -> ShowS
Show)
pHeapProfilerTakeHeapSnapshot
  :: PHeapProfilerTakeHeapSnapshot
pHeapProfilerTakeHeapSnapshot :: PHeapProfilerTakeHeapSnapshot
pHeapProfilerTakeHeapSnapshot
  = Maybe Bool
-> Maybe Bool -> Maybe Bool -> PHeapProfilerTakeHeapSnapshot
PHeapProfilerTakeHeapSnapshot
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PHeapProfilerTakeHeapSnapshot where
  toJSON :: PHeapProfilerTakeHeapSnapshot -> Value
toJSON PHeapProfilerTakeHeapSnapshot
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
"reportProgress" 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
<$> (PHeapProfilerTakeHeapSnapshot -> Maybe Bool
pHeapProfilerTakeHeapSnapshotReportProgress PHeapProfilerTakeHeapSnapshot
p),
    (Text
"captureNumericValue" 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
<$> (PHeapProfilerTakeHeapSnapshot -> Maybe Bool
pHeapProfilerTakeHeapSnapshotCaptureNumericValue PHeapProfilerTakeHeapSnapshot
p),
    (Text
"exposeInternals" 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
<$> (PHeapProfilerTakeHeapSnapshot -> Maybe Bool
pHeapProfilerTakeHeapSnapshotExposeInternals PHeapProfilerTakeHeapSnapshot
p)
    ]
instance Command PHeapProfilerTakeHeapSnapshot where
  type CommandResponse PHeapProfilerTakeHeapSnapshot = ()
  commandName :: Proxy PHeapProfilerTakeHeapSnapshot -> String
commandName Proxy PHeapProfilerTakeHeapSnapshot
_ = String
"HeapProfiler.takeHeapSnapshot"
  fromJSON :: Proxy PHeapProfilerTakeHeapSnapshot
-> Value -> Result (CommandResponse PHeapProfilerTakeHeapSnapshot)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PHeapProfilerTakeHeapSnapshot -> Result ())
-> Proxy PHeapProfilerTakeHeapSnapshot
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PHeapProfilerTakeHeapSnapshot -> ())
-> Proxy PHeapProfilerTakeHeapSnapshot
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PHeapProfilerTakeHeapSnapshot -> ()
forall a b. a -> b -> a
const ()