{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-- | A module for defining metrics that can be monitored.
--
-- Metrics are used to monitor program behavior and performance. All
-- metrics have
--
--  * a name, and
--
--  * a way to get the metric's current value.
--
-- This module provides a way to register metrics in a global \"metric
-- store\". The store can then be used to get a snapshot of all
-- metrics. The store also serves as a central place to keep track of
-- all the program's metrics, both user and library defined.
--
-- Here's an example of creating a single counter, used to count the
-- number of request served by a web server:
--
-- > import System.Metrics
-- > import qualified System.Metrics.Counter as Counter
-- >
-- > main = do
-- >     store <- newStore
-- >     requests <- createCounter "myapp.request_count" store
-- >     -- Every time we receive a request:
-- >     Counter.inc requests
--
-- This module also provides a way to register a number of predefined
-- metrics that are useful in most applications. See e.g.
-- 'registerGcMetrics'.
module System.Metrics
    (
      -- * Naming metrics
      -- $naming

      -- * The metric store
      -- $metric-store
      Store
    , newStore

      -- * Registering metrics
      -- $registering
    , registerCounter
    , registerGauge
    , registerLabel
    , registerDistribution
    , registerGroup

      -- ** Convenience functions
      -- $convenience
    , createCounter
    , createGauge
    , createLabel
    , createDistribution

      -- ** Predefined metrics
      -- $predefined
    , registerGcMetrics

      -- * Sampling metrics
      -- $sampling
    , Sample
    , sampleAll
    , Value(..)
    ) where

import Control.Applicative ((<$>))
import Control.Monad (forM)
import Data.Int (Int64)
import qualified Data.IntMap.Strict as IM
import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef)
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified GHC.Stats as Stats
import Prelude hiding (read)

import System.Metrics.Counter (Counter)
import qualified System.Metrics.Counter as Counter
import System.Metrics.Distribution (Distribution)
import qualified System.Metrics.Distribution as Distribution
import System.Metrics.Gauge (Gauge)
import qualified System.Metrics.Gauge as Gauge
import System.Metrics.Label (Label)
import qualified System.Metrics.Label as Label

-- $naming
-- Compound metric names should be separated using underscores.
-- Example: @request_count@. Periods in the name imply namespacing.
-- Example: @\"myapp.users\"@. Some consumers of metrics will use
-- these namespaces to group metrics in e.g. UIs.
--
-- Libraries and frameworks that want to register their own metrics
-- should prefix them with a namespace, to avoid collision with
-- user-defined metrics and metrics defined by other libraries. For
-- example, the Snap web framework could prefix all its metrics with
-- @\"snap.\"@.
--
-- It's customary to suffix the metric name with a short string
-- explaining the metric's type e.g. using @\"_ms\"@ to denote
-- milliseconds.

------------------------------------------------------------------------
-- * The metric store

-- $metric-store
-- The metric store is a shared store of metrics. It allows several
-- disjoint components (e.g. libraries) to contribute to the set of
-- metrics exposed by an application. Libraries that want to provide a
-- set of metrics should defined a register method, in the style of
-- 'registerGcMetrics', that registers the metrics in the 'Store'. The
-- register function should document which metrics are registered and
-- their types (i.e. counter, gauge, label, or distribution).

-- | A mutable metric store.
newtype Store = Store { Store -> IORef State
storeState :: IORef State }

type GroupId = Int

-- | The 'Store' state.
data State = State
     { State -> HashMap Text (Either MetricSampler GroupId)
stateMetrics :: !(M.HashMap T.Text (Either MetricSampler GroupId))
     , State -> IntMap GroupSampler
stateGroups  :: !(IM.IntMap GroupSampler)
     , State -> GroupId
stateNextId  :: {-# UNPACK #-} !Int
     }

data GroupSampler = forall a. GroupSampler
     { ()
groupSampleAction   :: !(IO a)
     , ()
groupSamplerMetrics :: !(M.HashMap T.Text (a -> Value))
     }

-- TODO: Rename this to Metric and Metric to SampledMetric.
data MetricSampler = CounterS !(IO Int64)
                   | GaugeS !(IO Int64)
                   | LabelS !(IO T.Text)
                   | DistributionS !(IO Distribution.Stats)

-- | Create a new, empty metric store.
newStore :: IO Store
newStore :: IO Store
newStore = do
    IORef State
state <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef (State -> IO (IORef State)) -> State -> IO (IORef State)
forall a b. (a -> b) -> a -> b
$ HashMap Text (Either MetricSampler GroupId)
-> IntMap GroupSampler -> GroupId -> State
State HashMap Text (Either MetricSampler GroupId)
forall k v. HashMap k v
M.empty IntMap GroupSampler
forall a. IntMap a
IM.empty GroupId
0
    Store -> IO Store
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Store -> IO Store) -> Store -> IO Store
forall a b. (a -> b) -> a -> b
$ IORef State -> Store
Store IORef State
state

------------------------------------------------------------------------
-- * Registering metrics

-- $registering
-- Before metrics can be sampled they need to be registered with the
-- metric store. The same metric name can only be used once. Passing a
-- metric name that has already been used to one of the register
-- function is an 'error'.

