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


{- |
= Profiler

-}


module CDP.Domains.Profiler (module CDP.Domains.Profiler) 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.Debugger as Debugger
import CDP.Domains.Runtime as Runtime


-- | Type 'Profiler.ProfileNode'.
--   Profile node. Holds callsite information, execution statistics and child nodes.
data ProfilerProfileNode = ProfilerProfileNode
  {
    -- | Unique id of the node.
    ProfilerProfileNode -> Int
profilerProfileNodeId :: Int,
    -- | Function location.
    ProfilerProfileNode -> RuntimeCallFrame
profilerProfileNodeCallFrame :: Runtime.RuntimeCallFrame,
    -- | Number of samples where this node was on top of the call stack.
    ProfilerProfileNode -> Maybe Int
profilerProfileNodeHitCount :: Maybe Int,
    -- | Child node ids.
    ProfilerProfileNode -> Maybe [Int]
profilerProfileNodeChildren :: Maybe [Int],
    -- | The reason of being not optimized. The function may be deoptimized or marked as don't
    --   optimize.
    ProfilerProfileNode -> Maybe Text
profilerProfileNodeDeoptReason :: Maybe T.Text,
    -- | An array of source position ticks.
    ProfilerProfileNode -> Maybe [ProfilerPositionTickInfo]
profilerProfileNodePositionTicks :: Maybe [ProfilerPositionTickInfo]
  }
  deriving (ProfilerProfileNode -> ProfilerProfileNode -> Bool
(ProfilerProfileNode -> ProfilerProfileNode -> Bool)
-> (ProfilerProfileNode -> ProfilerProfileNode -> Bool)
-> Eq ProfilerProfileNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerProfileNode -> ProfilerProfileNode -> Bool
$c/= :: ProfilerProfileNode -> ProfilerProfileNode -> Bool
== :: ProfilerProfileNode -> ProfilerProfileNode -> Bool
$c== :: ProfilerProfileNode -> ProfilerProfileNode -> Bool
Eq, Int -> ProfilerProfileNode -> ShowS
[ProfilerProfileNode] -> ShowS
ProfilerProfileNode -> String
(Int -> ProfilerProfileNode -> ShowS)
-> (ProfilerProfileNode -> String)
-> ([ProfilerProfileNode] -> ShowS)
-> Show ProfilerProfileNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerProfileNode] -> ShowS
$cshowList :: [ProfilerProfileNode] -> ShowS
show :: ProfilerProfileNode -> String
$cshow :: ProfilerProfileNode -> String
showsPrec :: Int -> ProfilerProfileNode -> ShowS
$cshowsPrec :: Int -> ProfilerProfileNode -> ShowS
Show)
instance FromJSON ProfilerProfileNode where
  parseJSON :: Value -> Parser ProfilerProfileNode
parseJSON = String
-> (Object -> Parser ProfilerProfileNode)
-> Value
-> Parser ProfilerProfileNode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerProfileNode" ((Object -> Parser ProfilerProfileNode)
 -> Value -> Parser ProfilerProfileNode)
-> (Object -> Parser ProfilerProfileNode)
-> Value
-> Parser ProfilerProfileNode
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> RuntimeCallFrame
-> Maybe Int
-> Maybe [Int]
-> Maybe Text
-> Maybe [ProfilerPositionTickInfo]
-> ProfilerProfileNode
ProfilerProfileNode
    (Int
 -> RuntimeCallFrame
 -> Maybe Int
 -> Maybe [Int]
 -> Maybe Text
 -> Maybe [ProfilerPositionTickInfo]
 -> ProfilerProfileNode)
