{- |
Module      : GHC.Eventlog.Live.Metric
Description : Representation for metrics.
Stability   : experimental
Portability : portable
-}
module GHC.Eventlog.Live.Data.Metric (
  Metric (..),
) where

import GHC.Eventlog.Live.Data.Attribute (Attr)
import GHC.RTS.Events (Timestamp)

{- |
Metrics combine a measurement with a timestamp representing the time of the
measurement, a timestamp representing the earliest possible measurment, and
a list of attributes.
-}
data Metric a = Metric
  { forall a. Metric a -> a
value :: !a
  -- ^ The measurement.
  , forall a. Metric a -> Maybe Timestamp
maybeTimeUnixNano :: !(Maybe Timestamp)
  -- ^ The time at which the measurment was taken.
  , forall a. Metric a -> Maybe Timestamp
maybeStartTimeUnixNano :: !(Maybe Timestamp)
  -- ^ The earliest time at which any measurement could have been taken.
  --   Usually, this represents the start time of a process.
  , forall a. Metric a -> [Attr]
attr :: [Attr]
  -- ^ A list of attributes.
  }
  deriving ((forall a b. (a -> b) -> Metric a -> Metric b)
-> (forall a b. a -> Metric b -> Metric a) -> Functor Metric
forall a b. a -> Metric b -> Metric a
forall a b. (a -> b) -> Metric a -> Metric b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Metric a -> Metric b
fmap :: forall a b. (a -> b) -> Metric a -> Metric b
$c<$ :: forall a b. a -> Metric b -> Metric a
<$ :: forall a b. a -> Metric b -> Metric a
Functor, Int -> Metric a -> ShowS
[Metric a] -> ShowS
Metric a -> String
(Int -> Metric a -> ShowS)
-> (Metric a -> String) -> ([Metric a] -> ShowS) -> Show (Metric a)
forall a. Show a => Int -> Metric a -> ShowS
forall a. Show a => [Metric a] -> ShowS
forall a. Show a => Metric a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Metric a -> ShowS
showsPrec :: Int -> Metric a -> ShowS
$cshow :: forall a. Show a => Metric a -> String
show :: Metric a -> String
$cshowList :: forall a. Show a => [Metric a] -> ShowS
showList :: [Metric a] -> ShowS
Show)