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


{- |
= Memory

-}


module CDP.Domains.Memory (module CDP.Domains.Memory) 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 'Memory.PressureLevel'.
--   Memory pressure level.
data MemoryPressureLevel = MemoryPressureLevelModerate | MemoryPressureLevelCritical
  deriving (Eq MemoryPressureLevel
Eq MemoryPressureLevel
-> (MemoryPressureLevel -> MemoryPressureLevel -> Ordering)
-> (MemoryPressureLevel -> MemoryPressureLevel -> Bool)
-> (MemoryPressureLevel -> MemoryPressureLevel -> Bool)
-> (MemoryPressureLevel -> MemoryPressureLevel -> Bool)
-> (MemoryPressureLevel -> MemoryPressureLevel -> Bool)
-> (MemoryPressureLevel
    -> MemoryPressureLevel -> MemoryPressureLevel)
-> (MemoryPressureLevel
    -> MemoryPressureLevel -> MemoryPressureLevel)
-> Ord MemoryPressureLevel
MemoryPressureLevel -> MemoryPressureLevel -> Bool
MemoryPressureLevel -> MemoryPressureLevel -> Ordering
MemoryPressureLevel -> MemoryPressureLevel -> MemoryPressureLevel
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 :: MemoryPressureLevel -> MemoryPressureLevel -> MemoryPressureLevel
$cmin :: MemoryPressureLevel -> MemoryPressureLevel -> MemoryPressureLevel
max :: MemoryPressureLevel -> MemoryPressureLevel -> MemoryPressureLevel
$cmax :: MemoryPressureLevel -> MemoryPressureLevel -> MemoryPressureLevel
>= :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
$c>= :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
> :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
$c> :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
<= :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
$c<= :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
< :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
$c< :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
compare :: MemoryPressureLevel -> MemoryPressureLevel -> Ordering
$ccompare :: MemoryPressureLevel -> MemoryPressureLevel -> Ordering
$cp1Ord :: Eq MemoryPressureLevel
Ord, MemoryPressureLevel -> MemoryPressureLevel -> Bool
(MemoryPressureLevel -> MemoryPressureLevel -> Bool)
-> (MemoryPressureLevel -> MemoryPressureLevel -> Bool)
-> Eq MemoryPressureLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
$c/= :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
== :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
$c== :: MemoryPressureLevel -> MemoryPressureLevel -> Bool
Eq, Int -> MemoryPressureLevel -> ShowS
[MemoryPressureLevel] -> ShowS
MemoryPressureLevel -> String
(Int -> MemoryPressureLevel -> ShowS)
-> (MemoryPressureLevel -> String)
-> ([MemoryPressureLevel] -> ShowS)
-> Show MemoryPressureLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemoryPressureLevel] -> ShowS
$cshowList :: [MemoryPressureLevel] -> ShowS
show :: MemoryPressureLevel -> String
$cshow :: MemoryPressureLevel -> String
showsPrec :: Int -> MemoryPressureLevel -> ShowS
$cshowsPrec :: Int -> MemoryPressureLevel -> ShowS
Show, ReadPrec [MemoryPressureLevel]
ReadPrec MemoryPressureLevel
Int -> ReadS MemoryPressureLevel
ReadS [MemoryPressureLevel]
(Int -> ReadS MemoryPressureLevel)
-> ReadS [MemoryPressureLevel]
-> ReadPrec MemoryPressureLevel
-> ReadPrec [MemoryPressureLevel]
-> Read MemoryPressureLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MemoryPressureLevel]
$creadListPrec :: ReadPrec [MemoryPressureLevel]
readPrec :: ReadPrec MemoryPressureLevel
$creadPrec :: ReadPrec MemoryPressureLevel
readList :: ReadS [MemoryPressureLevel]
$creadList :: ReadS [MemoryPressureLevel]
readsPrec :: Int -> ReadS MemoryPressureLevel
$creadsPrec :: Int -> ReadS MemoryPressureLevel
Read)
instance FromJSON MemoryPressureLevel where
  parseJSON :: Value -> Parser MemoryPressureLevel