-> Parser Int
-> Parser
     (RuntimeCallFrame
      -> Maybe Int
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe [ProfilerPositionTickInfo]
      -> ProfilerProfileNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Parser
  (RuntimeCallFrame
   -> Maybe Int
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe [ProfilerPositionTickInfo]
   -> ProfilerProfileNode)
-> Parser RuntimeCallFrame
-> Parser
     (Maybe Int
      -> Maybe [Int]
      -> Maybe Text
      -> Maybe [ProfilerPositionTickInfo]
      -> ProfilerProfileNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RuntimeCallFrame
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"callFrame"
    Parser
  (Maybe Int
   -> Maybe [Int]
   -> Maybe Text
   -> Maybe [ProfilerPositionTickInfo]
   -> ProfilerProfileNode)
-> Parser (Maybe Int)
-> Parser
     (Maybe [Int]
      -> Maybe Text
      -> Maybe [ProfilerPositionTickInfo]
      -> ProfilerProfileNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"hitCount"
    Parser
  (Maybe [Int]
   -> Maybe Text
   -> Maybe [ProfilerPositionTickInfo]
   -> ProfilerProfileNode)
-> Parser (Maybe [Int])
-> Parser
     (Maybe Text
      -> Maybe [ProfilerPositionTickInfo] -> ProfilerProfileNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"children"
    Parser
  (Maybe Text
   -> Maybe [ProfilerPositionTickInfo] -> ProfilerProfileNode)
-> Parser (Maybe Text)
-> Parser (Maybe [ProfilerPositionTickInfo] -> ProfilerProfileNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"deoptReason"
    Parser (Maybe [ProfilerPositionTickInfo] -> ProfilerProfileNode)
-> Parser (Maybe [ProfilerPositionTickInfo])
-> Parser ProfilerProfileNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [ProfilerPositionTickInfo])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"positionTicks"
instance ToJSON ProfilerProfileNode where
  toJSON :: ProfilerProfileNode -> Value
toJSON ProfilerProfileNode
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"id" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Int -> Pair) -> Maybe Int -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
forall a. a -> Maybe a
Just (ProfilerProfileNode -> Int
profilerProfileNodeId ProfilerProfileNode
p),
    (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 (ProfilerProfileNode -> RuntimeCallFrame
profilerProfileNodeCallFrame ProfilerProfileNode
p),
    (Text
"hitCount" 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
<$> (ProfilerProfileNode -> Maybe Int
profilerProfileNodeHitCount ProfilerProfileNode
p),
    (Text
"children" 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
<$> (ProfilerProfileNode -> Maybe [Int]
profilerProfileNodeChildren ProfilerProfileNode
p),
    (Text
"deoptReason" 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
<$> (ProfilerProfileNode -> Maybe Text
profilerProfileNodeDeoptReason ProfilerProfileNode
p),
    (Text
"positionTicks" Text -> [ProfilerPositionTickInfo] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([ProfilerPositionTickInfo] -> Pair)
-> Maybe [ProfilerPositionTickInfo] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProfilerProfileNode -> Maybe [ProfilerPositionTickInfo]
profilerProfileNodePositionTicks ProfilerProfileNode
p)
    ]

-- | Type 'Profiler.Profile'.
--   Profile.
data ProfilerProfile = ProfilerProfile
  {
    -- | The list of profile nodes. First item is the root node.
    ProfilerProfile -> [ProfilerProfileNode]
profilerProfileNodes :: [ProfilerProfileNode],
    -- | Profiling start timestamp in microseconds.
    ProfilerProfile -> Double
profilerProfileStartTime :: Double,
    -- | Profiling end timestamp in microseconds.
    ProfilerProfile -> Double
profilerProfileEndTime :: Double,
    -- | Ids of samples top nodes.
    ProfilerProfile -> Maybe [Int]
profilerProfileSamples :: Maybe [Int],
    -- | Time intervals between adjacent samples in microseconds. The first delta is relative to the
    --   profile startTime.
    ProfilerProfile -> Maybe [Int]
profilerProfileTimeDeltas :: Maybe [Int]
  }
  deriving (ProfilerProfile -> ProfilerProfile -> Bool
(ProfilerProfile -> ProfilerProfile -> Bool)
-> (ProfilerProfile -> ProfilerProfile -> Bool)
-> Eq ProfilerProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerProfile -> ProfilerProfile -> Bool
$c/= :: ProfilerProfile -> ProfilerProfile -> Bool
== :: ProfilerProfile -> ProfilerProfile -> Bool
$c== :: ProfilerProfile -> ProfilerProfile -> Bool
Eq, Int -> ProfilerProfile -> ShowS
[ProfilerProfile] -> ShowS
ProfilerProfile -> String
(Int -> ProfilerProfile -> ShowS)
-> (ProfilerProfile -> String)
-> ([ProfilerProfile] -> ShowS)
-> Show ProfilerProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerProfile] -> ShowS
$cshowList :: [ProfilerProfile] -> ShowS
show :: ProfilerProfile -> String
$cshow :: ProfilerProfile -> String
showsPrec :: Int -> ProfilerProfile -> ShowS
$cshowsPrec :: Int -> ProfilerProfile -> ShowS
Show)
instance FromJSON ProfilerProfile where
  parseJSON :: Value -> Parser ProfilerProfile
parseJSON = String
-> (Object -> Parser ProfilerProfile)
-> Value
-> Parser ProfilerProfile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerProfile" ((Object -> Parser ProfilerProfile)
 -> Value -> Parser ProfilerProfile)
-> (Object -> Parser ProfilerProfile)
-> Value
-> Parser ProfilerProfile
forall a b. (a -> b) -> a -> b
$ \Object
o -> [ProfilerProfileNode]
-> Double
-> Double
-> Maybe [Int]
-> Maybe [Int]
-> ProfilerProfile
ProfilerProfile
    ([ProfilerProfileNode]
 -> Double
 -> Double
 -> Maybe [Int]
 -> Maybe [Int]
 -> ProfilerProfile)
-> Parser [ProfilerProfileNode]
-> Parser
     (Double -> Double -> Maybe [Int] -> Maybe [Int] -> ProfilerProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [ProfilerProfileNode]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"nodes"
    Parser
  (Double -> Double -> Maybe [Int] -> Maybe [Int] -> ProfilerProfile)
-> Parser Double
-> Parser (Double -> Maybe [Int] -> Maybe [Int] -> ProfilerProfile)
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
"startTime"
    Parser (Double -> Maybe [Int] -> Maybe [Int] -> ProfilerProfile)
-> Parser Double
-> Parser (Maybe [Int] -> Maybe [Int] -> ProfilerProfile)
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
"endTime"
    Parser (Maybe [Int] -> Maybe [Int] -> ProfilerProfile)
-> Parser (Maybe [Int]) -> Parser (Maybe [Int] -> ProfilerProfile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"samples"
    Parser (Maybe [Int] -> ProfilerProfile)
-> Parser (Maybe [Int]) -> Parser ProfilerProfile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"timeDeltas"
instance ToJSON ProfilerProfile where
  toJSON :: ProfilerProfile -> Value
toJSON ProfilerProfile
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
"nodes" Text -> [ProfilerProfileNode] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([ProfilerProfileNode] -> Pair)
-> Maybe [ProfilerProfileNode] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProfilerProfileNode] -> Maybe [ProfilerProfileNode]
forall a. a -> Maybe a
Just (ProfilerProfile -> [ProfilerProfileNode]
profilerProfileNodes ProfilerProfile
p),
    (Text
"startTime" 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 (ProfilerProfile -> Double
profilerProfileStartTime ProfilerProfile
p),
    (Text
"endTime" 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 (ProfilerProfile -> Double
profilerProfileEndTime ProfilerProfile
p),
    (Text
"samples" 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
<$> (ProfilerProfile -> Maybe [Int]
profilerProfileSamples ProfilerProfile
p),
    (Text
"timeDeltas" 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
<$> (ProfilerProfile -> Maybe [Int]
profilerProfileTimeDeltas ProfilerProfile
p)
    ]

-- | Type 'Profiler.PositionTickInfo'.
--   Specifies a number of samples attributed to a certain source position.
data ProfilerPositionTickInfo = ProfilerPositionTickInfo
  {
    -- | Source line number (1-based).
    ProfilerPositionTickInfo -> Int
profilerPositionTickInfoLine :: Int,
    -- | Number of samples attributed to the source line.
    ProfilerPositionTickInfo -> Int
profilerPositionTickInfoTicks :: Int
  }
  deriving (ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool
(ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool)
-> (ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool)
-> Eq ProfilerPositionTickInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool
$c/= :: ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool
== :: ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool
$c== :: ProfilerPositionTickInfo -> ProfilerPositionTickInfo -> Bool
Eq, Int -> ProfilerPositionTickInfo -> ShowS
[ProfilerPositionTickInfo] -> ShowS
ProfilerPositionTickInfo -> String
(Int -> ProfilerPositionTickInfo -> ShowS)
-> (ProfilerPositionTickInfo -> String)
-> ([ProfilerPositionTickInfo] -> ShowS)
-> Show ProfilerPositionTickInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerPositionTickInfo] -> ShowS
$cshowList :: [ProfilerPositionTickInfo] -> ShowS
show :: ProfilerPositionTickInfo -> String
$cshow :: ProfilerPositionTickInfo -> String
showsPrec :: Int -> ProfilerPositionTickInfo -> ShowS
$cshowsPrec :: Int -> ProfilerPositionTickInfo -> ShowS
Show)
instance FromJSON ProfilerPositionTickInfo where
  parseJSON :: Value -> Parser ProfilerPositionTickInfo
parseJSON = String
-> (Object -> Parser ProfilerPositionTickInfo)
-> Value
-> Parser ProfilerPositionTickInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerPositionTickInfo" ((Object -> Parser ProfilerPositionTickInfo)
 -> Value -> Parser ProfilerPositionTickInfo)
-> (Object -> Parser ProfilerPositionTickInfo)
-> Value
-> Parser ProfilerPositionTickInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> ProfilerPositionTickInfo
ProfilerPositionTickInfo
    (Int -> Int -> ProfilerPositionTickInfo)
-> Parser Int -> Parser (Int -> ProfilerPositionTickInfo)
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
"line"
    Parser (Int -> ProfilerPositionTickInfo)
-> Parser Int -> Parser ProfilerPositionTickInfo
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
"ticks"
instance ToJSON ProfilerPositionTickInfo where
  toJSON :: ProfilerPositionTickInfo -> Value
toJSON ProfilerPositionTickInfo
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
"line" 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 (ProfilerPositionTickInfo -> Int
profilerPositionTickInfoLine ProfilerPositionTickInfo
p),
    (Text
"ticks" 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 (ProfilerPositionTickInfo -> Int
profilerPositionTickInfoTicks ProfilerPositionTickInfo
p)
    ]

-- | Type 'Profiler.CoverageRange'.
--   Coverage data for a source range.
data ProfilerCoverageRange = ProfilerCoverageRange
  {
    -- | JavaScript script source offset for the range start.
    ProfilerCoverageRange -> Int
profilerCoverageRangeStartOffset :: Int,
    -- | JavaScript script source offset for the range end.
    ProfilerCoverageRange -> Int
profilerCoverageRangeEndOffset :: Int,
    -- | Collected execution count of the source range.
    ProfilerCoverageRange -> Int
profilerCoverageRangeCount :: Int
  }
  deriving (ProfilerCoverageRange -> ProfilerCoverageRange -> Bool
(ProfilerCoverageRange -> ProfilerCoverageRange -> Bool)
-> (ProfilerCoverageRange -> ProfilerCoverageRange -> Bool)
-> Eq ProfilerCoverageRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerCoverageRange -> ProfilerCoverageRange -> Bool
$c/= :: ProfilerCoverageRange -> ProfilerCoverageRange -> Bool
== :: ProfilerCoverageRange -> ProfilerCoverageRange -> Bool
$c== :: ProfilerCoverageRange -> ProfilerCoverageRange -> Bool
Eq, Int -> ProfilerCoverageRange -> ShowS
[ProfilerCoverageRange] -> ShowS
ProfilerCoverageRange -> String
(Int -> ProfilerCoverageRange -> ShowS)
-> (ProfilerCoverageRange -> String)
-> ([ProfilerCoverageRange] -> ShowS)
-> Show ProfilerCoverageRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerCoverageRange] -> ShowS
$cshowList :: [ProfilerCoverageRange] -> ShowS
show :: ProfilerCoverageRange -> String
$cshow :: ProfilerCoverageRange -> String
showsPrec :: Int -> ProfilerCoverageRange -> ShowS
$cshowsPrec :: Int -> ProfilerCoverageRange -> ShowS
Show)
instance FromJSON ProfilerCoverageRange where
  parseJSON :: Value -> Parser ProfilerCoverageRange
parseJSON = String
-> (Object -> Parser ProfilerCoverageRange)
-> Value
-> Parser ProfilerCoverageRange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerCoverageRange" ((Object -> Parser ProfilerCoverageRange)
 -> Value -> Parser ProfilerCoverageRange)
-> (Object -> Parser ProfilerCoverageRange)
-> Value
-> Parser ProfilerCoverageRange
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Int -> Int -> ProfilerCoverageRange
ProfilerCoverageRange
    (Int -> Int -> Int -> ProfilerCoverageRange)
-> Parser Int -> Parser (Int -> Int -> ProfilerCoverageRange)
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
"startOffset"
    Parser (Int -> Int -> ProfilerCoverageRange)
-> Parser Int -> Parser (Int -> ProfilerCoverageRange)
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
"endOffset"
    Parser (Int -> ProfilerCoverageRange)
-> Parser Int -> Parser ProfilerCoverageRange
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
"count"
instance ToJSON ProfilerCoverageRange where
  toJSON :: ProfilerCoverageRange -> Value
toJSON ProfilerCoverageRange
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
"startOffset" 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 (ProfilerCoverageRange -> Int
profilerCoverageRangeStartOffset ProfilerCoverageRange
p),
    (Text
"endOffset" 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 (ProfilerCoverageRange -> Int
profilerCoverageRangeEndOffset ProfilerCoverageRange
p),
    (Text
"count" 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 (ProfilerCoverageRange -> Int
profilerCoverageRangeCount ProfilerCoverageRange
p)
    ]

-- | Type 'Profiler.FunctionCoverage'.
--   Coverage data for a JavaScript function.
data ProfilerFunctionCoverage = ProfilerFunctionCoverage
  {
    -- | JavaScript function name.
    ProfilerFunctionCoverage -> Text
profilerFunctionCoverageFunctionName :: T.Text,
    -- | Source ranges inside the function with coverage data.
    ProfilerFunctionCoverage -> [ProfilerCoverageRange]
profilerFunctionCoverageRanges :: [ProfilerCoverageRange],
    -- | Whether coverage data for this function has block granularity.
    ProfilerFunctionCoverage -> Bool
profilerFunctionCoverageIsBlockCoverage :: Bool
  }
  deriving (ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool
(ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool)
-> (ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool)
-> Eq ProfilerFunctionCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool
$c/= :: ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool
== :: ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool
$c== :: ProfilerFunctionCoverage -> ProfilerFunctionCoverage -> Bool
Eq, Int -> ProfilerFunctionCoverage -> ShowS
[ProfilerFunctionCoverage] -> ShowS
ProfilerFunctionCoverage -> String
(Int -> ProfilerFunctionCoverage -> ShowS)
-> (ProfilerFunctionCoverage -> String)
-> ([ProfilerFunctionCoverage] -> ShowS)
-> Show ProfilerFunctionCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerFunctionCoverage] -> ShowS
$cshowList :: [ProfilerFunctionCoverage] -> ShowS
show :: ProfilerFunctionCoverage -> String
$cshow :: ProfilerFunctionCoverage -> String
showsPrec :: Int -> ProfilerFunctionCoverage -> ShowS
$cshowsPrec :: Int -> ProfilerFunctionCoverage -> ShowS
Show)
instance FromJSON ProfilerFunctionCoverage where
  parseJSON :: Value -> Parser ProfilerFunctionCoverage
parseJSON = String
-> (Object -> Parser ProfilerFunctionCoverage)
-> Value
-> Parser ProfilerFunctionCoverage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerFunctionCoverage" ((Object -> Parser ProfilerFunctionCoverage)
 -> Value -> Parser ProfilerFunctionCoverage)
-> (Object -> Parser ProfilerFunctionCoverage)
-> Value
-> Parser ProfilerFunctionCoverage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> [ProfilerCoverageRange] -> Bool -> ProfilerFunctionCoverage
ProfilerFunctionCoverage
    (Text
 -> [ProfilerCoverageRange] -> Bool -> ProfilerFunctionCoverage)
-> Parser Text
-> Parser
     ([ProfilerCoverageRange] -> Bool -> ProfilerFunctionCoverage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"functionName"
    Parser
  ([ProfilerCoverageRange] -> Bool -> ProfilerFunctionCoverage)
-> Parser [ProfilerCoverageRange]
-> Parser (Bool -> ProfilerFunctionCoverage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [ProfilerCoverageRange]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"ranges"
    Parser (Bool -> ProfilerFunctionCoverage)
-> Parser Bool -> Parser ProfilerFunctionCoverage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"isBlockCoverage"
instance ToJSON ProfilerFunctionCoverage where
  toJSON :: ProfilerFunctionCoverage -> Value
toJSON ProfilerFunctionCoverage
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"functionName" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (ProfilerFunctionCoverage -> Text
profilerFunctionCoverageFunctionName ProfilerFunctionCoverage
p),
    (Text
"ranges" Text -> [ProfilerCoverageRange] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([ProfilerCoverageRange] -> Pair)
-> Maybe [ProfilerCoverageRange] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProfilerCoverageRange] -> Maybe [ProfilerCoverageRange]
forall a. a -> Maybe a
Just (ProfilerFunctionCoverage -> [ProfilerCoverageRange]
profilerFunctionCoverageRanges ProfilerFunctionCoverage
p),
    (Text
"isBlockCoverage" 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 (ProfilerFunctionCoverage -> Bool
profilerFunctionCoverageIsBlockCoverage ProfilerFunctionCoverage
p)
    ]

-- | Type 'Profiler.ScriptCoverage'.
--   Coverage data for a JavaScript script.
data ProfilerScriptCoverage = ProfilerScriptCoverage
  {
    -- | JavaScript script id.
    ProfilerScriptCoverage -> Text
profilerScriptCoverageScriptId :: Runtime.RuntimeScriptId,
    -- | JavaScript script name or url.
    ProfilerScriptCoverage -> Text
profilerScriptCoverageUrl :: T.Text,
    -- | Functions contained in the script that has coverage data.
    ProfilerScriptCoverage -> [ProfilerFunctionCoverage]
profilerScriptCoverageFunctions :: [ProfilerFunctionCoverage]
  }
  deriving (ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool
(ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool)
-> (ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool)
-> Eq ProfilerScriptCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool
$c/= :: ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool
== :: ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool
$c== :: ProfilerScriptCoverage -> ProfilerScriptCoverage -> Bool
Eq, Int -> ProfilerScriptCoverage -> ShowS
[ProfilerScriptCoverage] -> ShowS
ProfilerScriptCoverage -> String
(Int -> ProfilerScriptCoverage -> ShowS)
-> (ProfilerScriptCoverage -> String)
-> ([ProfilerScriptCoverage] -> ShowS)
-> Show ProfilerScriptCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerScriptCoverage] -> ShowS
$cshowList :: [ProfilerScriptCoverage] -> ShowS
show :: ProfilerScriptCoverage -> String
$cshow :: ProfilerScriptCoverage -> String
showsPrec :: Int -> ProfilerScriptCoverage -> ShowS
$cshowsPrec :: Int -> ProfilerScriptCoverage -> ShowS
Show)
instance FromJSON ProfilerScriptCoverage where
  parseJSON :: Value -> Parser ProfilerScriptCoverage
parseJSON = String
-> (Object -> Parser ProfilerScriptCoverage)
-> Value
-> Parser ProfilerScriptCoverage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerScriptCoverage" ((Object -> Parser ProfilerScriptCoverage)
 -> Value -> Parser ProfilerScriptCoverage)
-> (Object -> Parser ProfilerScriptCoverage)
-> Value
-> Parser ProfilerScriptCoverage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text -> [ProfilerFunctionCoverage] -> ProfilerScriptCoverage
ProfilerScriptCoverage
    (Text
 -> Text -> [ProfilerFunctionCoverage] -> ProfilerScriptCoverage)
-> Parser Text
-> Parser
     (Text -> [ProfilerFunctionCoverage] -> ProfilerScriptCoverage)
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
"scriptId"
    Parser
  (Text -> [ProfilerFunctionCoverage] -> ProfilerScriptCoverage)
-> Parser Text
-> Parser ([ProfilerFunctionCoverage] -> ProfilerScriptCoverage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"url"
    Parser ([ProfilerFunctionCoverage] -> ProfilerScriptCoverage)
-> Parser [ProfilerFunctionCoverage]
-> Parser ProfilerScriptCoverage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [ProfilerFunctionCoverage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"functions"
instance ToJSON ProfilerScriptCoverage where
  toJSON :: ProfilerScriptCoverage -> Value
toJSON ProfilerScriptCoverage
p = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [
    (Text
"scriptId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (ProfilerScriptCoverage -> Text
profilerScriptCoverageScriptId ProfilerScriptCoverage
p),
    (Text
"url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just (ProfilerScriptCoverage -> Text
profilerScriptCoverageUrl ProfilerScriptCoverage
p),
    (Text
"functions" Text -> [ProfilerFunctionCoverage] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) ([ProfilerFunctionCoverage] -> Pair)
-> Maybe [ProfilerFunctionCoverage] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProfilerFunctionCoverage] -> Maybe [ProfilerFunctionCoverage]
forall a. a -> Maybe a
Just (ProfilerScriptCoverage -> [ProfilerFunctionCoverage]
profilerScriptCoverageFunctions ProfilerScriptCoverage
p)
    ]

-- | Type of the 'Profiler.consoleProfileFinished' event.
data ProfilerConsoleProfileFinished = ProfilerConsoleProfileFinished
  {
    ProfilerConsoleProfileFinished -> Text
profilerConsoleProfileFinishedId :: T.Text,
    -- | Location of console.profileEnd().
    ProfilerConsoleProfileFinished -> DebuggerLocation
profilerConsoleProfileFinishedLocation :: Debugger.DebuggerLocation,
    ProfilerConsoleProfileFinished -> ProfilerProfile
profilerConsoleProfileFinishedProfile :: ProfilerProfile,
    -- | Profile title passed as an argument to console.profile().
    ProfilerConsoleProfileFinished -> Maybe Text
profilerConsoleProfileFinishedTitle :: Maybe T.Text
  }
  deriving (ProfilerConsoleProfileFinished
-> ProfilerConsoleProfileFinished -> Bool
(ProfilerConsoleProfileFinished
 -> ProfilerConsoleProfileFinished -> Bool)
-> (ProfilerConsoleProfileFinished
    -> ProfilerConsoleProfileFinished -> Bool)
-> Eq ProfilerConsoleProfileFinished
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerConsoleProfileFinished
-> ProfilerConsoleProfileFinished -> Bool
$c/= :: ProfilerConsoleProfileFinished
-> ProfilerConsoleProfileFinished -> Bool
== :: ProfilerConsoleProfileFinished
-> ProfilerConsoleProfileFinished -> Bool
$c== :: ProfilerConsoleProfileFinished
-> ProfilerConsoleProfileFinished -> Bool
Eq, Int -> ProfilerConsoleProfileFinished -> ShowS
[ProfilerConsoleProfileFinished] -> ShowS
ProfilerConsoleProfileFinished -> String
(Int -> ProfilerConsoleProfileFinished -> ShowS)
-> (ProfilerConsoleProfileFinished -> String)
-> ([ProfilerConsoleProfileFinished] -> ShowS)
-> Show ProfilerConsoleProfileFinished
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerConsoleProfileFinished] -> ShowS
$cshowList :: [ProfilerConsoleProfileFinished] -> ShowS
show :: ProfilerConsoleProfileFinished -> String
$cshow :: ProfilerConsoleProfileFinished -> String
showsPrec :: Int -> ProfilerConsoleProfileFinished -> ShowS
$cshowsPrec :: Int -> ProfilerConsoleProfileFinished -> ShowS
Show)
instance FromJSON ProfilerConsoleProfileFinished where
  parseJSON :: Value -> Parser ProfilerConsoleProfileFinished
parseJSON = String
-> (Object -> Parser ProfilerConsoleProfileFinished)
-> Value
-> Parser ProfilerConsoleProfileFinished
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerConsoleProfileFinished" ((Object -> Parser ProfilerConsoleProfileFinished)
 -> Value -> Parser ProfilerConsoleProfileFinished)
-> (Object -> Parser ProfilerConsoleProfileFinished)
-> Value
-> Parser ProfilerConsoleProfileFinished
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> DebuggerLocation
-> ProfilerProfile
-> Maybe Text
-> ProfilerConsoleProfileFinished
ProfilerConsoleProfileFinished
    (Text
 -> DebuggerLocation
 -> ProfilerProfile
 -> Maybe Text
 -> ProfilerConsoleProfileFinished)
-> Parser Text
-> Parser
     (DebuggerLocation
      -> ProfilerProfile -> Maybe Text -> ProfilerConsoleProfileFinished)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Parser
  (DebuggerLocation
   -> ProfilerProfile -> Maybe Text -> ProfilerConsoleProfileFinished)
-> Parser DebuggerLocation
-> Parser
     (ProfilerProfile -> Maybe Text -> ProfilerConsoleProfileFinished)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DebuggerLocation
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"location"
    Parser
  (ProfilerProfile -> Maybe Text -> ProfilerConsoleProfileFinished)
-> Parser ProfilerProfile
-> Parser (Maybe Text -> ProfilerConsoleProfileFinished)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser ProfilerProfile
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"profile"
    Parser (Maybe Text -> ProfilerConsoleProfileFinished)
-> Parser (Maybe Text) -> Parser ProfilerConsoleProfileFinished
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"title"
instance Event ProfilerConsoleProfileFinished where
  eventName :: Proxy ProfilerConsoleProfileFinished -> String
eventName Proxy ProfilerConsoleProfileFinished
_ = String
"Profiler.consoleProfileFinished"

-- | Type of the 'Profiler.consoleProfileStarted' event.
data ProfilerConsoleProfileStarted = ProfilerConsoleProfileStarted
  {
    ProfilerConsoleProfileStarted -> Text
profilerConsoleProfileStartedId :: T.Text,
    -- | Location of console.profile().
    ProfilerConsoleProfileStarted -> DebuggerLocation
profilerConsoleProfileStartedLocation :: Debugger.DebuggerLocation,
    -- | Profile title passed as an argument to console.profile().
    ProfilerConsoleProfileStarted -> Maybe Text
profilerConsoleProfileStartedTitle :: Maybe T.Text
  }
  deriving (ProfilerConsoleProfileStarted
-> ProfilerConsoleProfileStarted -> Bool
(ProfilerConsoleProfileStarted
 -> ProfilerConsoleProfileStarted -> Bool)
-> (ProfilerConsoleProfileStarted
    -> ProfilerConsoleProfileStarted -> Bool)
-> Eq ProfilerConsoleProfileStarted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerConsoleProfileStarted
-> ProfilerConsoleProfileStarted -> Bool
$c/= :: ProfilerConsoleProfileStarted
-> ProfilerConsoleProfileStarted -> Bool
== :: ProfilerConsoleProfileStarted
-> ProfilerConsoleProfileStarted -> Bool
$c== :: ProfilerConsoleProfileStarted
-> ProfilerConsoleProfileStarted -> Bool
Eq, Int -> ProfilerConsoleProfileStarted -> ShowS
[ProfilerConsoleProfileStarted] -> ShowS
ProfilerConsoleProfileStarted -> String
(Int -> ProfilerConsoleProfileStarted -> ShowS)
-> (ProfilerConsoleProfileStarted -> String)
-> ([ProfilerConsoleProfileStarted] -> ShowS)
-> Show ProfilerConsoleProfileStarted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerConsoleProfileStarted] -> ShowS
$cshowList :: [ProfilerConsoleProfileStarted] -> ShowS
show :: ProfilerConsoleProfileStarted -> String
$cshow :: ProfilerConsoleProfileStarted -> String
showsPrec :: Int -> ProfilerConsoleProfileStarted -> ShowS
$cshowsPrec :: Int -> ProfilerConsoleProfileStarted -> ShowS
Show)
instance FromJSON ProfilerConsoleProfileStarted where
  parseJSON :: Value -> Parser ProfilerConsoleProfileStarted
parseJSON = String
-> (Object -> Parser ProfilerConsoleProfileStarted)
-> Value
-> Parser ProfilerConsoleProfileStarted
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerConsoleProfileStarted" ((Object -> Parser ProfilerConsoleProfileStarted)
 -> Value -> Parser ProfilerConsoleProfileStarted)