-- | Register a non-negative, monotonically increasing, integer-valued
-- metric. The provided action to read the value must be thread-safe.
-- Also see 'createCounter'.
registerCounter :: T.Text    -- ^ Counter name
                -> IO Int64  -- ^ Action to read the current metric value
                -> Store     -- ^ Metric store
                -> IO ()
registerCounter :: Text -> IO RtsTime -> Store -> IO ()
registerCounter Text
name IO RtsTime
sample Store
store =
    Text -> MetricSampler -> Store -> IO ()
register Text
name (IO RtsTime -> MetricSampler
CounterS IO RtsTime
sample) Store
store

-- | Register an integer-valued metric. The provided action to read
-- the value must be thread-safe. Also see 'createGauge'.
registerGauge :: T.Text    -- ^ Gauge name
              -> IO Int64  -- ^ Action to read the current metric value
              -> Store     -- ^ Metric store
              -> IO ()
registerGauge :: Text -> IO RtsTime -> Store -> IO ()
registerGauge Text
name IO RtsTime
sample Store
store =
    Text -> MetricSampler -> Store -> IO ()
register Text
name (IO RtsTime -> MetricSampler
GaugeS IO RtsTime
sample) Store
store

-- | Register a text metric. The provided action to read the value
-- must be thread-safe. Also see 'createLabel'.
registerLabel :: T.Text     -- ^ Label name
              -> IO T.Text  -- ^ Action to read the current metric value
              -> Store      -- ^ Metric store
              -> IO ()
registerLabel :: Text -> IO Text -> Store -> IO ()
registerLabel Text
name IO Text
sample Store
store =
    Text -> MetricSampler -> Store -> IO ()
register Text
name (IO Text -> MetricSampler
LabelS IO Text
sample) Store
store

-- | Register a distribution metric. The provided action to read the
-- value must be thread-safe. Also see 'createDistribution'.
registerDistribution
    :: T.Text                 -- ^ Distribution name
    -> IO Distribution.Stats  -- ^ Action to read the current metric
                              -- value
    -> Store                  -- ^ Metric store
    -> IO ()
registerDistribution :: Text -> IO Stats -> Store -> IO ()
registerDistribution Text
name IO Stats
sample Store
store =
    Text -> MetricSampler -> Store -> IO ()
register Text
name (IO Stats -> MetricSampler
DistributionS IO Stats
sample) Store
store

register :: T.Text
         -> MetricSampler
         -> Store
         -> IO ()