parseJSON = String
-> (Text -> Parser MemoryPressureLevel)
-> Value
-> Parser MemoryPressureLevel
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"MemoryPressureLevel" ((Text -> Parser MemoryPressureLevel)
 -> Value -> Parser MemoryPressureLevel)
-> (Text -> Parser MemoryPressureLevel)
-> Value
-> Parser MemoryPressureLevel
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"moderate" -> MemoryPressureLevel -> Parser MemoryPressureLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPressureLevel
MemoryPressureLevelModerate
    Text
"critical" -> MemoryPressureLevel -> Parser MemoryPressureLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemoryPressureLevel
MemoryPressureLevelCritical
    Text
"_" -> String -> Parser MemoryPressureLevel
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse MemoryPressureLevel"
instance ToJSON MemoryPressureLevel where
  toJSON :: MemoryPressureLevel -> Value
toJSON MemoryPressureLevel
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case MemoryPressureLevel
v of
    MemoryPressureLevel
MemoryPressureLevelModerate -> Text
"moderate"
    MemoryPressureLevel
MemoryPressureLevelCritical -> Text
"critical"

-- | Type 'Memory.SamplingProfileNode'.
--   Heap profile sample.
data MemorySamplingProfileNode = MemorySamplingProfileNode
  {
    -- | Size of the sampled allocation.
    MemorySamplingProfileNode -> Double
memorySamplingProfileNodeSize :: Double,
    -- | Total bytes attributed to this sample.
    MemorySamplingProfileNode -> Double
memorySamplingProfileNodeTotal :: Double,
    -- | Execution stack at the point of allocation.
    MemorySamplingProfileNode -> [Text]
memorySamplingProfileNodeStack :: [T.Text]
  }
  deriving (MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool
(MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool)
-> (MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool)
-> Eq MemorySamplingProfileNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool
$c/= :: MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool
== :: MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool
$c== :: MemorySamplingProfileNode -> MemorySamplingProfileNode -> Bool
Eq, Int -> MemorySamplingProfileNode -> ShowS
[MemorySamplingProfileNode] -> ShowS
MemorySamplingProfileNode -> String
(Int -> MemorySamplingProfileNode -> ShowS)
-> (MemorySamplingProfileNode -> String)
-> ([MemorySamplingProfileNode] -> ShowS)
-> Show MemorySamplingProfileNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemorySamplingProfileNode] -> ShowS
$cshowList :: [MemorySamplingProfileNode] -> ShowS
show :: MemorySamplingProfileNode -> String
$cshow :: MemorySamplingProfileNode -> String
showsPrec :: Int -> MemorySamplingProfileNode -> ShowS
$cshowsPrec :: Int -> MemorySamplingProfileNode -> ShowS
Show)
instance FromJSON MemorySamplingProfileNode where
  parseJSON :: Value -> Parser MemorySamplingProfileNode
parseJSON = String
-> (Object -> Parser MemorySamplingProfileNode)
-> Value
-> Parser MemorySamplingProfileNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MemorySamplingProfileNode" ((Object -> Parser MemorySamplingProfileNode)
 -> Value -> Parser MemorySamplingProfileNode)
-> (Object -> Parser MemorySamplingProfileNode)
-> Value
-> Parser MemorySamplingProfileNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> Double -> [Text] -> MemorySamplingProfileNode
MemorySamplingProfileNode
    (Double -> Double -> [Text] -> MemorySamplingProfileNode)
-> Parser Double
-> Parser (Double -> [Text] -> MemorySamplingProfileNode)
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 (Double -> [Text] -> MemorySamplingProfileNode)
-> Parser Double -> Parser ([Text] -> MemorySamplingProfileNode)
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
"total"
    Parser ([Text] -> MemorySamplingProfileNode)
-> Parser [Text] -> Parser MemorySamplingProfileNode
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
"stack"
instance ToJSON MemorySamplingProfileNode where
  toJSON :: MemorySamplingProfileNode -> Value