-> (Object -> Parser ProfilerConsoleProfileStarted)
-> Value
-> Parser ProfilerConsoleProfileStarted
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> DebuggerLocation -> Maybe Text -> ProfilerConsoleProfileStarted
ProfilerConsoleProfileStarted
    (Text
 -> DebuggerLocation -> Maybe Text -> ProfilerConsoleProfileStarted)
-> Parser Text
-> Parser
     (DebuggerLocation -> Maybe Text -> ProfilerConsoleProfileStarted)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"id"
    Parser
  (DebuggerLocation -> Maybe Text -> ProfilerConsoleProfileStarted)
-> Parser DebuggerLocation
-> Parser (Maybe Text -> ProfilerConsoleProfileStarted)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser DebuggerLocation
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"location"
    Parser (Maybe Text -> ProfilerConsoleProfileStarted)
-> Parser (Maybe Text) -> Parser ProfilerConsoleProfileStarted
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"title"
instance Event ProfilerConsoleProfileStarted where
  eventName :: Proxy ProfilerConsoleProfileStarted -> String
eventName Proxy ProfilerConsoleProfileStarted
_ = String
"Profiler.consoleProfileStarted"

-- | Type of the 'Profiler.preciseCoverageDeltaUpdate' event.
data ProfilerPreciseCoverageDeltaUpdate = ProfilerPreciseCoverageDeltaUpdate
  {
    -- | Monotonically increasing time (in seconds) when the coverage update was taken in the backend.
    ProfilerPreciseCoverageDeltaUpdate -> Double
profilerPreciseCoverageDeltaUpdateTimestamp :: Double,
    -- | Identifier for distinguishing coverage events.
    ProfilerPreciseCoverageDeltaUpdate -> Text
profilerPreciseCoverageDeltaUpdateOccasion :: T.Text,
    -- | Coverage data for the current isolate.
    ProfilerPreciseCoverageDeltaUpdate -> [ProfilerScriptCoverage]
profilerPreciseCoverageDeltaUpdateResult :: [ProfilerScriptCoverage]
  }
  deriving (ProfilerPreciseCoverageDeltaUpdate
-> ProfilerPreciseCoverageDeltaUpdate -> Bool
(ProfilerPreciseCoverageDeltaUpdate
 -> ProfilerPreciseCoverageDeltaUpdate -> Bool)
-> (ProfilerPreciseCoverageDeltaUpdate
    -> ProfilerPreciseCoverageDeltaUpdate -> Bool)
-> Eq ProfilerPreciseCoverageDeltaUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerPreciseCoverageDeltaUpdate
-> ProfilerPreciseCoverageDeltaUpdate -> Bool
$c/= :: ProfilerPreciseCoverageDeltaUpdate
-> ProfilerPreciseCoverageDeltaUpdate -> Bool
== :: ProfilerPreciseCoverageDeltaUpdate
-> ProfilerPreciseCoverageDeltaUpdate -> Bool
$c== :: ProfilerPreciseCoverageDeltaUpdate
-> ProfilerPreciseCoverageDeltaUpdate -> Bool
Eq, Int -> ProfilerPreciseCoverageDeltaUpdate -> ShowS
[ProfilerPreciseCoverageDeltaUpdate] -> ShowS
ProfilerPreciseCoverageDeltaUpdate -> String
(Int -> ProfilerPreciseCoverageDeltaUpdate -> ShowS)
-> (ProfilerPreciseCoverageDeltaUpdate -> String)
-> ([ProfilerPreciseCoverageDeltaUpdate] -> ShowS)
-> Show ProfilerPreciseCoverageDeltaUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerPreciseCoverageDeltaUpdate] -> ShowS
$cshowList :: [ProfilerPreciseCoverageDeltaUpdate] -> ShowS
show :: ProfilerPreciseCoverageDeltaUpdate -> String
$cshow :: ProfilerPreciseCoverageDeltaUpdate -> String
showsPrec :: Int -> ProfilerPreciseCoverageDeltaUpdate -> ShowS
$cshowsPrec :: Int -> ProfilerPreciseCoverageDeltaUpdate -> ShowS
Show)
instance FromJSON ProfilerPreciseCoverageDeltaUpdate where
  parseJSON :: Value -> Parser ProfilerPreciseCoverageDeltaUpdate