register :: Text -> MetricSampler -> Store -> IO ()
register Text
name MetricSampler
sample Store
store = do
    IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (Store -> IORef State
storeState Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ state :: State
state@State{GroupId
IntMap GroupSampler
HashMap Text (Either MetricSampler GroupId)
stateMetrics :: State -> HashMap Text (Either MetricSampler GroupId)
stateGroups :: State -> IntMap GroupSampler
stateNextId :: State -> GroupId
stateMetrics :: HashMap Text (Either MetricSampler GroupId)
stateGroups :: IntMap GroupSampler
stateNextId :: GroupId
..} ->
        if Text -> HashMap Text (Either MetricSampler GroupId) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
M.member Text
name HashMap Text (Either MetricSampler GroupId)
stateMetrics
            then Text -> (State, ())
forall a. Text -> a
alreadyInUseError Text
name
            else let !state' :: State
state' = State
state {
                               stateMetrics = M.insert name
                                              (Left sample)
                                              stateMetrics
                             }
                     in (State
state', ())

-- | Raise an exception indicating that the metric name is already in
-- use.
alreadyInUseError :: T.Text -> a
alreadyInUseError :: forall a. Text -> a
alreadyInUseError Text
name =
    [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"The name \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\" is already taken " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
    [Char]
"by a metric."

-- | Register an action that will be executed any time one of the
-- metrics computed from the value it returns needs to be sampled.
--
-- When one or more of the metrics listed in the first argument needs
-- to be sampled, the action is executed and the provided getter
-- functions will be used to extract the metric(s) from the action's
-- return value.
--
-- The registered action might be called from a different thread and
-- therefore needs to be thread-safe.
--
-- This function allows you to sample groups of metrics together. This
-- is useful if
--
-- * you need a consistent view of several metric or
--
-- * sampling the metrics together is more efficient.
--
-- For example, sampling GC statistics needs to be done atomically or
-- a GC might strike in the middle of sampling, rendering the values
-- incoherent. Sampling GC statistics is also more efficient if done
-- in \"bulk\", as the run-time system provides a function to sample all
-- GC statistics at once.
--
-- Note that sampling of the metrics is only atomic if the provided
-- action computes @a@ atomically (e.g. if @a@ is a record, the action
-- needs to compute its fields atomically if the sampling is to be
-- atomic.)
--
-- Example usage:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import qualified Data.HashMap.Strict as M
-- > import GHC.Stats
-- > import System.Metrics
-- >
-- > main = do
-- >     store <- newStore
-- >     let metrics =
-- >             [ ("num_gcs", Counter . numGcs)
-- >             , ("max_bytes_used", Gauge . maxBytesUsed)
-- >             ]
-- >     registerGroup (M.fromList metrics) getGCStats store
registerGroup
    :: M.HashMap T.Text
       (a -> Value)  -- ^ Metric names and getter functions.
    -> IO a          -- ^ Action to sample the metric group
    -> Store         -- ^ Metric store
    -> IO ()
registerGroup :: forall a. HashMap Text (a -> Value) -> IO a -> Store -> IO ()
registerGroup HashMap Text (a -> Value)
getters IO a
cb Store
store = do
    IORef State -> (State -> (State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (Store -> IORef State
storeState Store
store) ((State -> (State, ())) -> IO ())
-> (State -> (State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ State{GroupId
IntMap GroupSampler
HashMap Text (Either MetricSampler GroupId)
stateMetrics :: State -> HashMap Text (Either MetricSampler GroupId)
stateGroups :: State -> IntMap GroupSampler
stateNextId :: State -> GroupId
stateMetrics :: HashMap Text (Either MetricSampler GroupId)
stateGroups :: IntMap GroupSampler
stateNextId :: GroupId
..} ->
        let !state' :: State
state' = State
                { stateMetrics :: HashMap Text (Either MetricSampler GroupId)
stateMetrics = (HashMap Text (Either MetricSampler GroupId)
 -> Text
 -> (a -> Value)
 -> HashMap Text (Either MetricSampler GroupId))
-> HashMap Text (Either MetricSampler GroupId)
-> HashMap Text (a -> Value)
-> HashMap Text (Either MetricSampler GroupId)
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
M.foldlWithKey' (GroupId
-> HashMap Text (Either MetricSampler GroupId)
-> Text
-> (a -> Value)
-> HashMap Text (Either MetricSampler GroupId)
forall {b} {a} {p}.
b
-> HashMap Text (Either a b)
-> Text
-> p
-> HashMap Text (Either a b)
register_ GroupId
stateNextId)
                                 HashMap Text (Either MetricSampler GroupId)
stateMetrics HashMap Text (a -> Value)
getters
                , stateGroups :: IntMap GroupSampler
stateGroups  = GroupId
-> GroupSampler -> IntMap GroupSampler -> IntMap GroupSampler
forall a. GroupId -> a -> IntMap a -> IntMap a
IM.insert GroupId
stateNextId
                                 (IO a -> HashMap Text (a -> Value) -> GroupSampler
forall a. IO a -> HashMap Text (a -> Value) -> GroupSampler
GroupSampler IO a
cb HashMap Text (a -> Value)
getters)
                                 IntMap GroupSampler
stateGroups
                , stateNextId :: GroupId
stateNextId  = GroupId
stateNextId GroupId -> GroupId -> GroupId
forall a. Num a => a -> a -> a
+ GroupId
1
                }
       in (State
state', ())
  where
    register_ :: b
-> HashMap Text (Either a b)
-> Text
-> p
-> HashMap Text (Either a b)
register_ b
groupId HashMap Text (Either a b)
metrics Text
name p
_ = case Text -> HashMap Text (Either a b) -> Maybe (Either a b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
name HashMap Text (Either a b)
metrics of
        Maybe (Either a b)
Nothing -> Text
-> Either a b
-> HashMap Text (Either a b)
-> HashMap Text (Either a b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name (b -> Either a b
forall a b. b -> Either a b
Right b
groupId) HashMap Text (Either a b)
metrics
        Just Either a b
_  -> Text -> HashMap Text (Either a b)
forall a. Text -> a
alreadyInUseError Text
name

------------------------------------------------------------------------
-- ** Convenience functions

-- $convenience
-- These functions combined the creation of a mutable reference (e.g.
-- a 'Counter') with registering that reference in the store in one
-- convenient function.

-- | Create and register a zero-initialized counter.
createCounter :: T.Text  -- ^ Counter name
              -> Store   -- ^ Metric store
              -> IO Counter
createCounter :: Text -> Store -> IO Counter
createCounter Text
name Store
store = do
    Counter
counter <- IO Counter
Counter.new
    Text -> IO RtsTime -> Store -> IO ()
registerCounter Text
name (Counter -> IO RtsTime
Counter.read Counter
counter) Store
store
    Counter -> IO Counter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Counter
counter

-- | Create and register a zero-initialized gauge.
createGauge :: T.Text  -- ^ Gauge name
            -> Store   -- ^ Metric store
            -> IO Gauge
createGauge :: Text -> Store -> IO Gauge
createGauge Text
name Store
store = do
    Gauge
gauge <- IO Gauge
Gauge.new
    Text -> IO RtsTime -> Store -> IO ()
registerGauge Text
name (Gauge -> IO RtsTime
Gauge.read Gauge
gauge) Store
store
    Gauge -> IO Gauge
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Gauge
gauge

-- | Create and register an empty label.
createLabel :: T.Text  -- ^ Label name
            -> Store   -- ^ Metric store
            -> IO Label
createLabel :: Text -> Store -> IO Label
createLabel Text
name Store
store = do
    Label
label <- IO Label
Label.new
    Text -> IO Text -> Store -> IO ()
registerLabel Text
name (Label -> IO Text
Label.read Label
label) Store
store
    Label -> IO Label
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Label
label

-- | Create and register an event tracker.
createDistribution :: T.Text  -- ^ Distribution name
                   -> Store   -- ^ Metric store
                   -> IO Distribution
createDistribution :: Text -> Store -> IO Distribution
createDistribution Text
name Store
store = do
    Distribution
event <- IO Distribution
Distribution.new
    Text -> IO Stats -> Store -> IO ()
registerDistribution Text
name (Distribution -> IO Stats
Distribution.read Distribution
event) Store
store
    Distribution -> IO Distribution
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Distribution
event

------------------------------------------------------------------------
-- * Predefined metrics

-- $predefined
-- This library provides a number of pre-defined metrics that can
-- easily be added to a metrics store by calling their register
-- function.

-- | Register a number of metrics related to garbage collector
-- behavior.
--
-- To enable GC statistics collection, either run your program with
--
-- > +RTS -T
--
-- or compile it with
--
-- > -with-rtsopts=-T
--
-- The runtime overhead of @-T@ is very small so it's safe to always
-- leave it enabled.
--
-- Registered counters:
--
-- [@rts.gc.bytes_allocated@] Total number of bytes allocated
--
-- [@rts.gc.num_gcs@] Number of garbage collections performed
--
-- [@rts.gc.num_bytes_usage_samples@] Number of byte usage samples taken
--
-- [@rts.gc.cumulative_bytes_used@] Sum of all byte usage samples, can be
-- used with @numByteUsageSamples@ to calculate averages with
-- arbitrary weighting (if you are sampling this record multiple
-- times).
--
-- [@rts.gc.bytes_copied@] Number of bytes copied during GC
--
-- [@rts.gc.init_cpu_ms@] CPU time used by the init phase, in
-- milliseconds. GHC 8.6+ only.
--
-- [@rts.gc.init_wall_ms@] Wall clock time spent running the init
-- phase, in milliseconds. GHC 8.6+ only.
--
-- [@rts.gc.mutator_cpu_ms@] CPU time spent running mutator threads,
-- in milliseconds. This does not include any profiling overhead or
-- initialization.
--
-- [@rts.gc.mutator_wall_ms@] Wall clock time spent running mutator
-- threads, in milliseconds. This does not include initialization.
--
-- [@rts.gc.gc_cpu_ms@] CPU time spent running GC, in milliseconds.
--
-- [@rts.gc.gc_wall_ms@] Wall clock time spent running GC, in
-- milliseconds.
--
-- [@rts.gc.cpu_ms@] Total CPU time elapsed since program start, in
-- milliseconds.
--
-- [@rts.gc.wall_ms@] Total wall clock time elapsed since start, in
-- milliseconds.
--
-- Registered gauges:
--
-- [@rts.gc.max_bytes_used@] Maximum number of live bytes seen so far
--
-- [@rts.gc.max_large_bytes_used@] Maximum number of live bytes seen so far just in large ojects
--
-- [@rts.gc.max_compact_bytes_used@] Maximum number of live bytes seen so far just in compact regions
--
-- [@rts.gc.current_bytes_used@] Current number of live bytes
--
-- [@rts.gc.current_bytes_slop@] Current number of bytes lost to slop
--
-- [@rts.gc.max_bytes_slop@] Maximum number of bytes lost to slop at any one time so far
--
-- [@rts.gc.peak_megabytes_allocated@] Maximum number of megabytes allocated
--
-- [@rts.gc.par_tot_bytes_copied@] Number of bytes copied during GC, minus
-- space held by mutable lists held by the capabilities.  Can be used
-- with 'parMaxBytesCopied' to determine how well parallel GC utilized
-- all cores.
--
-- [@rts.gc.par_avg_bytes_copied@] Deprecated alias for
-- @par_tot_bytes_copied@.
--
-- [@rts.gc.par_max_bytes_copied@] Sum of number of bytes copied each GC by
-- the most active GC thread each GC. The ratio of
-- @par_tot_bytes_copied@ divided by @par_max_bytes_copied@ approaches
-- 1 for a maximally sequential run and approaches the number of
-- threads (set by the RTS flag @-N@) for a maximally parallel run. Deprecated by
-- GHC in later versions.
--
-- [@rts.gc.par_balanced_bytes_copied@] Sum of balanced data copied by all threads in parallel GC, across all parallel GCs.
--
-- [@rts.gc.nm.sync_cpu_ms@] The total CPU time used during the post-mark pause phase of the concurrent nonmoving GC.
--
-- [@rts.gc.nm.sync_elapsed_ms@] The total time elapsed during the post-mark pause phase of the concurrent nonmoving GC.
--
-- [@rts.gc.nm.sync_max_elapsed_ms@] The maximum elapsed length of any post-mark pause phase of the concurrent nonmoving GC.
--
-- [@rts.gc.nm.cpu_ms@] The total CPU time used by the nonmoving GC.
--
-- [@rts.gc.nm.elapsed_ms@] The total time elapsed during which there is a nonmoving GC active.
--
-- [@rts.gc.nm.max_elapsed_ms@] The maximum time elapsed during any nonmoving GC cycle.
registerGcMetrics :: Store -> IO ()
registerGcMetrics :: Store -> IO ()
registerGcMetrics =
    HashMap Text (RTSStats -> Value) -> IO RTSStats -> Store -> IO ()
forall a. HashMap Text (a -> Value) -> IO a -> Store -> IO ()
registerGroup
#if MIN_VERSION_base(4,10,0)
    ([(Text, RTSStats -> Value)] -> HashMap Text (RTSStats -> Value)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList
     [ (Text
"rts.gc.bytes_allocated"          , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.allocated_bytes)
     , (Text
"rts.gc.num_gcs"                  , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> RtsTime) -> (RTSStats -> Word32) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word32
Stats.gcs)
     , (Text
"rts.gc.num_bytes_usage_samples"  , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> RtsTime) -> (RTSStats -> Word32) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word32
Stats.major_gcs)
     , (Text
"rts.gc.cumulative_bytes_used"    , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.cumulative_live_bytes)
     , (Text
"rts.gc.bytes_copied"             , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.copied_bytes)
#if MIN_VERSION_base(4,12,0)
     , (Text
"rts.gc.init_cpu_ms"              , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.init_cpu_ns)
     , (Text
"rts.gc.init_wall_ms"             , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.init_elapsed_ns)
#endif
     , (Text
"rts.gc.mutator_cpu_ms"           , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.mutator_cpu_ns)
     , (Text
"rts.gc.mutator_wall_ms"          , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.mutator_elapsed_ns)
     , (Text
"rts.gc.gc_cpu_ms"                , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.gc_cpu_ns)
     , (Text
"rts.gc.gc_wall_ms"               , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.gc_elapsed_ns)
     , (Text
"rts.gc.cpu_ms"                   , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.cpu_ns)
     , (Text
"rts.gc.wall_ms"                  , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.elapsed_ns)
     , (Text
"rts.gc.max_bytes_used"           , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_live_bytes)
     , (Text
"rts.gc.max_large_bytes_used"     , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_large_objects_bytes)
     , (Text
"rts.gc.max_compact_bytes_used"   , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_compact_bytes)
     , (Text
"rts.gc.current_bytes_used"       , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCDetails -> Word64
Stats.gcdetails_live_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
Stats.gc)
     , (Text
"rts.gc.current_bytes_slop"       , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCDetails -> Word64
Stats.gcdetails_slop_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
Stats.gc)
     , (Text
"rts.gc.max_bytes_slop"           , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_slop_bytes)
     , (Text
"rts.gc.peak_megabytes_allocated" , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` (Word64
1024Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
*Word64
1024)) (Word64 -> Word64) -> (RTSStats -> Word64) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_mem_in_use_bytes)
     , (Text
"rts.gc.par_tot_bytes_copied"     , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.par_copied_bytes)
     , (Text
"rts.gc.par_avg_bytes_copied"     , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.par_copied_bytes)
     , (Text
"rts.gc.par_max_bytes_copied"     , RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.cumulative_par_max_copied_bytes)
#if MIN_VERSION_base(4,11,0)
     , (Text
"rts.gc.par_balanced_bytes_copied", RtsTime -> Value
Gauge (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RtsTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RtsTime) -> (RTSStats -> Word64) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.cumulative_par_balanced_copied_bytes)
#if MIN_VERSION_base(4,15,0)
     , (Text
"rts.gc.nm.sync_cpu_ms"           , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.nonmoving_gc_sync_cpu_ns)
     , (Text
"rts.gc.nm.sync_elapsed_ms"       , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.nonmoving_gc_sync_elapsed_ns)
     , (Text
"rts.gc.nm.sync_max_elapsed_ms"   , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.nonmoving_gc_sync_max_elapsed_ns)
     , (Text
"rts.gc.nm.cpu_ms"                , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.nonmoving_gc_cpu_ns)
     , (Text
"rts.gc.nm.elapsed_ms"            , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.nonmoving_gc_elapsed_ns)
     , (Text
"rts.gc.nm.max_elapsed_ms"        , RtsTime -> Value
Counter (RtsTime -> Value) -> (RTSStats -> RtsTime) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> RtsTime
nsToMs (RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
Stats.nonmoving_gc_max_elapsed_ns)
# endif
# endif
     ])
    IO RTSStats
getRTSStats
    where
    -- | Convert nanoseconds to milliseconds.
    nsToMs :: Int64 -> Int64
    nsToMs :: RtsTime -> RtsTime
nsToMs RtsTime
s = Double -> RtsTime
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (RtsTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac RtsTime
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1000000.0 :: Double))
#else
    (M.fromList
     [ ("rts.gc.bytes_allocated"          , Counter . Stats.bytesAllocated)
     , ("rts.gc.num_gcs"                  , Counter . Stats.numGcs)
     , ("rts.gc.num_bytes_usage_samples"  , Counter . Stats.numByteUsageSamples)
     , ("rts.gc.cumulative_bytes_used"    , Counter . Stats.cumulativeBytesUsed)
     , ("rts.gc.bytes_copied"             , Counter . Stats.bytesCopied)
     , ("rts.gc.mutator_cpu_ms"           , Counter . sToMs . Stats.mutatorCpuSeconds)
     , ("rts.gc.mutator_wall_ms"          , Counter . sToMs . Stats.mutatorWallSeconds)
     , ("rts.gc.gc_cpu_ms"                , Counter . sToMs . Stats.gcCpuSeconds)
     , ("rts.gc.gc_wall_ms"               , Counter . sToMs . Stats.gcWallSeconds)
     , ("rts.gc.cpu_ms"                   , Counter . sToMs . Stats.cpuSeconds)
     , ("rts.gc.wall_ms"                  , Counter . sToMs . Stats.wallSeconds)
     , ("rts.gc.max_bytes_used"           , Gauge . Stats.maxBytesUsed)
     , ("rts.gc.current_bytes_used"       , Gauge . Stats.currentBytesUsed)
     , ("rts.gc.current_bytes_slop"       , Gauge . Stats.currentBytesSlop)
     , ("rts.gc.max_bytes_slop"           , Gauge . Stats.maxBytesSlop)
     , ("rts.gc.peak_megabytes_allocated" , Gauge . Stats.peakMegabytesAllocated)
     , ("rts.gc.par_tot_bytes_copied"     , Gauge . gcParTotBytesCopied)
     , ("rts.gc.par_avg_bytes_copied"     , Gauge . gcParTotBytesCopied)
     , ("rts.gc.par_max_bytes_copied"     , Gauge . Stats.parMaxBytesCopied)
     ])
    getGcStats
    where
    -- | Convert seconds to milliseconds.
    sToMs :: Double -> Int64
    sToMs s = round (s * 1000.0)
#endif

#if MIN_VERSION_base(4,10,0)
-- | Get RTS statistics.
getRTSStats :: IO Stats.RTSStats
getRTSStats :: IO RTSStats
getRTSStats = do
    Bool
enabled <- IO Bool
Stats.getRTSStatsEnabled
    if Bool
enabled
        then IO RTSStats
Stats.getRTSStats
        else RTSStats -> IO RTSStats
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RTSStats
emptyRTSStats

-- | Empty RTS statistics, as if the application hasn't started yet.
emptyRTSStats :: Stats.RTSStats
emptyRTSStats :: RTSStats
emptyRTSStats = Stats.RTSStats
    { gcs :: Word32
gcs                                  = Word32
0
    , major_gcs :: Word32
major_gcs                            = Word32
0
    , allocated_bytes :: Word64
allocated_bytes                      = Word64
0
    , max_live_bytes :: Word64
max_live_bytes                       = Word64
0
    , max_large_objects_bytes :: Word64
max_large_objects_bytes              = Word64
0
    , max_compact_bytes :: Word64
max_compact_bytes                    = Word64
0
    , max_slop_bytes :: Word64
max_slop_bytes                       = Word64
0
    , max_mem_in_use_bytes :: Word64
max_mem_in_use_bytes                 = Word64
0
    , cumulative_live_bytes :: Word64
cumulative_live_bytes                = Word64
0
    , copied_bytes :: Word64
copied_bytes                         = Word64
0
    , par_copied_bytes :: Word64
par_copied_bytes                     = Word64
0
    , cumulative_par_max_copied_bytes :: Word64
cumulative_par_max_copied_bytes      = Word64
0
# if MIN_VERSION_base(4,11,0)
    , cumulative_par_balanced_copied_bytes :: Word64
cumulative_par_balanced_copied_bytes = Word64
0
# if MIN_VERSION_base(4,12,0)
    , init_cpu_ns :: RtsTime
init_cpu_ns                          = RtsTime
0
    , init_elapsed_ns :: RtsTime
init_elapsed_ns                      = RtsTime
0
# if MIN_VERSION_base(4,15,0)
    , nonmoving_gc_sync_cpu_ns :: RtsTime
nonmoving_gc_sync_cpu_ns             = RtsTime
0
    , nonmoving_gc_sync_elapsed_ns :: RtsTime
nonmoving_gc_sync_elapsed_ns         = RtsTime
0
    , nonmoving_gc_sync_max_elapsed_ns :: RtsTime
nonmoving_gc_sync_max_elapsed_ns     = RtsTime
0
    , nonmoving_gc_cpu_ns :: RtsTime
nonmoving_gc_cpu_ns                  = RtsTime
0
    , nonmoving_gc_elapsed_ns :: RtsTime
nonmoving_gc_elapsed_ns              = RtsTime
0
    , nonmoving_gc_max_elapsed_ns :: RtsTime
nonmoving_gc_max_elapsed_ns          = RtsTime
0
# endif
# endif
# endif
    , mutator_cpu_ns :: RtsTime
mutator_cpu_ns                       = RtsTime
0
    , mutator_elapsed_ns :: RtsTime
mutator_elapsed_ns                   = RtsTime
0
    , gc_cpu_ns :: RtsTime
gc_cpu_ns                            = RtsTime
0
    , gc_elapsed_ns :: RtsTime
gc_elapsed_ns                        = RtsTime
0
    , cpu_ns :: RtsTime
cpu_ns                               = RtsTime
0
    , elapsed_ns :: RtsTime
elapsed_ns                           = RtsTime
0
    , gc :: GCDetails
gc                                   = GCDetails
emptyGCDetails
    }

emptyGCDetails :: Stats.GCDetails
emptyGCDetails :: GCDetails
emptyGCDetails = Stats.GCDetails
    { gcdetails_gen :: Word32
gcdetails_gen                       = Word32
0
    , gcdetails_threads :: Word32
gcdetails_threads                   = Word32
0
    , gcdetails_allocated_bytes :: Word64
gcdetails_allocated_bytes           = Word64
0
    , gcdetails_live_bytes :: Word64
gcdetails_live_bytes                = Word64
0
    , gcdetails_large_objects_bytes :: Word64
gcdetails_large_objects_bytes       = Word64
0
    , gcdetails_compact_bytes :: Word64
gcdetails_compact_bytes             = Word64
0
    , gcdetails_slop_bytes :: Word64
gcdetails_slop_bytes                = Word64
0
    , gcdetails_mem_in_use_bytes :: Word64
gcdetails_mem_in_use_bytes          = Word64
0
    , gcdetails_copied_bytes :: Word64
gcdetails_copied_bytes              = Word64
0
    , gcdetails_par_max_copied_bytes :: Word64
gcdetails_par_max_copied_bytes      = Word64
0
# if MIN_VERSION_base(4,11,0)
    , gcdetails_par_balanced_copied_bytes :: Word64
gcdetails_par_balanced_copied_bytes = Word64
0
# if MIN_VERSION_base(4,15,0)
    , gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns  = RtsTime
0
    , gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns = RtsTime
0
# if MIN_VERSION_base(4,18,0)
    , gcdetails_block_fragmentation_bytes :: Word64
gcdetails_block_fragmentation_bytes = Word64
0
# endif
# endif
# endif
    , gcdetails_sync_elapsed_ns :: RtsTime
gcdetails_sync_elapsed_ns           = RtsTime
0
    , gcdetails_cpu_ns :: RtsTime
gcdetails_cpu_ns                    = RtsTime
0
    , gcdetails_elapsed_ns :: RtsTime
gcdetails_elapsed_ns                = RtsTime
0
    }
#else
-- | Get GC statistics.
getGcStats :: IO Stats.GCStats
# if MIN_VERSION_base(4,6,0)
getGcStats = do
    enabled <- Stats.getGCStatsEnabled
    if enabled
        then Stats.getGCStats
        else return emptyGCStats

-- | Empty GC statistics, as if the application hasn't started yet.
emptyGCStats :: Stats.GCStats
emptyGCStats = Stats.GCStats
    { bytesAllocated         = 0
    , numGcs                 = 0
    , maxBytesUsed           = 0
    , numByteUsageSamples    = 0
    , cumulativeBytesUsed    = 0
    , bytesCopied            = 0
    , currentBytesUsed       = 0
    , currentBytesSlop       = 0
    , maxBytesSlop           = 0
    , peakMegabytesAllocated = 0
    , mutatorCpuSeconds      = 0
    , mutatorWallSeconds     = 0
    , gcCpuSeconds           = 0
    , gcWallSeconds          = 0
    , cpuSeconds             = 0
    , wallSeconds            = 0
    , parTotBytesCopied      = 0
    , parMaxBytesCopied      = 0
    }
# else
getGcStats = Stats.getGCStats
# endif

-- | Helper to work around rename in GHC.Stats in base-4.6.
gcParTotBytesCopied :: Stats.GCStats -> Int64
# if MIN_VERSION_base(4,6,0)
gcParTotBytesCopied = Stats.parTotBytesCopied
# else
gcParTotBytesCopied = Stats.parAvgBytesCopied
# endif
#endif

------------------------------------------------------------------------
-- * Sampling metrics

-- $sampling
-- The metrics register in the store can be sampled together. Sampling
-- is /not/ atomic. While each metric will be retrieved atomically,
-- the sample is not an atomic snapshot of the system as a whole. See
-- 'registerGroup' for an explanation of how to sample a subset of all
-- metrics atomically.

-- | A sample of some metrics.
type Sample = M.HashMap T.Text Value

-- | Sample all metrics. Sampling is /not/ atomic in the sense that
-- some metrics might have been mutated before they're sampled but
-- after some other metrics have already been sampled.
sampleAll :: Store -> IO Sample
sampleAll :: Store -> IO Sample
sampleAll Store
store = do
    State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef (Store -> IORef State
storeState Store
store)
    let metrics :: HashMap Text (Either MetricSampler GroupId)
metrics = State -> HashMap Text (Either MetricSampler GroupId)
stateMetrics State
state
        groups :: IntMap GroupSampler
groups = State -> IntMap GroupSampler
stateGroups State
state
    [(Text, Value)]
cbSample <- [GroupSampler] -> IO [(Text, Value)]
sampleGroups ([GroupSampler] -> IO [(Text, Value)])
-> [GroupSampler] -> IO [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ IntMap GroupSampler -> [GroupSampler]
forall a. IntMap a -> [a]
IM.elems IntMap GroupSampler
groups
    [(Text, Value)]
sample <- HashMap Text (Either MetricSampler GroupId) -> IO [(Text, Value)]
readAllRefs HashMap Text (Either MetricSampler GroupId)
metrics
    let allSamples :: [(Text, Value)]
allSamples = [(Text, Value)]
sample [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [(Text, Value)]
cbSample
    Sample -> IO Sample
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sample -> IO Sample) -> Sample -> IO Sample
forall a b. (a -> b) -> a -> b
$! [(Text, Value)] -> Sample
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Text, Value)]
allSamples

-- | Sample all metric groups.
sampleGroups :: [GroupSampler] -> IO [(T.Text, Value)]
sampleGroups :: [GroupSampler] -> IO [(Text, Value)]
sampleGroups [GroupSampler]
cbSamplers = [[(Text, Value)]] -> [(Text, Value)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Text, Value)]] -> [(Text, Value)])
-> IO [[(Text, Value)]] -> IO [(Text, Value)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [IO [(Text, Value)]] -> IO [[(Text, Value)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((GroupSampler -> IO [(Text, Value)])
-> [GroupSampler] -> [IO [(Text, Value)]]
forall a b. (a -> b) -> [a] -> [b]
map GroupSampler -> IO [(Text, Value)]
runOne [GroupSampler]
cbSamplers)
  where
    runOne :: GroupSampler -> IO [(T.Text, Value)]
    runOne :: GroupSampler -> IO [(Text, Value)]
runOne GroupSampler{IO a
HashMap Text (a -> Value)
groupSampleAction :: ()
groupSamplerMetrics :: ()
groupSampleAction :: IO a
groupSamplerMetrics :: HashMap Text (a -> Value)
..} = do
        a
a <- IO a
groupSampleAction
        [(Text, Value)] -> IO [(Text, Value)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Value)] -> IO [(Text, Value)])
-> [(Text, Value)] -> IO [(Text, Value)]
forall a b. (a -> b) -> a -> b
$! ((Text, a -> Value) -> (Text, Value))
-> [(Text, a -> Value)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Text
n, a -> Value
f) -> (Text
n, a -> Value
f a
a)) (HashMap Text (a -> Value) -> [(Text, a -> Value)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap Text (a -> Value)
groupSamplerMetrics)

-- | The value of a sampled metric.
data Value = Counter {-# UNPACK #-} !Int64
           | Gauge {-# UNPACK #-} !Int64
           | Label {-# UNPACK #-} !T.Text
           | Distribution !Distribution.Stats
           deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, GroupId -> Value -> [Char] -> [Char]
[Value] -> [Char] -> [Char]
Value -> [Char]
(GroupId -> Value -> [Char] -> [Char])
-> (Value -> [Char]) -> ([Value] -> [Char] -> [Char]) -> Show Value
forall a.
(GroupId -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: GroupId -> Value -> [Char] -> [Char]
showsPrec :: GroupId -> Value -> [Char] -> [Char]
$cshow :: Value -> [Char]
show :: Value -> [Char]
$cshowList :: [Value] -> [Char] -> [Char]
showList :: [Value] -> [Char] -> [Char]
Show)

sampleOne :: MetricSampler -> IO Value
sampleOne :: MetricSampler -> IO Value
sampleOne (CounterS IO RtsTime
m)      = RtsTime -> Value
Counter (RtsTime -> Value) -> IO RtsTime -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RtsTime
m
sampleOne (GaugeS IO RtsTime
m)        = RtsTime -> Value
Gauge (RtsTime -> Value) -> IO RtsTime -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RtsTime
m
sampleOne (LabelS IO Text
m)        = Text -> Value
Label (Text -> Value) -> IO Text -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
m
sampleOne (DistributionS IO Stats
m) = Stats -> Value
Distribution (Stats -> Value) -> IO Stats -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Stats
m

-- | Get a snapshot of all values.  Note that we're not guaranteed to
-- see a consistent snapshot of the whole map.
readAllRefs :: M.HashMap T.Text (Either MetricSampler GroupId)
            -> IO [(T.Text, Value)]
readAllRefs :: HashMap Text (Either MetricSampler GroupId) -> IO [(Text, Value)]
readAllRefs HashMap Text (Either MetricSampler GroupId)
m = do
    [(Text, MetricSampler)]
-> ((Text, MetricSampler) -> IO (Text, Value))
-> IO [(Text, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([(Text
name, MetricSampler
ref) | (Text
name, Left MetricSampler
ref) <- HashMap Text (Either MetricSampler GroupId)
-> [(Text, Either MetricSampler GroupId)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap Text (Either MetricSampler GroupId)
m]) (((Text, MetricSampler) -> IO (Text, Value)) -> IO [(Text, Value)])
-> ((Text, MetricSampler) -> IO (Text, Value))
-> IO [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ \ (Text
name, MetricSampler
ref) -> do
        Value
val <- MetricSampler -> IO Value
sampleOne MetricSampler
ref
        (Text, Value) -> IO (Text, Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Value
val)