toJSON MemorySamplingProfileNode
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 (MemorySamplingProfileNode -> Double
memorySamplingProfileNodeSize MemorySamplingProfileNode
p),
    (Text
"total" 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 (MemorySamplingProfileNode -> Double
memorySamplingProfileNodeTotal MemorySamplingProfileNode
p),
    (Text
"stack" 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 (MemorySamplingProfileNode -> [Text]
memorySamplingProfileNodeStack MemorySamplingProfileNode
p)
    ]

-- | Type 'Memory.SamplingProfile'.
--   Array of heap profile samples.
data MemorySamplingProfile = MemorySamplingProfile
  {
    MemorySamplingProfile -> [MemorySamplingProfileNode]
memorySamplingProfileSamples :: [MemorySamplingProfileNode],
    MemorySamplingProfile -> [MemoryModule]
memorySamplingProfileModules :: [MemoryModule]
  }
  deriving (MemorySamplingProfile -> MemorySamplingProfile -> Bool
(MemorySamplingProfile -> MemorySamplingProfile -> Bool)
-> (MemorySamplingProfile -> MemorySamplingProfile -> Bool)
-> Eq MemorySamplingProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemorySamplingProfile -> MemorySamplingProfile -> Bool
$c/= :: MemorySamplingProfile -> MemorySamplingProfile -> Bool
== :: MemorySamplingProfile -> MemorySamplingProfile -> Bool
$c== :: MemorySamplingProfile -> MemorySamplingProfile -> Bool
Eq, Int -> MemorySamplingProfile -> ShowS
[MemorySamplingProfile] -> ShowS
MemorySamplingProfile -> String
(Int -> MemorySamplingProfile -> ShowS)
-> (MemorySamplingProfile -> String)
-> ([MemorySamplingProfile] -> ShowS)
-> Show MemorySamplingProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemorySamplingProfile] -> ShowS
$cshowList :: [MemorySamplingProfile] -> ShowS
show :: MemorySamplingProfile -> String
$cshow :: MemorySamplingProfile -> String
showsPrec :: Int -> MemorySamplingProfile -> ShowS
$cshowsPrec :: Int -> MemorySamplingProfile -> ShowS
Show)
instance FromJSON MemorySamplingProfile where
  parseJSON :: Value -> Parser MemorySamplingProfile
parseJSON = String
-> (Object -> Parser MemorySamplingProfile)
-> Value
-> Parser MemorySamplingProfile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MemorySamplingProfile" ((Object -> Parser MemorySamplingProfile)
 -> Value -> Parser MemorySamplingProfile)
-> (Object -> Parser MemorySamplingProfile)
-> Value
-> Parser MemorySamplingProfile
forall a b. (a -> b) -> a -> b
$ \Object
o -> [MemorySamplingProfileNode]
-> [MemoryModule] -> MemorySamplingProfile
MemorySamplingProfile
    ([MemorySamplingProfileNode]
 -> [MemoryModule] -> MemorySamplingProfile)
-> Parser [MemorySamplingProfileNode]
-> Parser ([MemoryModule] -> MemorySamplingProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [MemorySamplingProfileNode]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"samples"
    Parser ([MemoryModule] -> MemorySamplingProfile)
-> Parser [MemoryModule] -> Parser MemorySamplingProfile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [MemoryModule]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"modules"
instance ToJSON MemorySamplingProfile where
  toJSON :: MemorySamplingProfile -> Value
toJSON MemorySamplingProfile
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
"samples" Text -> [MemorySamplingProfileNode] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([MemorySamplingProfileNode] -> Pair)
-> Maybe [MemorySamplingProfileNode] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MemorySamplingProfileNode] -> Maybe [MemorySamplingProfileNode]
forall a. a -> Maybe a
Just (MemorySamplingProfile -> [MemorySamplingProfileNode]
memorySamplingProfileSamples MemorySamplingProfile
p),
    (Text
"modules" Text -> [MemoryModule] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([MemoryModule] -> Pair) -> Maybe [MemoryModule] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MemoryModule] -> Maybe [MemoryModule]
forall a. a -> Maybe a
Just (MemorySamplingProfile -> [MemoryModule]
memorySamplingProfileModules MemorySamplingProfile
p)
    ]