parseJSON = String
-> (Object -> Parser ProfilerPreciseCoverageDeltaUpdate)
-> Value
-> Parser ProfilerPreciseCoverageDeltaUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerPreciseCoverageDeltaUpdate" ((Object -> Parser ProfilerPreciseCoverageDeltaUpdate)
 -> Value -> Parser ProfilerPreciseCoverageDeltaUpdate)
-> (Object -> Parser ProfilerPreciseCoverageDeltaUpdate)
-> Value
-> Parser ProfilerPreciseCoverageDeltaUpdate
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double
-> Text
-> [ProfilerScriptCoverage]
-> ProfilerPreciseCoverageDeltaUpdate
ProfilerPreciseCoverageDeltaUpdate
    (Double
 -> Text
 -> [ProfilerScriptCoverage]
 -> ProfilerPreciseCoverageDeltaUpdate)
-> Parser Double
-> Parser
     (Text
      -> [ProfilerScriptCoverage] -> ProfilerPreciseCoverageDeltaUpdate)
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
"timestamp"
    Parser
  (Text
   -> [ProfilerScriptCoverage] -> ProfilerPreciseCoverageDeltaUpdate)
-> Parser Text
-> Parser
     ([ProfilerScriptCoverage] -> ProfilerPreciseCoverageDeltaUpdate)
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
"occasion"
    Parser
  ([ProfilerScriptCoverage] -> ProfilerPreciseCoverageDeltaUpdate)
