{-# language OverloadedStrings #-}
{-# language CPP #-}
{-# language NumDecimals #-}

-- | This module defines a metrics that exposes statistics from the GHC runtime
-- system ("GHC.Conc", "GHC.Stats").
--
-- To use these metrics, the monitored executable should run with the `+RTS -T`
-- command line flags and the following must be added somewhere near the
-- beginning of the main method:
--
-- >>> register ghcMetrics
module Prometheus.Metric.GHC (
    GHCMetrics
,   ghcMetrics
,   ghcMetricsWithLabels
) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import qualified Data.ByteString.UTF8 as BS
import Data.Text (Text)
import Data.Fixed (Fixed, E9)
#if __GLASGOW_HASKELL__ < 804
import GHC.Conc (numSparks, getNumCapabilities)
import GHC.Stats (GCStats(..), getGCStatsEnabled, getGCStats)
#else
import GHC.Stats (RTSStats(..), GCDetails(..), getRTSStatsEnabled, getRTSStats)
#endif
import qualified GHC.Stats as Stats
import Prometheus


data GHCMetrics = GHCMetrics

ghcMetrics :: Metric GHCMetrics
ghcMetrics :: Metric GHCMetrics
ghcMetrics = LabelPairs -> Metric GHCMetrics
ghcMetricsWithLabels []

ghcMetricsWithLabels :: LabelPairs -> Metric GHCMetrics
ghcMetricsWithLabels :: LabelPairs -> Metric GHCMetrics
ghcMetricsWithLabels LabelPairs
labels = IO (GHCMetrics, IO [SampleGroup]) -> Metric GHCMetrics
forall s. IO (s, IO [SampleGroup]) -> Metric s
Metric (do
  Bool
statsEnabled <-
#if __GLASGOW_HASKELL__ < 804
    getGCStatsEnabled
#else
    IO Bool
getRTSStatsEnabled
#endif
  if Bool
statsEnabled
  then (GHCMetrics, IO [SampleGroup]) -> IO (GHCMetrics, IO [SampleGroup])
forall (m :: * -> *) a. Monad m => a -> m a
return (GHCMetrics
GHCMetrics, do
        RTSStats
stats <-
#if __GLASGOW_HASKELL__ < 804
            getGCStats
#else
            IO RTSStats
getRTSStats
#endif
        [[SampleGroup]] -> [SampleGroup]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SampleGroup]] -> [SampleGroup])
-> IO [[SampleGroup]] -> IO [SampleGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LabelPairs -> RTSStats -> IO [SampleGroup]) -> IO [SampleGroup])
-> [LabelPairs -> RTSStats -> IO [SampleGroup]]
-> IO [[SampleGroup]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\LabelPairs -> RTSStats -> IO [SampleGroup]
f -> LabelPairs -> RTSStats -> IO [SampleGroup]
f LabelPairs
labels RTSStats
stats) [LabelPairs -> RTSStats -> IO [SampleGroup]]
ghcCollectors
    )
  else (GHCMetrics, IO [SampleGroup]) -> IO (GHCMetrics, IO [SampleGroup])
forall (m :: * -> *) a. Monad m => a -> m a
return (GHCMetrics
GHCMetrics, [SampleGroup] -> IO [SampleGroup]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
  )