-- | Type 'Memory.Module'.
--   Executable module information
data MemoryModule = MemoryModule
  {
    -- | Name of the module.
    MemoryModule -> Text
memoryModuleName :: T.Text,
    -- | UUID of the module.
    MemoryModule -> Text
memoryModuleUuid :: T.Text,
    -- | Base address where the module is loaded into memory. Encoded as a decimal
    --   or hexadecimal (0x prefixed) string.
    MemoryModule -> Text
memoryModuleBaseAddress :: T.Text,
    -- | Size of the module in bytes.
    MemoryModule -> Double
memoryModuleSize :: Double
  }
  deriving (MemoryModule -> MemoryModule -> Bool
(MemoryModule -> MemoryModule -> Bool)
-> (MemoryModule -> MemoryModule -> Bool) -> Eq MemoryModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryModule -> MemoryModule -> Bool
$c/= :: MemoryModule -> MemoryModule -> Bool
== :: MemoryModule -> MemoryModule -> Bool
$c== :: MemoryModule -> MemoryModule -> Bool
Eq, Int -> MemoryModule -> ShowS
[MemoryModule] -> ShowS
MemoryModule -> String
(Int -> MemoryModule -> ShowS)
-> (MemoryModule -> String)
-> ([MemoryModule] -> ShowS)
-> Show MemoryModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemoryModule] -> ShowS
$cshowList :: [MemoryModule] -> ShowS
show :: MemoryModule -> String
$cshow :: MemoryModule -> String
showsPrec :: Int -> MemoryModule -> ShowS
$cshowsPrec :: Int -> MemoryModule -> ShowS
Show)
instance FromJSON MemoryModule where
  parseJSON :: Value -> Parser MemoryModule
parseJSON = String
-> (Object -> Parser MemoryModule) -> Value -> Parser MemoryModule
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MemoryModule" ((Object -> Parser MemoryModule) -> Value -> Parser MemoryModule)
-> (Object -> Parser MemoryModule) -> Value -> Parser MemoryModule
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Text -> Double -> MemoryModule
MemoryModule
    (Text -> Text -> Text -> Double -> MemoryModule)
-> Parser Text -> Parser (Text -> Text -> Double -> MemoryModule)
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 -> Text -> Double -> MemoryModule)
-> Parser Text -> Parser (Text -> Double -> MemoryModule)
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
"uuid"
    Parser (Text -> Double -> MemoryModule)
-> Parser Text -> Parser (Double -> MemoryModule)
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
"baseAddress"
    Parser (Double -> MemoryModule)
-> Parser Double -> Parser MemoryModule
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
"size"
instance ToJSON MemoryModule where
  toJSON :: MemoryModule -> Value