-> Parser [ProfilerScriptCoverage]
-> Parser ProfilerPreciseCoverageDeltaUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [ProfilerScriptCoverage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
instance Event ProfilerPreciseCoverageDeltaUpdate where
  eventName :: Proxy ProfilerPreciseCoverageDeltaUpdate -> String
eventName Proxy ProfilerPreciseCoverageDeltaUpdate
_ = String
"Profiler.preciseCoverageDeltaUpdate"


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


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

-- | Collect coverage data for the current isolate. The coverage data may be incomplete due to
--   garbage collection.

-- | Parameters of the 'Profiler.getBestEffortCoverage' command.
data PProfilerGetBestEffortCoverage = PProfilerGetBestEffortCoverage
  deriving (PProfilerGetBestEffortCoverage
-> PProfilerGetBestEffortCoverage -> Bool
(PProfilerGetBestEffortCoverage
 -> PProfilerGetBestEffortCoverage -> Bool)
-> (PProfilerGetBestEffortCoverage
    -> PProfilerGetBestEffortCoverage -> Bool)
-> Eq PProfilerGetBestEffortCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PProfilerGetBestEffortCoverage
-> PProfilerGetBestEffortCoverage -> Bool
$c/= :: PProfilerGetBestEffortCoverage
-> PProfilerGetBestEffortCoverage -> Bool
== :: PProfilerGetBestEffortCoverage
-> PProfilerGetBestEffortCoverage -> Bool
$c== :: PProfilerGetBestEffortCoverage
-> PProfilerGetBestEffortCoverage -> Bool
Eq, Int -> PProfilerGetBestEffortCoverage -> ShowS
[PProfilerGetBestEffortCoverage] -> ShowS
PProfilerGetBestEffortCoverage -> String
(Int -> PProfilerGetBestEffortCoverage -> ShowS)
-> (PProfilerGetBestEffortCoverage -> String)
-> ([PProfilerGetBestEffortCoverage] -> ShowS)
-> Show PProfilerGetBestEffortCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PProfilerGetBestEffortCoverage] -> ShowS
$cshowList :: [PProfilerGetBestEffortCoverage] -> ShowS
show :: PProfilerGetBestEffortCoverage -> String
$cshow :: PProfilerGetBestEffortCoverage -> String
showsPrec :: Int -> PProfilerGetBestEffortCoverage -> ShowS
$cshowsPrec :: Int -> PProfilerGetBestEffortCoverage -> ShowS
Show)
pProfilerGetBestEffortCoverage
  :: PProfilerGetBestEffortCoverage