#if __GLASGOW_HASKELL__ < 804
ghcCollectors :: [LabelPairs -> GCStats -> IO [SampleGroup]]
ghcCollectors = [
        \labelpairs gcstats -> do
          sparkCount <- numSparks
          showCollector
            "ghc_sparks"
            "The number of sparks in the local spark pool."
            GaugeType
            sparkCount
            labelpairs
    ,   \labelpairs gcstats -> do
          numCapabilities <- getNumCapabilities
          showCollector
            "ghc_capabilities"
            "The number of threads that can run truly simultaneously."
            GaugeType
            numCapabilities
            labelpairs
    ,   statsCollector
            "ghc_allocated_bytes_total"
            "Total number of bytes allocated."
            CounterType
            bytesAllocated
    ,   statsCollector
            "ghc_num_gcs"
            "The number of garbage collections performed."
            CounterType
            numGcs
    ,   statsCollector
            "ghc_max_used_bytes"
            "The maximum number of live bytes seen so far."
            GaugeType
            maxBytesUsed
    ,   statsCollector
            "ghc_cumulative_used_bytes_total"
            "The cumulative total bytes used."
            CounterType
            cumulativeBytesUsed
    ,   statsCollector
            "ghc_copied_bytes_total"
            "The number of bytes copied during garbage collection."
            CounterType
            bytesCopied
    ,   statsCollector
            "ghc_current_used_bytes"
            "The number of current live bytes."
            GaugeType
            currentBytesUsed
    ,   statsCollector
            "ghc_current_slop_bytes"
            "The current number of bytes lost to slop."
            GaugeType
            currentBytesSlop
    ,   statsCollector
            "ghc_max_slop_bytes"
            "The maximum number of bytes lost to slop so far."
            GaugeType
            maxBytesSlop
    ,   statsCollector
            "ghc_peak_allocated_megabytes" -- XXX: export as bytes?
            "The maximum number of megabytes allocated."
            GaugeType
            peakMegabytesAllocated
    ,   statsCollector
            "ghc_mutator_cpu_seconds_total"
            "The CPU time spent running mutator threads."
            CounterType
            mutatorCpuSeconds
    ,   statsCollector
            "ghc_mutator_wall_seconds_total"
            "The wall clock time spent running mutator threads."
            CounterType
            mutatorCpuSeconds
    ,   statsCollector
            "ghc_gc_cpu_seconds_total"
            "The CPU time spent running GC."
            CounterType
            gcCpuSeconds
    ,   statsCollector
            "ghc_gc_wall_seconds_total"
            "The wall clock time spent running GC."
            CounterType
            gcWallSeconds
    ,   statsCollector
            "ghc_cpu_seconds_total"
            "Total CPU time elapsed since program start."
            CounterType
            cpuSeconds
    ,   statsCollector
            "ghc_wall_seconds_total"
            "Total wall clock time elapsed since start."
            CounterType
            wallSeconds
    ,   statsCollector
            "ghc_parallel_copied_bytes_total"
            "Number of bytes copied during GC, minus space held by mutable lists held by the capabilities."
            CounterType
            parTotBytesCopied
    ,   statsCollector
            "ghc_parallel_max_copied_bytes_total"
            "Sum of number of bytes copied each GC by the most active GC thread each GC."
            CounterType
            parMaxBytesCopied
    ]

#else

ghcCollectors :: [LabelPairs -> RTSStats -> IO [SampleGroup]]
ghcCollectors :: [LabelPairs -> RTSStats -> IO [SampleGroup]]
ghcCollectors = [
      Text
-> Text
-> SampleType
-> (RTSStats -> Word32)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcs_total"
            Text
"Total number of GCs"
            SampleType
CounterType
            RTSStats -> Word32
gcs
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word32)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_major_gcs_total"
            Text
"Total number of major (oldest generation) GCs"
            SampleType
CounterType
            RTSStats -> Word32
major_gcs
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_allocated_bytes_total"
            Text
"Total bytes allocated"
            SampleType
CounterType
            RTSStats -> Word64
allocated_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_max_live_bytes"
            Text
"Maximum live data (including large objects + compact regions)"
            SampleType
GaugeType
            RTSStats -> Word64
max_live_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_max_large_objects_bytes"
            Text
"Maximum live data in large objects"
            SampleType
GaugeType
            RTSStats -> Word64
max_large_objects_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_max_compact_bytes"
            Text
"Maximum live data in compact regions"
            SampleType
GaugeType
            RTSStats -> Word64
max_compact_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_max_slop_bytes"
            Text
"Maximum slop"
            SampleType
GaugeType
            RTSStats -> Word64