toJSON MemoryModule
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 (MemoryModule -> Text
memoryModuleName MemoryModule
p),
    (Text
"uuid" 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 (MemoryModule -> Text
memoryModuleUuid MemoryModule
p),
    (Text
"baseAddress" 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 (MemoryModule -> Text
memoryModuleBaseAddress MemoryModule
p),
    (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 (MemoryModule -> Double
memoryModuleSize MemoryModule
p)
    ]


-- | Parameters of the 'Memory.getDOMCounters' command.
data PMemoryGetDOMCounters = PMemoryGetDOMCounters
  deriving (PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool
(PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool)
-> (PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool)
-> Eq PMemoryGetDOMCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool
$c/= :: PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool
== :: PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool
$c== :: PMemoryGetDOMCounters -> PMemoryGetDOMCounters -> Bool
Eq, Int -> PMemoryGetDOMCounters -> ShowS
[PMemoryGetDOMCounters] -> ShowS
PMemoryGetDOMCounters -> String
(Int -> PMemoryGetDOMCounters -> ShowS)
-> (PMemoryGetDOMCounters -> String)
-> ([PMemoryGetDOMCounters] -> ShowS)
-> Show PMemoryGetDOMCounters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PMemoryGetDOMCounters] -> ShowS
$cshowList :: [PMemoryGetDOMCounters] -> ShowS
show :: PMemoryGetDOMCounters -> String
$cshow :: PMemoryGetDOMCounters -> String
showsPrec :: Int -> PMemoryGetDOMCounters -> ShowS
$cshowsPrec :: Int -> PMemoryGetDOMCounters -> ShowS
Show)
pMemoryGetDOMCounters
  :: PMemoryGetDOMCounters
pMemoryGetDOMCounters :: PMemoryGetDOMCounters
pMemoryGetDOMCounters
  = PMemoryGetDOMCounters
PMemoryGetDOMCounters
instance ToJSON PMemoryGetDOMCounters where
  toJSON :: PMemoryGetDOMCounters -> Value
toJSON PMemoryGetDOMCounters
_ = Value
A.Null
data MemoryGetDOMCounters = MemoryGetDOMCounters
  {
    MemoryGetDOMCounters -> Int
memoryGetDOMCountersDocuments :: Int,
    MemoryGetDOMCounters -> Int
memoryGetDOMCountersNodes :: Int,
    MemoryGetDOMCounters -> Int
memoryGetDOMCountersJsEventListeners :: Int
  }
  deriving (MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool
(MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool)
-> (MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool)
-> Eq MemoryGetDOMCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool
$c/= :: MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool
== :: MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool
$c== :: MemoryGetDOMCounters -> MemoryGetDOMCounters -> Bool
Eq, Int -> MemoryGetDOMCounters -> ShowS
[MemoryGetDOMCounters] -> ShowS
MemoryGetDOMCounters -> String
(Int -> MemoryGetDOMCounters -> ShowS)
-> (MemoryGetDOMCounters -> String)
-> ([MemoryGetDOMCounters] -> ShowS)
-> Show MemoryGetDOMCounters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemoryGetDOMCounters] -> ShowS
$cshowList :: [MemoryGetDOMCounters] -> ShowS
show :: MemoryGetDOMCounters -> String
$cshow :: MemoryGetDOMCounters -> String
showsPrec :: Int -> MemoryGetDOMCounters -> ShowS
$cshowsPrec :: Int -> MemoryGetDOMCounters -> ShowS
Show)
instance FromJSON MemoryGetDOMCounters where
  parseJSON :: Value -> Parser MemoryGetDOMCounters
parseJSON = String
-> (Object -> Parser MemoryGetDOMCounters)
-> Value
-> Parser MemoryGetDOMCounters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"MemoryGetDOMCounters" ((Object -> Parser MemoryGetDOMCounters)
 -> Value -> Parser MemoryGetDOMCounters)
-> (Object -> Parser MemoryGetDOMCounters)
-> Value
-> Parser MemoryGetDOMCounters
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> Int -> MemoryGetDOMCounters
MemoryGetDOMCounters
    (Int -> Int -> Int -> MemoryGetDOMCounters)
-> Parser Int -> Parser (Int -> Int -> MemoryGetDOMCounters)
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
"documents"
    Parser (Int -> Int -> MemoryGetDOMCounters)
-> Parser Int -> Parser (Int -> MemoryGetDOMCounters)
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
"nodes"
    Parser (Int -> MemoryGetDOMCounters)
-> Parser Int -> Parser MemoryGetDOMCounters
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
"jsEventListeners"
instance Command PMemoryGetDOMCounters where
  type CommandResponse PMemoryGetDOMCounters = MemoryGetDOMCounters
  commandName :: Proxy PMemoryGetDOMCounters -> String
commandName Proxy PMemoryGetDOMCounters
_ = String
"Memory.getDOMCounters"


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