pProfilerGetBestEffortCoverage :: PProfilerGetBestEffortCoverage
pProfilerGetBestEffortCoverage
  = PProfilerGetBestEffortCoverage
PProfilerGetBestEffortCoverage
instance ToJSON PProfilerGetBestEffortCoverage where
  toJSON :: PProfilerGetBestEffortCoverage -> Value
toJSON PProfilerGetBestEffortCoverage
_ = Value
A.Null
data ProfilerGetBestEffortCoverage = ProfilerGetBestEffortCoverage
  {
    -- | Coverage data for the current isolate.
    ProfilerGetBestEffortCoverage -> [ProfilerScriptCoverage]
profilerGetBestEffortCoverageResult :: [ProfilerScriptCoverage]
  }
  deriving (ProfilerGetBestEffortCoverage
-> ProfilerGetBestEffortCoverage -> Bool
(ProfilerGetBestEffortCoverage
 -> ProfilerGetBestEffortCoverage -> Bool)
-> (ProfilerGetBestEffortCoverage
    -> ProfilerGetBestEffortCoverage -> Bool)
-> Eq ProfilerGetBestEffortCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerGetBestEffortCoverage
-> ProfilerGetBestEffortCoverage -> Bool
$c/= :: ProfilerGetBestEffortCoverage
-> ProfilerGetBestEffortCoverage -> Bool
== :: ProfilerGetBestEffortCoverage
-> ProfilerGetBestEffortCoverage -> Bool
$c== :: ProfilerGetBestEffortCoverage
-> ProfilerGetBestEffortCoverage -> Bool
Eq, Int -> ProfilerGetBestEffortCoverage -> ShowS
[ProfilerGetBestEffortCoverage] -> ShowS
ProfilerGetBestEffortCoverage -> String
(Int -> ProfilerGetBestEffortCoverage -> ShowS)
-> (ProfilerGetBestEffortCoverage -> String)
-> ([ProfilerGetBestEffortCoverage] -> ShowS)
-> Show ProfilerGetBestEffortCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerGetBestEffortCoverage] -> ShowS
$cshowList :: [ProfilerGetBestEffortCoverage] -> ShowS
show :: ProfilerGetBestEffortCoverage -> String
$cshow :: ProfilerGetBestEffortCoverage -> String
showsPrec :: Int -> ProfilerGetBestEffortCoverage -> ShowS
$cshowsPrec :: Int -> ProfilerGetBestEffortCoverage -> ShowS
Show)
instance FromJSON ProfilerGetBestEffortCoverage where
  parseJSON :: Value -> Parser ProfilerGetBestEffortCoverage
parseJSON = String
-> (Object -> Parser ProfilerGetBestEffortCoverage)
-> Value
-> Parser ProfilerGetBestEffortCoverage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerGetBestEffortCoverage" ((Object -> Parser ProfilerGetBestEffortCoverage)
 -> Value -> Parser ProfilerGetBestEffortCoverage)
-> (Object -> Parser ProfilerGetBestEffortCoverage)
-> Value
-> Parser ProfilerGetBestEffortCoverage
forall a b. (a -> b) -> a -> b
$ \Object
o -> [ProfilerScriptCoverage] -> ProfilerGetBestEffortCoverage
ProfilerGetBestEffortCoverage
    ([ProfilerScriptCoverage] -> ProfilerGetBestEffortCoverage)
-> Parser [ProfilerScriptCoverage]
-> Parser ProfilerGetBestEffortCoverage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [ProfilerScriptCoverage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
instance Command PProfilerGetBestEffortCoverage where
  type CommandResponse PProfilerGetBestEffortCoverage = ProfilerGetBestEffortCoverage
  commandName :: Proxy PProfilerGetBestEffortCoverage -> String
commandName Proxy PProfilerGetBestEffortCoverage
_ = String
"Profiler.getBestEffortCoverage"

-- | Changes CPU profiler sampling interval. Must be called before CPU profiles recording started.

-- | Parameters of the 'Profiler.setSamplingInterval' command.
data PProfilerSetSamplingInterval = PProfilerSetSamplingInterval
  {
    -- | New sampling interval in microseconds.
    PProfilerSetSamplingInterval -> Int
pProfilerSetSamplingIntervalInterval :: Int
  }
  deriving (PProfilerSetSamplingInterval
-> PProfilerSetSamplingInterval -> Bool
(PProfilerSetSamplingInterval
 -> PProfilerSetSamplingInterval -> Bool)
-> (PProfilerSetSamplingInterval
    -> PProfilerSetSamplingInterval -> Bool)
-> Eq PProfilerSetSamplingInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PProfilerSetSamplingInterval
-> PProfilerSetSamplingInterval -> Bool
$c/= :: PProfilerSetSamplingInterval
-> PProfilerSetSamplingInterval -> Bool
== :: PProfilerSetSamplingInterval
-> PProfilerSetSamplingInterval -> Bool
$c== :: PProfilerSetSamplingInterval
-> PProfilerSetSamplingInterval -> Bool
Eq, Int -> PProfilerSetSamplingInterval -> ShowS
[PProfilerSetSamplingInterval] -> ShowS
PProfilerSetSamplingInterval -> String
(Int -> PProfilerSetSamplingInterval -> ShowS)
-> (PProfilerSetSamplingInterval -> String)
-> ([PProfilerSetSamplingInterval] -> ShowS)
-> Show PProfilerSetSamplingInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PProfilerSetSamplingInterval] -> ShowS
$cshowList :: [PProfilerSetSamplingInterval] -> ShowS
show :: PProfilerSetSamplingInterval -> String
$cshow :: PProfilerSetSamplingInterval -> String
showsPrec :: Int -> PProfilerSetSamplingInterval -> ShowS
$cshowsPrec :: Int -> PProfilerSetSamplingInterval -> ShowS
Show)
pProfilerSetSamplingInterval
  {-
  -- | New sampling interval in microseconds.
  -}
  :: Int
  -> PProfilerSetSamplingInterval