max_slop_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_max_mem_in_use_bytes"
            Text
"Maximum memory in use by the RTS"
            SampleType
GaugeType
            RTSStats -> Word64
max_mem_in_use_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_cumulative_live_bytes_total"
            Text
"Sum of live bytes across all major GCs. Divided by major_gcs gives the average live data over the lifetime of the program."
            SampleType
CounterType
            RTSStats -> Word64
cumulative_live_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_copied_bytes_total"
            Text
"Sum of copied_bytes across all GCs"
            SampleType
CounterType
            RTSStats -> Word64
copied_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_par_copied_bytes_total"
            Text
"Sum of copied_bytes across all parallel GCs"
            SampleType
CounterType
            RTSStats -> Word64
par_copied_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_cumulative_par_max_copied_bytes_total"
            Text
"Sum of par_max_copied_bytes across all parallel GCs"
            SampleType
CounterType
            RTSStats -> Word64
cumulative_par_max_copied_bytes
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_mutator_cpu_seconds_total"
            Text
"Total CPU time used by the mutator"
            SampleType
CounterType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
mutator_cpu_ns)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_mutator_elapsed_seconds_total"
            Text
"Total elapsed time used by the mutator"
            SampleType
CounterType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
mutator_elapsed_ns)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gc_cpu_seconds_total"
            Text
"Total CPU time used by the GC"
            SampleType
CounterType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
gc_cpu_ns)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gc_elapsed_seconds_total"
            Text
"Total elapsed time used by the GC"
            SampleType
CounterType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
gc_elapsed_ns)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_cpu_seconds_total"
            Text
"Total CPU time (at the previous GC)"
            SampleType
CounterType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
cpu_ns)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_elapsed_seconds_total"
            Text
"Total elapsed time (at the previous GC)"
            SampleType
CounterType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> RtsTime
elapsed_ns)

    , Text
-> Text
-> SampleType
-> (RTSStats -> Word32)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_gen"
            Text
"The generation number of this GC"
            SampleType
HistogramType -- TODO: is this correct?
                          -- Gauge makes little sense here.
                          -- With Histogram we'll be able to see which
                          -- generations are collected most often.
            (GCDetails -> Word32
gcdetails_gen (GCDetails -> Word32)
-> (RTSStats -> GCDetails) -> RTSStats -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word32)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_threads"
            Text
"Number of threads used in this GC"
            SampleType
