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


{- |
= Performance

-}


module CDP.Domains.Performance (module CDP.Domains.Performance) 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 'Performance.Metric'.
--   Run-time execution metric.
data PerformanceMetric = PerformanceMetric
  {
    -- | Metric name.
    PerformanceMetric -> Text
performanceMetricName :: T.Text,
    -- | Metric value.
    PerformanceMetric -> Double
performanceMetricValue :: Double
  }
  deriving (PerformanceMetric -> PerformanceMetric -> Bool
(PerformanceMetric -> PerformanceMetric -> Bool)
-> (PerformanceMetric -> PerformanceMetric -> Bool)
-> Eq PerformanceMetric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceMetric -> PerformanceMetric -> Bool
$c/= :: PerformanceMetric -> PerformanceMetric -> Bool
== :: PerformanceMetric -> PerformanceMetric -> Bool
$c== :: PerformanceMetric -> PerformanceMetric -> Bool
Eq, Int -> PerformanceMetric -> ShowS
[PerformanceMetric] -> ShowS
PerformanceMetric -> String
(Int -> PerformanceMetric -> ShowS)
-> (PerformanceMetric -> String)
-> ([PerformanceMetric] -> ShowS)
-> Show PerformanceMetric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceMetric] -> ShowS
$cshowList :: [PerformanceMetric] -> ShowS
show :: PerformanceMetric -> String
$cshow :: PerformanceMetric -> String
showsPrec :: Int -> PerformanceMetric -> ShowS
$cshowsPrec :: Int -> PerformanceMetric -> ShowS
Show)
instance FromJSON PerformanceMetric where
  parseJSON :: Value -> Parser PerformanceMetric
parseJSON = String
-> (Object -> Parser PerformanceMetric)
-> Value
-> Parser PerformanceMetric
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceMetric" ((Object -> Parser PerformanceMetric)
 -> Value -> Parser PerformanceMetric)
-> (Object -> Parser PerformanceMetric)
-> Value
-> Parser PerformanceMetric
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Double -> PerformanceMetric
PerformanceMetric
    (Text -> Double -> PerformanceMetric)
-> Parser Text -> Parser (Double -> PerformanceMetric)
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 (Double -> PerformanceMetric)
-> Parser Double -> Parser PerformanceMetric
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
"value"
instance ToJSON PerformanceMetric where
  toJSON :: PerformanceMetric -> Value
toJSON PerformanceMetric
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 (PerformanceMetric -> Text
performanceMetricName PerformanceMetric
p),
    (Text
"value" 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 (PerformanceMetric -> Double
performanceMetricValue PerformanceMetric
p)
    ]

-- | Type of the 'Performance.metrics' event.
data PerformanceMetrics = PerformanceMetrics
  {
    -- | Current values of the metrics.
    PerformanceMetrics -> [PerformanceMetric]
performanceMetricsMetrics :: [PerformanceMetric],
    -- | Timestamp title.
    PerformanceMetrics -> Text
performanceMetricsTitle :: T.Text
  }
  deriving (PerformanceMetrics -> PerformanceMetrics -> Bool
(PerformanceMetrics -> PerformanceMetrics -> Bool)
-> (PerformanceMetrics -> PerformanceMetrics -> Bool)
-> Eq PerformanceMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceMetrics -> PerformanceMetrics -> Bool
$c/= :: PerformanceMetrics -> PerformanceMetrics -> Bool
== :: PerformanceMetrics -> PerformanceMetrics -> Bool
$c== :: PerformanceMetrics -> PerformanceMetrics -> Bool
Eq, Int -> PerformanceMetrics -> ShowS
[PerformanceMetrics] -> ShowS
PerformanceMetrics -> String
(Int -> PerformanceMetrics -> ShowS)
-> (PerformanceMetrics -> String)
-> ([PerformanceMetrics] -> ShowS)
-> Show PerformanceMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceMetrics] -> ShowS
$cshowList :: [PerformanceMetrics] -> ShowS
show :: PerformanceMetrics -> String
$cshow :: PerformanceMetrics -> String
showsPrec :: Int -> PerformanceMetrics -> ShowS
$cshowsPrec :: Int -> PerformanceMetrics -> ShowS
Show)
instance FromJSON PerformanceMetrics where
  parseJSON :: Value -> Parser PerformanceMetrics
parseJSON = String
-> (Object -> Parser PerformanceMetrics)
-> Value
-> Parser PerformanceMetrics
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceMetrics" ((Object -> Parser PerformanceMetrics)
 -> Value -> Parser PerformanceMetrics)