-- | Simulate OomIntervention by purging V8 memory.

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

-- | Enable/disable suppressing memory pressure notifications in all processes.

-- | Parameters of the 'Memory.setPressureNotificationsSuppressed' command.
data PMemorySetPressureNotificationsSuppressed = PMemorySetPressureNotificationsSuppressed
  {
    -- | If true, memory pressure notifications will be suppressed.
    PMemorySetPressureNotificationsSuppressed -> Bool
pMemorySetPressureNotificationsSuppressedSuppressed :: Bool
  }
  deriving (PMemorySetPressureNotificationsSuppressed
-> PMemorySetPressureNotificationsSuppressed -> Bool
(PMemorySetPressureNotificationsSuppressed
 -> PMemorySetPressureNotificationsSuppressed -> Bool)
-> (PMemorySetPressureNotificationsSuppressed
    -> PMemorySetPressureNotificationsSuppressed -> Bool)
-> Eq PMemorySetPressureNotificationsSuppressed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PMemorySetPressureNotificationsSuppressed
-> PMemorySetPressureNotificationsSuppressed -> Bool
$c/= :: PMemorySetPressureNotificationsSuppressed
-> PMemorySetPressureNotificationsSuppressed -> Bool
== :: PMemorySetPressureNotificationsSuppressed
-> PMemorySetPressureNotificationsSuppressed -> Bool
$c== :: PMemorySetPressureNotificationsSuppressed
-> PMemorySetPressureNotificationsSuppressed -> Bool
Eq, Int -> PMemorySetPressureNotificationsSuppressed -> ShowS
[PMemorySetPressureNotificationsSuppressed] -> ShowS
PMemorySetPressureNotificationsSuppressed -> String
(Int -> PMemorySetPressureNotificationsSuppressed -> ShowS)
-> (PMemorySetPressureNotificationsSuppressed -> String)
-> ([PMemorySetPressureNotificationsSuppressed] -> ShowS)
-> Show PMemorySetPressureNotificationsSuppressed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PMemorySetPressureNotificationsSuppressed] -> ShowS
$cshowList :: [PMemorySetPressureNotificationsSuppressed] -> ShowS
show :: PMemorySetPressureNotificationsSuppressed -> String
$cshow :: PMemorySetPressureNotificationsSuppressed -> String
showsPrec :: Int -> PMemorySetPressureNotificationsSuppressed -> ShowS
$cshowsPrec :: Int -> PMemorySetPressureNotificationsSuppressed -> ShowS
Show)
pMemorySetPressureNotificationsSuppressed
  {-
  -- | If true, memory pressure notifications will be suppressed.
  -}
  :: Bool
  -> PMemorySetPressureNotificationsSuppressed
pMemorySetPressureNotificationsSuppressed :: Bool -> PMemorySetPressureNotificationsSuppressed
pMemorySetPressureNotificationsSuppressed
  Bool
arg_pMemorySetPressureNotificationsSuppressedSuppressed
  = Bool -> PMemorySetPressureNotificationsSuppressed
PMemorySetPressureNotificationsSuppressed
    Bool
arg_pMemorySetPressureNotificationsSuppressedSuppressed
instance ToJSON PMemorySetPressureNotificationsSuppressed where
  toJSON :: PMemorySetPressureNotificationsSuppressed -> Value
toJSON PMemorySetPressureNotificationsSuppressed
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
"suppressed" 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 (PMemorySetPressureNotificationsSuppressed -> Bool
pMemorySetPressureNotificationsSuppressedSuppressed PMemorySetPressureNotificationsSuppressed
p)
    ]
instance Command PMemorySetPressureNotificationsSuppressed where
  type CommandResponse PMemorySetPressureNotificationsSuppressed = ()
  commandName :: Proxy PMemorySetPressureNotificationsSuppressed -> String
commandName Proxy PMemorySetPressureNotificationsSuppressed
_ = String
"Memory.setPressureNotificationsSuppressed"
  fromJSON :: Proxy PMemorySetPressureNotificationsSuppressed