GaugeType
            (GCDetails -> Word32
gcdetails_threads (GCDetails -> Word32)
-> (RTSStats -> GCDetails) -> RTSStats -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_allocated_bytes"
            Text
"Number of bytes allocated since the previous GC"
            SampleType
GaugeType -- TODO: this doesn't seem very meaningful.
            (GCDetails -> Word64
gcdetails_allocated_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_live_bytes"
            Text
"Total amount of live data in the heap (including large + compact data)"
            SampleType
GaugeType
            (GCDetails -> Word64
gcdetails_live_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_large_objects_bytes"
            Text
"Total amount of live data in large objects"
            SampleType
GaugeType
            (GCDetails -> Word64
gcdetails_large_objects_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_compact_bytes"
            Text
"Total amount of live data in compact regions"
            SampleType
GaugeType
            (GCDetails -> Word64
gcdetails_compact_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_slop_bytes"
            Text
"Total amount of slop (wasted memory)"
            SampleType
GaugeType
            (GCDetails -> Word64
gcdetails_slop_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_mem_in_use_bytes"
            Text
"Total amount of memory in use by the RTS"
            SampleType
CounterType
            (GCDetails -> Word64
gcdetails_mem_in_use_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_copied_bytes"
            Text
"Total amount of data copied during this GC"
            SampleType
GaugeType -- TODO: this will also vary wildly between GCs of different generations.
            (GCDetails -> Word64
gcdetails_copied_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Word64)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_par_max_copied_bytes"
            Text
"In parallel GC, the max amount of data copied by any one thread"
            SampleType
GaugeType
            (GCDetails -> Word64
gcdetails_par_max_copied_bytes (GCDetails -> Word64)
-> (RTSStats -> GCDetails) -> RTSStats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_sync_elapsed_seconds"
            Text
"The time elapsed during synchronisation before GC"
            SampleType
GaugeType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCDetails -> RtsTime
gcdetails_sync_elapsed_ns (GCDetails -> RtsTime)
-> (RTSStats -> GCDetails) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_cpu_seconds"
            Text
"The CPU time used during GC itself"
            SampleType
GaugeType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCDetails -> RtsTime
gcdetails_cpu_ns (GCDetails -> RtsTime)
-> (RTSStats -> GCDetails) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
    , Text
-> Text
-> SampleType
-> (RTSStats -> Fixed E9)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
forall a.
Show a =>
Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector
            Text
"ghc_gcdetails_elapsed_seconds"
            Text
"The time elapsed during GC itself"
            SampleType
GaugeType
            (RtsTime -> Fixed E9
rtsTimeToSeconds (RtsTime -> Fixed E9)
-> (RTSStats -> RtsTime) -> RTSStats -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCDetails -> RtsTime
gcdetails_elapsed_ns (GCDetails -> RtsTime)
-> (RTSStats -> GCDetails) -> RTSStats -> RtsTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> GCDetails
gc)
  ]

-- | Convert from 'RtsTime' (nanoseconds) to seconds with nanosecond precision.
rtsTimeToSeconds :: Stats.RtsTime -> Fixed E9
rtsTimeToSeconds :: RtsTime -> Fixed E9
rtsTimeToSeconds = (Fixed E9 -> Fixed E9 -> Fixed E9
forall a. Fractional a => a -> a -> a
/ Fixed E9
1e9) (Fixed E9 -> Fixed E9)
-> (RtsTime -> Fixed E9) -> RtsTime -> Fixed E9
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsTime -> Fixed E9
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#endif

#if __GLASGOW_HASKELL__ < 804
statsCollector :: Show a
               => Text -> Text -> SampleType -> (GCStats -> a) -> LabelPairs -> GCStats -> IO [SampleGroup]
statsCollector name help sampleType stat labels gcstats =
    showCollector name help sampleType (stat gcstats) labels
#else
statsCollector :: Show a
               => Text -> Text -> SampleType -> (RTSStats -> a) -> LabelPairs -> RTSStats -> IO [SampleGroup]
statsCollector :: Text
-> Text
-> SampleType
-> (RTSStats -> a)
-> LabelPairs
-> RTSStats
-> IO [SampleGroup]
statsCollector Text
name Text
help SampleType
sampleType RTSStats -> a
stat LabelPairs
labels RTSStats
rtsStats =
    Text -> Text -> SampleType -> a -> LabelPairs -> IO [SampleGroup]
forall a.
Show a =>
Text -> Text -> SampleType -> a -> LabelPairs -> IO [SampleGroup]
showCollector Text
name Text
help SampleType
sampleType (RTSStats -> a
stat RTSStats
rtsStats) LabelPairs
labels
#endif

showCollector :: Show a => Text -> Text -> SampleType -> a -> LabelPairs -> IO [SampleGroup]
showCollector :: Text -> Text -> SampleType -> a -> LabelPairs -> IO [SampleGroup]
showCollector Text
name Text
help SampleType
sampleType a
value LabelPairs
labels = do
    let info :: Info
info = Text -> Text -> Info
Info Text
name Text
help
    let valueBS :: ByteString
valueBS = String -> ByteString
BS.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
value
    [SampleGroup] -> IO [SampleGroup]
forall (m :: * -> *) a. Monad m => a -> m a
return [Info -> SampleType -> [Sample] -> SampleGroup
SampleGroup Info
info SampleType
sampleType [Text -> LabelPairs -> ByteString -> Sample
Sample Text
name LabelPairs
labels ByteString
valueBS]]