-> (Object -> Parser PerformanceMetrics)
-> Value
-> Parser PerformanceMetrics
forall a b. (a -> b) -> a -> b
$ \Object
o -> [PerformanceMetric] -> Text -> PerformanceMetrics
PerformanceMetrics
    ([PerformanceMetric] -> Text -> PerformanceMetrics)
-> Parser [PerformanceMetric]
-> Parser (Text -> PerformanceMetrics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [PerformanceMetric]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"metrics"
    Parser (Text -> PerformanceMetrics)
-> Parser Text -> Parser PerformanceMetrics
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
"title"
instance Event PerformanceMetrics where
  eventName :: Proxy PerformanceMetrics -> String
eventName Proxy PerformanceMetrics
_ = String
"Performance.metrics"

-- | Disable collecting and reporting metrics.

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

-- | Enable collecting and reporting metrics.

-- | Parameters of the 'Performance.enable' command.
data PPerformanceEnableTimeDomain = PPerformanceEnableTimeDomainTimeTicks | PPerformanceEnableTimeDomainThreadTicks
  deriving (Eq PPerformanceEnableTimeDomain
Eq PPerformanceEnableTimeDomain
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> Ordering)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> Bool)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> Bool)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> Bool)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> Bool)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain)
-> Ord PPerformanceEnableTimeDomain
PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Ordering
PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain
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 :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain
$cmin :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain
max :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain
$cmax :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> PPerformanceEnableTimeDomain
>= :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
$c>= :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
> :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
$c> :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
<= :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
$c<= :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
< :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
$c< :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
compare :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Ordering
$ccompare :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Ordering
$cp1Ord :: Eq PPerformanceEnableTimeDomain
Ord, PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
(PPerformanceEnableTimeDomain
 -> PPerformanceEnableTimeDomain -> Bool)
-> (PPerformanceEnableTimeDomain
    -> PPerformanceEnableTimeDomain -> Bool)
-> Eq PPerformanceEnableTimeDomain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
$c/= :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
== :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
$c== :: PPerformanceEnableTimeDomain
-> PPerformanceEnableTimeDomain -> Bool
Eq, Int -> PPerformanceEnableTimeDomain -> ShowS
[PPerformanceEnableTimeDomain] -> ShowS
PPerformanceEnableTimeDomain -> String
(Int -> PPerformanceEnableTimeDomain -> ShowS)
-> (PPerformanceEnableTimeDomain -> String)
-> ([PPerformanceEnableTimeDomain] -> ShowS)
-> Show PPerformanceEnableTimeDomain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPerformanceEnableTimeDomain] -> ShowS
$cshowList :: [PPerformanceEnableTimeDomain] -> ShowS
show :: PPerformanceEnableTimeDomain -> String
$cshow :: PPerformanceEnableTimeDomain -> String
showsPrec :: Int -> PPerformanceEnableTimeDomain -> ShowS
$cshowsPrec :: Int -> PPerformanceEnableTimeDomain -> ShowS
Show, ReadPrec [PPerformanceEnableTimeDomain]
ReadPrec PPerformanceEnableTimeDomain
Int -> ReadS PPerformanceEnableTimeDomain
ReadS [PPerformanceEnableTimeDomain]
(Int -> ReadS PPerformanceEnableTimeDomain)
-> ReadS [PPerformanceEnableTimeDomain]
-> ReadPrec PPerformanceEnableTimeDomain
-> ReadPrec [PPerformanceEnableTimeDomain]
-> Read PPerformanceEnableTimeDomain
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PPerformanceEnableTimeDomain]
$creadListPrec :: ReadPrec [PPerformanceEnableTimeDomain]
readPrec :: ReadPrec PPerformanceEnableTimeDomain
$creadPrec :: ReadPrec PPerformanceEnableTimeDomain
readList :: ReadS [PPerformanceEnableTimeDomain]
$creadList :: ReadS [PPerformanceEnableTimeDomain]
readsPrec :: Int -> ReadS PPerformanceEnableTimeDomain
$creadsPrec :: Int -> ReadS PPerformanceEnableTimeDomain
Read)
instance FromJSON PPerformanceEnableTimeDomain where
  parseJSON :: Value -> Parser PPerformanceEnableTimeDomain
parseJSON = String
-> (Text -> Parser PPerformanceEnableTimeDomain)
-> Value
-> Parser PPerformanceEnableTimeDomain
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"PPerformanceEnableTimeDomain" ((Text -> Parser PPerformanceEnableTimeDomain)
 -> Value -> Parser PPerformanceEnableTimeDomain)