-> Value
-> Result
     (CommandResponse PMemorySetPressureNotificationsSuppressed)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PMemorySetPressureNotificationsSuppressed -> Result ())
-> Proxy PMemorySetPressureNotificationsSuppressed
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PMemorySetPressureNotificationsSuppressed -> ())
-> Proxy PMemorySetPressureNotificationsSuppressed
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PMemorySetPressureNotificationsSuppressed -> ()
forall a b. a -> b -> a
const ()

-- | Simulate a memory pressure notification in all processes.

-- | Parameters of the 'Memory.simulatePressureNotification' command.
data PMemorySimulatePressureNotification = PMemorySimulatePressureNotification
  {
    -- | Memory pressure level of the notification.
    PMemorySimulatePressureNotification -> MemoryPressureLevel
pMemorySimulatePressureNotificationLevel :: MemoryPressureLevel
  }
  deriving (PMemorySimulatePressureNotification
-> PMemorySimulatePressureNotification -> Bool
(PMemorySimulatePressureNotification
 -> PMemorySimulatePressureNotification -> Bool)
-> (PMemorySimulatePressureNotification
    -> PMemorySimulatePressureNotification -> Bool)
-> Eq PMemorySimulatePressureNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PMemorySimulatePressureNotification
-> PMemorySimulatePressureNotification -> Bool
$c/= :: PMemorySimulatePressureNotification
-> PMemorySimulatePressureNotification -> Bool
== :: PMemorySimulatePressureNotification
-> PMemorySimulatePressureNotification -> Bool
$c== :: PMemorySimulatePressureNotification
-> PMemorySimulatePressureNotification -> Bool
Eq, Int -> PMemorySimulatePressureNotification -> ShowS
[PMemorySimulatePressureNotification] -> ShowS
PMemorySimulatePressureNotification -> String
(Int -> PMemorySimulatePressureNotification -> ShowS)
-> (PMemorySimulatePressureNotification -> String)
-> ([PMemorySimulatePressureNotification] -> ShowS)
-> Show PMemorySimulatePressureNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PMemorySimulatePressureNotification] -> ShowS
$cshowList :: [PMemorySimulatePressureNotification] -> ShowS
show :: PMemorySimulatePressureNotification -> String
$cshow :: PMemorySimulatePressureNotification -> String
showsPrec :: Int -> PMemorySimulatePressureNotification -> ShowS
$cshowsPrec :: Int -> PMemorySimulatePressureNotification -> ShowS
Show)
pMemorySimulatePressureNotification
  {-
  -- | Memory pressure level of the notification.
  -}
  :: MemoryPressureLevel
  -> PMemorySimulatePressureNotification
pMemorySimulatePressureNotification :: MemoryPressureLevel -> PMemorySimulatePressureNotification
pMemorySimulatePressureNotification
  MemoryPressureLevel
arg_pMemorySimulatePressureNotificationLevel
  = MemoryPressureLevel -> PMemorySimulatePressureNotification
PMemorySimulatePressureNotification
    MemoryPressureLevel
arg_pMemorySimulatePressureNotificationLevel
instance ToJSON PMemorySimulatePressureNotification where
  toJSON :: PMemorySimulatePressureNotification -> Value
toJSON PMemorySimulatePressureNotification
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
"level" Text -> MemoryPressureLevel -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (MemoryPressureLevel -> Pair)
-> Maybe MemoryPressureLevel -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoryPressureLevel -> Maybe MemoryPressureLevel
forall a. a -> Maybe a
Just (PMemorySimulatePressureNotification -> MemoryPressureLevel
pMemorySimulatePressureNotificationLevel PMemorySimulatePressureNotification
p)
    ]
instance Command PMemorySimulatePressureNotification where
  type CommandResponse PMemorySimulatePressureNotification = ()
  commandName :: Proxy PMemorySimulatePressureNotification -> String