pProfilerSetSamplingInterval :: Int -> PProfilerSetSamplingInterval
pProfilerSetSamplingInterval
  Int
arg_pProfilerSetSamplingIntervalInterval
  = Int -> PProfilerSetSamplingInterval
PProfilerSetSamplingInterval
    Int
arg_pProfilerSetSamplingIntervalInterval
instance ToJSON PProfilerSetSamplingInterval where
  toJSON :: PProfilerSetSamplingInterval -> Value
toJSON PProfilerSetSamplingInterval
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
"interval" 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 (PProfilerSetSamplingInterval -> Int
pProfilerSetSamplingIntervalInterval PProfilerSetSamplingInterval
p)
    ]
instance Command PProfilerSetSamplingInterval where
  type CommandResponse PProfilerSetSamplingInterval = ()
  commandName :: Proxy PProfilerSetSamplingInterval -> String
commandName Proxy PProfilerSetSamplingInterval
_ = String
"Profiler.setSamplingInterval"
  fromJSON :: Proxy PProfilerSetSamplingInterval
-> Value -> Result (CommandResponse PProfilerSetSamplingInterval)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PProfilerSetSamplingInterval -> Result ())
-> Proxy PProfilerSetSamplingInterval
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PProfilerSetSamplingInterval -> ())
-> Proxy PProfilerSetSamplingInterval
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PProfilerSetSamplingInterval -> ()
forall a b. a -> b -> a
const ()


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

-- | Enable precise code coverage. Coverage data for JavaScript executed before enabling precise code
--   coverage may be incomplete. Enabling prevents running optimized code and resets execution
--   counters.

-- | Parameters of the 'Profiler.startPreciseCoverage' command.
data PProfilerStartPreciseCoverage = PProfilerStartPreciseCoverage
  {
    -- | Collect accurate call counts beyond simple 'covered' or 'not covered'.
    PProfilerStartPreciseCoverage -> Maybe Bool
pProfilerStartPreciseCoverageCallCount :: Maybe Bool,
    -- | Collect block-based coverage.
    PProfilerStartPreciseCoverage -> Maybe Bool
pProfilerStartPreciseCoverageDetailed :: Maybe Bool,
    -- | Allow the backend to send updates on its own initiative
    PProfilerStartPreciseCoverage -> Maybe Bool
pProfilerStartPreciseCoverageAllowTriggeredUpdates :: Maybe Bool
  }
  deriving (PProfilerStartPreciseCoverage
-> PProfilerStartPreciseCoverage -> Bool
(PProfilerStartPreciseCoverage
 -> PProfilerStartPreciseCoverage -> Bool)
-> (PProfilerStartPreciseCoverage
    -> PProfilerStartPreciseCoverage -> Bool)
-> Eq PProfilerStartPreciseCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PProfilerStartPreciseCoverage
-> PProfilerStartPreciseCoverage -> Bool
$c/= :: PProfilerStartPreciseCoverage
-> PProfilerStartPreciseCoverage -> Bool
== :: PProfilerStartPreciseCoverage
-> PProfilerStartPreciseCoverage -> Bool
$c== :: PProfilerStartPreciseCoverage
-> PProfilerStartPreciseCoverage -> Bool
Eq, Int -> PProfilerStartPreciseCoverage -> ShowS
[PProfilerStartPreciseCoverage] -> ShowS
PProfilerStartPreciseCoverage -> String
(Int -> PProfilerStartPreciseCoverage -> ShowS)
-> (PProfilerStartPreciseCoverage -> String)
-> ([PProfilerStartPreciseCoverage] -> ShowS)
-> Show PProfilerStartPreciseCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PProfilerStartPreciseCoverage] -> ShowS
$cshowList :: [PProfilerStartPreciseCoverage] -> ShowS
show :: PProfilerStartPreciseCoverage -> String
$cshow :: PProfilerStartPreciseCoverage -> String
showsPrec :: Int -> PProfilerStartPreciseCoverage -> ShowS
$cshowsPrec :: Int -> PProfilerStartPreciseCoverage -> ShowS
Show)
pProfilerStartPreciseCoverage
  :: PProfilerStartPreciseCoverage
pProfilerStartPreciseCoverage :: PProfilerStartPreciseCoverage
pProfilerStartPreciseCoverage
  = Maybe Bool
-> Maybe Bool -> Maybe Bool -> PProfilerStartPreciseCoverage
PProfilerStartPreciseCoverage
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
forall a. Maybe a
Nothing
instance ToJSON PProfilerStartPreciseCoverage where
  toJSON :: PProfilerStartPreciseCoverage -> Value
toJSON PProfilerStartPreciseCoverage
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
"callCount" 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
<$> (PProfilerStartPreciseCoverage -> Maybe Bool
pProfilerStartPreciseCoverageCallCount PProfilerStartPreciseCoverage
p),
    (Text
"detailed" 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
<$> (PProfilerStartPreciseCoverage -> Maybe Bool
pProfilerStartPreciseCoverageDetailed PProfilerStartPreciseCoverage
p),
    (Text
"allowTriggeredUpdates" 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
<$> (PProfilerStartPreciseCoverage -> Maybe Bool
pProfilerStartPreciseCoverageAllowTriggeredUpdates PProfilerStartPreciseCoverage
p)
    ]
data ProfilerStartPreciseCoverage = ProfilerStartPreciseCoverage
  {
    -- | Monotonically increasing time (in seconds) when the coverage update was taken in the backend.
    ProfilerStartPreciseCoverage -> Double
profilerStartPreciseCoverageTimestamp :: Double
  }
  deriving (ProfilerStartPreciseCoverage
-> ProfilerStartPreciseCoverage -> Bool
(ProfilerStartPreciseCoverage
 -> ProfilerStartPreciseCoverage -> Bool)
-> (ProfilerStartPreciseCoverage
    -> ProfilerStartPreciseCoverage -> Bool)
-> Eq ProfilerStartPreciseCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerStartPreciseCoverage
-> ProfilerStartPreciseCoverage -> Bool
$c/= :: ProfilerStartPreciseCoverage
-> ProfilerStartPreciseCoverage -> Bool
== :: ProfilerStartPreciseCoverage
-> ProfilerStartPreciseCoverage -> Bool
$c== :: ProfilerStartPreciseCoverage
-> ProfilerStartPreciseCoverage -> Bool
Eq, Int -> ProfilerStartPreciseCoverage -> ShowS
[ProfilerStartPreciseCoverage] -> ShowS
ProfilerStartPreciseCoverage -> String
(Int -> ProfilerStartPreciseCoverage -> ShowS)
-> (ProfilerStartPreciseCoverage -> String)
-> ([ProfilerStartPreciseCoverage] -> ShowS)
-> Show ProfilerStartPreciseCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerStartPreciseCoverage] -> ShowS
$cshowList :: [ProfilerStartPreciseCoverage] -> ShowS
show :: ProfilerStartPreciseCoverage -> String
$cshow :: ProfilerStartPreciseCoverage -> String
showsPrec :: Int -> ProfilerStartPreciseCoverage -> ShowS
$cshowsPrec :: Int -> ProfilerStartPreciseCoverage -> ShowS
Show)
instance FromJSON ProfilerStartPreciseCoverage where
  parseJSON :: Value -> Parser ProfilerStartPreciseCoverage