-> (Text -> Parser PPerformanceEnableTimeDomain)
-> Value
-> Parser PPerformanceEnableTimeDomain
forall a b. (a -> b) -> a -> b
$ \Text
v -> case Text
v of
    Text
"timeTicks" -> PPerformanceEnableTimeDomain -> Parser PPerformanceEnableTimeDomain
forall (f :: * -> *) a. Applicative f => a -> f a
pure PPerformanceEnableTimeDomain
PPerformanceEnableTimeDomainTimeTicks
    Text
"threadTicks" -> PPerformanceEnableTimeDomain -> Parser PPerformanceEnableTimeDomain
forall (f :: * -> *) a. Applicative f => a -> f a
pure PPerformanceEnableTimeDomain
PPerformanceEnableTimeDomainThreadTicks
    Text
"_" -> String -> Parser PPerformanceEnableTimeDomain
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse PPerformanceEnableTimeDomain"
instance ToJSON PPerformanceEnableTimeDomain where
  toJSON :: PPerformanceEnableTimeDomain -> Value
toJSON PPerformanceEnableTimeDomain
v = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case PPerformanceEnableTimeDomain
v of
    PPerformanceEnableTimeDomain
PPerformanceEnableTimeDomainTimeTicks -> Text
"timeTicks"
    PPerformanceEnableTimeDomain
PPerformanceEnableTimeDomainThreadTicks -> Text
"threadTicks"
data PPerformanceEnable = PPerformanceEnable
  {
    -- | Time domain to use for collecting and reporting duration metrics.
    PPerformanceEnable -> Maybe PPerformanceEnableTimeDomain
pPerformanceEnableTimeDomain :: Maybe PPerformanceEnableTimeDomain
  }
  deriving (PPerformanceEnable -> PPerformanceEnable -> Bool
(PPerformanceEnable -> PPerformanceEnable -> Bool)
-> (PPerformanceEnable -> PPerformanceEnable -> Bool)
-> Eq PPerformanceEnable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPerformanceEnable -> PPerformanceEnable -> Bool
$c/= :: PPerformanceEnable -> PPerformanceEnable -> Bool
== :: PPerformanceEnable -> PPerformanceEnable -> Bool
$c== :: PPerformanceEnable -> PPerformanceEnable -> Bool
Eq, Int -> PPerformanceEnable -> ShowS
[PPerformanceEnable] -> ShowS
PPerformanceEnable -> String
(Int -> PPerformanceEnable -> ShowS)
-> (PPerformanceEnable -> String)
-> ([PPerformanceEnable] -> ShowS)
-> Show PPerformanceEnable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPerformanceEnable] -> ShowS
$cshowList :: [PPerformanceEnable] -> ShowS
show :: PPerformanceEnable -> String
$cshow :: PPerformanceEnable -> String
showsPrec :: Int -> PPerformanceEnable -> ShowS
$cshowsPrec :: Int -> PPerformanceEnable -> ShowS
Show)
pPerformanceEnable
  :: PPerformanceEnable
pPerformanceEnable :: PPerformanceEnable
pPerformanceEnable
  = Maybe PPerformanceEnableTimeDomain -> PPerformanceEnable
PPerformanceEnable
    Maybe PPerformanceEnableTimeDomain
forall a. Maybe a
Nothing
instance ToJSON PPerformanceEnable where
  toJSON :: PPerformanceEnable -> Value
toJSON PPerformanceEnable
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
"timeDomain" Text -> PPerformanceEnableTimeDomain -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..=) (PPerformanceEnableTimeDomain -> Pair)
-> Maybe PPerformanceEnableTimeDomain -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PPerformanceEnable -> Maybe PPerformanceEnableTimeDomain
pPerformanceEnableTimeDomain PPerformanceEnable
p)
    ]
instance Command PPerformanceEnable where
  type CommandResponse PPerformanceEnable = ()
  commandName :: Proxy PPerformanceEnable -> String
commandName Proxy PPerformanceEnable
_ = String
"Performance.enable"
  fromJSON :: Proxy PPerformanceEnable
-> Value -> Result (CommandResponse PPerformanceEnable)
fromJSON = Result () -> Value -> Result ()
forall a b. a -> b -> a
const (Result () -> Value -> Result ())
-> (Proxy PPerformanceEnable -> Result ())
-> Proxy PPerformanceEnable
-> Value
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result ()
forall a. a -> Result a
A.Success (() -> Result ())
-> (Proxy PPerformanceEnable -> ())
-> Proxy PPerformanceEnable
-> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Proxy PPerformanceEnable -> ()
forall a b. a -> b -> a
const ()