commandName Proxy PMemorySimulatePressureNotification
_ = String
"Memory.simulatePressureNotification"
  fromJSON :: Proxy PMemorySimulatePressureNotification
-> Value
-> Result (CommandResponse PMemorySimulatePressureNotification)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PMemorySimulatePressureNotification -> Result ())
-> Proxy PMemorySimulatePressureNotification
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PMemorySimulatePressureNotification -> ())
-> Proxy PMemorySimulatePressureNotification
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PMemorySimulatePressureNotification -> ()
forall a b. a -> b -> a
const ()

-- | Start collecting native memory profile.

-- | Parameters of the 'Memory.startSampling' command.
data PMemoryStartSampling = PMemoryStartSampling
  {
    -- | Average number of bytes between samples.
    PMemoryStartSampling -> Maybe Int
pMemoryStartSamplingSamplingInterval :: Maybe Int,
    -- | Do not randomize intervals between samples.
    PMemoryStartSampling -> Maybe Bool
pMemoryStartSamplingSuppressRandomness :: Maybe Bool
  }
  deriving (PMemoryStartSampling -> PMemoryStartSampling -> Bool
(PMemoryStartSampling -> PMemoryStartSampling -> Bool)
-> (PMemoryStartSampling -> PMemoryStartSampling -> Bool)
-> Eq PMemoryStartSampling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PMemoryStartSampling -> PMemoryStartSampling -> Bool
$c/= :: PMemoryStartSampling -> PMemoryStartSampling -> Bool
== :: PMemoryStartSampling -> PMemoryStartSampling -> Bool
$c== :: PMemoryStartSampling -> PMemoryStartSampling -> Bool
Eq, Int -> PMemoryStartSampling -> ShowS
[PMemoryStartSampling] -> ShowS
PMemoryStartSampling -> String
(Int -> PMemoryStartSampling -> ShowS)
-> (PMemoryStartSampling -> String)
-> ([PMemoryStartSampling] -> ShowS)
-> Show PMemoryStartSampling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PMemoryStartSampling] -> ShowS
$cshowList :: [PMemoryStartSampling] -> ShowS
show :: PMemoryStartSampling -> String
$cshow :: PMemoryStartSampling -> String
showsPrec :: Int -> PMemoryStartSampling -> ShowS
$cshowsPrec :: Int -> PMemoryStartSampling -> ShowS
Show)
pMemoryStartSampling
  :: PMemoryStartSampling
pMemoryStartSampling :: PMemoryStartSampling
pMemoryStartSampling
  = Maybe Int -> Maybe Bool -> PMemoryStartSampling
PMemoryStartSampling
    Maybe Int
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PMemoryStartSampling where
  toJSON :: PMemoryStartSampling -> Value
toJSON PMemoryStartSampling
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 -> 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
<$> (PMemoryStartSampling -> Maybe Int
pMemoryStartSamplingSamplingInterval PMemoryStartSampling
p),
    (Text
"suppressRandomness" 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
<$> (PMemoryStartSampling -> Maybe Bool
pMemoryStartSamplingSuppressRandomness PMemoryStartSampling
p)
    ]
instance Command PMemoryStartSampling where
  type CommandResponse PMemoryStartSampling = ()
  commandName :: Proxy PMemoryStartSampling -> String
commandName Proxy PMemoryStartSampling
_ = String
"Memory.startSampling"
  fromJSON :: Proxy PMemoryStartSampling
-> Value -> Result (CommandResponse PMemoryStartSampling)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PMemoryStartSampling -> Result ())
-> Proxy PMemoryStartSampling
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PMemoryStartSampling -> ())
-> Proxy PMemoryStartSampling
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PMemoryStartSampling -> ()
forall a b. a -> b -> a
const ()

-- | Stop collecting native memory profile.

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

-- | Retrieve native memory allocations profile
--   collected since renderer process startup.

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

-- | Retrieve native memory allocations profile
--   collected since browser process startup.

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

-- | Retrieve native memory allocations profile collected since last
--   `startSampling` call.

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