parseJSON = String
-> (Object -> Parser ProfilerStartPreciseCoverage)
-> Value
-> Parser ProfilerStartPreciseCoverage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerStartPreciseCoverage" ((Object -> Parser ProfilerStartPreciseCoverage)
 -> Value -> Parser ProfilerStartPreciseCoverage)
-> (Object -> Parser ProfilerStartPreciseCoverage)
-> Value
-> Parser ProfilerStartPreciseCoverage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Double -> ProfilerStartPreciseCoverage
ProfilerStartPreciseCoverage
    (Double -> ProfilerStartPreciseCoverage)
-> Parser Double -> Parser ProfilerStartPreciseCoverage
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
"timestamp"
instance Command PProfilerStartPreciseCoverage where
  type CommandResponse PProfilerStartPreciseCoverage = ProfilerStartPreciseCoverage
  commandName :: Proxy PProfilerStartPreciseCoverage -> String
commandName Proxy PProfilerStartPreciseCoverage
_ = String
"Profiler.startPreciseCoverage"


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

-- | Disable precise code coverage. Disabling releases unnecessary execution count records and allows
--   executing optimized code.

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

-- | Collect coverage data for the current isolate, and resets execution counters. Precise code
--   coverage needs to have started.

-- | Parameters of the 'Profiler.takePreciseCoverage' command.
data PProfilerTakePreciseCoverage = PProfilerTakePreciseCoverage
  deriving (PProfilerTakePreciseCoverage
-> PProfilerTakePreciseCoverage -> Bool
(PProfilerTakePreciseCoverage
 -> PProfilerTakePreciseCoverage -> Bool)
-> (PProfilerTakePreciseCoverage
    -> PProfilerTakePreciseCoverage -> Bool)
-> Eq PProfilerTakePreciseCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PProfilerTakePreciseCoverage
-> PProfilerTakePreciseCoverage -> Bool
$c/= :: PProfilerTakePreciseCoverage
-> PProfilerTakePreciseCoverage -> Bool
== :: PProfilerTakePreciseCoverage
-> PProfilerTakePreciseCoverage -> Bool
$c== :: PProfilerTakePreciseCoverage
-> PProfilerTakePreciseCoverage -> Bool
Eq, Int -> PProfilerTakePreciseCoverage -> ShowS
[PProfilerTakePreciseCoverage] -> ShowS
PProfilerTakePreciseCoverage -> String
(Int -> PProfilerTakePreciseCoverage -> ShowS)
-> (PProfilerTakePreciseCoverage -> String)
-> ([PProfilerTakePreciseCoverage] -> ShowS)
-> Show PProfilerTakePreciseCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PProfilerTakePreciseCoverage] -> ShowS
$cshowList :: [PProfilerTakePreciseCoverage] -> ShowS
show :: PProfilerTakePreciseCoverage -> String
$cshow :: PProfilerTakePreciseCoverage -> String
showsPrec :: Int -> PProfilerTakePreciseCoverage -> ShowS
$cshowsPrec :: Int -> PProfilerTakePreciseCoverage -> ShowS
Show)
pProfilerTakePreciseCoverage
  :: PProfilerTakePreciseCoverage
pProfilerTakePreciseCoverage :: PProfilerTakePreciseCoverage
pProfilerTakePreciseCoverage
  = PProfilerTakePreciseCoverage
PProfilerTakePreciseCoverage
instance ToJSON PProfilerTakePreciseCoverage where
  toJSON :: PProfilerTakePreciseCoverage -> Value
toJSON PProfilerTakePreciseCoverage
_ = Value
A.Null
data ProfilerTakePreciseCoverage = ProfilerTakePreciseCoverage
  {
    -- | Coverage data for the current isolate.
    ProfilerTakePreciseCoverage -> [ProfilerScriptCoverage]
profilerTakePreciseCoverageResult :: [ProfilerScriptCoverage],
    -- | Monotonically increasing time (in seconds) when the coverage update was taken in the backend.
    ProfilerTakePreciseCoverage -> Double
profilerTakePreciseCoverageTimestamp :: Double
  }
  deriving (ProfilerTakePreciseCoverage -> ProfilerTakePreciseCoverage -> Bool
(ProfilerTakePreciseCoverage
 -> ProfilerTakePreciseCoverage -> Bool)
-> (ProfilerTakePreciseCoverage
    -> ProfilerTakePreciseCoverage -> Bool)
-> Eq ProfilerTakePreciseCoverage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilerTakePreciseCoverage -> ProfilerTakePreciseCoverage -> Bool
$c/= :: ProfilerTakePreciseCoverage -> ProfilerTakePreciseCoverage -> Bool
== :: ProfilerTakePreciseCoverage -> ProfilerTakePreciseCoverage -> Bool
$c== :: ProfilerTakePreciseCoverage -> ProfilerTakePreciseCoverage -> Bool
Eq, Int -> ProfilerTakePreciseCoverage -> ShowS
[ProfilerTakePreciseCoverage] -> ShowS
ProfilerTakePreciseCoverage -> String
(Int -> ProfilerTakePreciseCoverage -> ShowS)
-> (ProfilerTakePreciseCoverage -> String)
-> ([ProfilerTakePreciseCoverage] -> ShowS)
-> Show ProfilerTakePreciseCoverage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilerTakePreciseCoverage] -> ShowS
$cshowList :: [ProfilerTakePreciseCoverage] -> ShowS
show :: ProfilerTakePreciseCoverage -> String
$cshow :: ProfilerTakePreciseCoverage -> String
showsPrec :: Int -> ProfilerTakePreciseCoverage -> ShowS
$cshowsPrec :: Int -> ProfilerTakePreciseCoverage -> ShowS
Show)
instance FromJSON ProfilerTakePreciseCoverage where
  parseJSON :: Value -> Parser ProfilerTakePreciseCoverage
parseJSON = String
-> (Object -> Parser ProfilerTakePreciseCoverage)
-> Value
-> Parser ProfilerTakePreciseCoverage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProfilerTakePreciseCoverage" ((Object -> Parser ProfilerTakePreciseCoverage)
 -> Value -> Parser ProfilerTakePreciseCoverage)
-> (Object -> Parser ProfilerTakePreciseCoverage)
-> Value
-> Parser ProfilerTakePreciseCoverage
forall a b. (a -> b) -> a -> b
$ \Object
o -> [ProfilerScriptCoverage] -> Double -> ProfilerTakePreciseCoverage
ProfilerTakePreciseCoverage
    ([ProfilerScriptCoverage] -> Double -> ProfilerTakePreciseCoverage)
-> Parser [ProfilerScriptCoverage]
-> Parser (Double -> ProfilerTakePreciseCoverage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [ProfilerScriptCoverage]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"result"
    Parser (Double -> ProfilerTakePreciseCoverage)
-> Parser Double -> Parser ProfilerTakePreciseCoverage
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 Command PProfilerTakePreciseCoverage where
  type CommandResponse PProfilerTakePreciseCoverage = ProfilerTakePreciseCoverage
  commandName :: Proxy PProfilerTakePreciseCoverage -> String
commandName Proxy PProfilerTakePreciseCoverage
_ = String
"Profiler.takePreciseCoverage"