-- | Retrieve current values of run-time metrics.

-- | Parameters of the 'Performance.getMetrics' command.
data PPerformanceGetMetrics = PPerformanceGetMetrics
  deriving (PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool
(PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool)
-> (PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool)
-> Eq PPerformanceGetMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool
$c/= :: PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool
== :: PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool
$c== :: PPerformanceGetMetrics -> PPerformanceGetMetrics -> Bool
Eq, Int -> PPerformanceGetMetrics -> ShowS
[PPerformanceGetMetrics] -> ShowS
PPerformanceGetMetrics -> String
(Int -> PPerformanceGetMetrics -> ShowS)
-> (PPerformanceGetMetrics -> String)
-> ([PPerformanceGetMetrics] -> ShowS)
-> Show PPerformanceGetMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPerformanceGetMetrics] -> ShowS
$cshowList :: [PPerformanceGetMetrics] -> ShowS
show :: PPerformanceGetMetrics -> String
$cshow :: PPerformanceGetMetrics -> String
showsPrec :: Int -> PPerformanceGetMetrics -> ShowS
$cshowsPrec :: Int -> PPerformanceGetMetrics -> ShowS
Show)
pPerformanceGetMetrics
  :: PPerformanceGetMetrics
pPerformanceGetMetrics :: PPerformanceGetMetrics
pPerformanceGetMetrics
  = PPerformanceGetMetrics
PPerformanceGetMetrics
instance ToJSON PPerformanceGetMetrics where
  toJSON :: PPerformanceGetMetrics -> Value
toJSON PPerformanceGetMetrics
_ = Value
A.Null
data PerformanceGetMetrics = PerformanceGetMetrics
  {
    -- | Current values for run-time metrics.
    PerformanceGetMetrics -> [PerformanceMetric]
performanceGetMetricsMetrics :: [PerformanceMetric]
  }
  deriving (PerformanceGetMetrics -> PerformanceGetMetrics -> Bool
(PerformanceGetMetrics -> PerformanceGetMetrics -> Bool)
-> (PerformanceGetMetrics -> PerformanceGetMetrics -> Bool)
-> Eq PerformanceGetMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceGetMetrics -> PerformanceGetMetrics -> Bool
$c/= :: PerformanceGetMetrics -> PerformanceGetMetrics -> Bool
== :: PerformanceGetMetrics -> PerformanceGetMetrics -> Bool
$c== :: PerformanceGetMetrics -> PerformanceGetMetrics -> Bool
Eq, Int -> PerformanceGetMetrics -> ShowS
[PerformanceGetMetrics] -> ShowS
PerformanceGetMetrics -> String
(Int -> PerformanceGetMetrics -> ShowS)
-> (PerformanceGetMetrics -> String)
-> ([PerformanceGetMetrics] -> ShowS)
-> Show PerformanceGetMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceGetMetrics] -> ShowS
$cshowList :: [PerformanceGetMetrics] -> ShowS
show :: PerformanceGetMetrics -> String
$cshow :: PerformanceGetMetrics -> String
showsPrec :: Int -> PerformanceGetMetrics -> ShowS
$cshowsPrec :: Int -> PerformanceGetMetrics -> ShowS
Show)
instance FromJSON PerformanceGetMetrics where
  parseJSON :: Value -> Parser PerformanceGetMetrics
parseJSON = String
-> (Object -> Parser PerformanceGetMetrics)
-> Value
-> Parser PerformanceGetMetrics
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PerformanceGetMetrics" ((Object -> Parser PerformanceGetMetrics)
 -> Value -> Parser PerformanceGetMetrics)
-> (Object -> Parser PerformanceGetMetrics)
-> Value
-> Parser PerformanceGetMetrics
forall a b. (a -> b) -> a -> b
$ \Object
o -> [PerformanceMetric] -> PerformanceGetMetrics
PerformanceGetMetrics
    ([PerformanceMetric] -> PerformanceGetMetrics)
-> Parser [PerformanceMetric] -> Parser PerformanceGetMetrics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [PerformanceMetric]
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"metrics"
instance Command PPerformanceGetMetrics where
  type CommandResponse PPerformanceGetMetrics = PerformanceGetMetrics
  commandName :: Proxy PPerformanceGetMetrics -> String
commandName Proxy PPerformanceGetMetrics
_ = String
"Performance.getMetrics"