{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module System.Metrics
(
Store
, newStore
, registerCounter
, registerGauge
, registerLabel
, registerDistribution
, registerGroup
, createCounter
, createGauge
, createLabel
, createDistribution
, registerGcMetrics
, 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
newtype Store = Store { Store -> IORef State
storeState :: IORef State }
type GroupId = Int
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))
}
data MetricSampler = CounterS !(IO Int64)
| GaugeS !(IO Int64)
| LabelS !(IO T.Text)
| DistributionS !(IO Distribution.Stats)
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 0
Store -> IO Store
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
registerCounter :: T.Text
-> IO Int64
-> Store
-> IO ()
registerCounter :: Text -> IO Int64 -> Store -> IO ()
registerCounter name :: Text
name sample :: IO Int64
sample store :: Store
store =
Text -> MetricSampler -> Store -> IO ()
register Text
name (IO Int64 -> MetricSampler
CounterS IO Int64
sample) Store
store
registerGauge :: T.Text
-> IO Int64
-> Store
-> IO ()
registerGauge :: Text -> IO Int64 -> Store -> IO ()
registerGauge name :: Text
name sample :: IO Int64
sample store :: Store
store =
Text -> MetricSampler -> Store -> IO ()
register Text
name (IO Int64 -> MetricSampler
GaugeS IO Int64
sample) Store
store
registerLabel :: T.Text
-> IO T.Text
-> Store
-> IO ()
registerLabel :: Text -> IO Text -> Store -> IO ()
registerLabel name :: Text
name sample :: IO Text
sample store :: Store
store =
Text -> MetricSampler -> Store -> IO ()
register Text
name (IO Text -> MetricSampler
LabelS IO Text
sample) Store
store
registerDistribution
:: T.Text
-> IO Distribution.Stats
-> Store
-> IO ()
registerDistribution :: Text -> IO Stats -> Store -> IO ()
registerDistribution name :: Text
name sample :: IO Stats
sample store :: 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 name :: Text
name sample :: MetricSampler
sample store :: 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{..} ->
case 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 of
False -> let !state' :: State
state' = State
state {
stateMetrics :: HashMap Text (Either MetricSampler GroupId)
stateMetrics = Text
-> Either MetricSampler GroupId
-> HashMap Text (Either MetricSampler GroupId)
-> HashMap Text (Either MetricSampler GroupId)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
name
(MetricSampler -> Either MetricSampler GroupId
forall a b. a -> Either a b
Left MetricSampler
sample)
HashMap Text (Either MetricSampler GroupId)
stateMetrics
}
in (State
state', ())
True -> Text -> (State, ())
forall a. Text -> a
alreadyInUseError Text
name
alreadyInUseError :: T.Text -> a
alreadyInUseError :: Text -> a
alreadyInUseError name :: Text
name =
[Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ "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]
++ "\" is already taken " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
"by a metric."
registerGroup
:: M.HashMap T.Text
(a -> Value)
-> IO a
-> Store
-> IO ()
registerGroup :: HashMap Text (a -> Value) -> IO a -> Store -> IO ()
registerGroup getters :: HashMap Text (a -> Value)
getters cb :: IO a
cb store :: 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{..} ->
let !state' :: State
state' = $WState :: HashMap Text (Either MetricSampler GroupId)
-> IntMap GroupSampler -> GroupId -> 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
+ 1
}
in (State
state', ())
where
register_ :: b
-> HashMap Text (Either a b)
-> Text
-> p
-> HashMap Text (Either a b)
register_ groupId :: b
groupId metrics :: HashMap Text (Either a b)
metrics name :: Text
name _ = 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
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 _ -> Text -> HashMap Text (Either a b)
forall a. Text -> a
alreadyInUseError Text
name
createCounter :: T.Text
-> Store
-> IO Counter
createCounter :: Text -> Store -> IO Counter
createCounter name :: Text
name store :: Store
store = do
Counter
counter <- IO Counter
Counter.new
Text -> IO Int64 -> Store -> IO ()
registerCounter Text
name (Counter -> IO Int64
Counter.read Counter
counter) Store
store
Counter -> IO Counter
forall (m :: * -> *) a. Monad m => a -> m a
return Counter
counter
createGauge :: T.Text
-> Store
-> IO Gauge
createGauge :: Text -> Store -> IO Gauge
createGauge name :: Text
name store :: Store
store = do
Gauge
gauge <- IO Gauge
Gauge.new
Text -> IO Int64 -> Store -> IO ()
registerGauge Text
name (Gauge -> IO Int64
Gauge.read Gauge
gauge) Store
store
Gauge -> IO Gauge
forall (m :: * -> *) a. Monad m => a -> m a
return Gauge
gauge
createLabel :: T.Text
-> Store
-> IO Label
createLabel :: Text -> Store -> IO Label
createLabel name :: Text
name store :: 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 (m :: * -> *) a. Monad m => a -> m a
return Label
label
createDistribution :: T.Text
-> Store
-> IO Distribution
createDistribution :: Text -> Store -> IO Distribution
createDistribution name :: Text
name store :: 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 (m :: * -> *) a. Monad m => a -> m a
return Distribution
event
#if MIN_VERSION_base(4,10,0)
nsToMs :: Int64 -> Int64
nsToMs :: Int64 -> Int64
nsToMs s :: Int64
s = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Int64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int64
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (1000000.0 :: Double))
#else
sToMs :: Double -> Int64
sToMs s = round (s * 1000.0)
#endif
registerGcMetrics :: Store -> IO ()
registerGcMetrics :: Store -> IO ()
registerGcMetrics store :: Store
store =
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
[ ("rts.gc.bytes_allocated" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.allocated_bytes)
, ("rts.gc.num_gcs" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (RTSStats -> Word32) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word32
Stats.gcs)
, ("rts.gc.num_bytes_usage_samples" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (RTSStats -> Word32) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word32
Stats.major_gcs)
, ("rts.gc.cumulative_bytes_used" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.cumulative_live_bytes)
, ("rts.gc.bytes_copied" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.copied_bytes)
#if MIN_VERSION_base(4,12,0)
, ("rts.gc.init_cpu_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.init_cpu_ns)
, ("rts.gc.init_wall_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.init_elapsed_ns)
#endif
, ("rts.gc.mutator_cpu_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.mutator_cpu_ns)
, ("rts.gc.mutator_wall_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.mutator_elapsed_ns)
, ("rts.gc.gc_cpu_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.gc_cpu_ns)
, ("rts.gc.gc_wall_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.gc_elapsed_ns)
, ("rts.gc.cpu_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.cpu_ns)
, ("rts.gc.wall_ms" , Int64 -> Value
Counter (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
nsToMs (Int64 -> Int64) -> (RTSStats -> Int64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Int64
Stats.elapsed_ns)
, ("rts.gc.max_bytes_used" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_live_bytes)
, ("rts.gc.current_bytes_used" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
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)
, ("rts.gc.current_bytes_slop" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
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)
, ("rts.gc.max_bytes_slop" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.max_slop_bytes)
, ("rts.gc.peak_megabytes_allocated" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` (1024Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
*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)
, ("rts.gc.par_tot_bytes_copied" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.par_copied_bytes)
, ("rts.gc.par_avg_bytes_copied" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.par_copied_bytes)
, ("rts.gc.par_max_bytes_copied" , Int64 -> Value
Gauge (Int64 -> Value) -> (RTSStats -> Int64) -> RTSStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (RTSStats -> Word64) -> RTSStats -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTSStats -> Word64
Stats.cumulative_par_max_copied_bytes)
])
IO RTSStats
getRTSStats
#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
#endif
Store
store
#if MIN_VERSION_base(4,10,0)
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 (m :: * -> *) a. Monad m => a -> m a
return RTSStats
emptyRTSStats
emptyRTSStats :: Stats.RTSStats
emptyRTSStats :: RTSStats
emptyRTSStats = RTSStats :: Word32
-> Word32
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> GCDetails
-> RTSStats
Stats.RTSStats
{ gcs :: Word32
gcs = 0
, major_gcs :: Word32
major_gcs = 0
, allocated_bytes :: Word64
allocated_bytes = 0
, max_live_bytes :: Word64
max_live_bytes = 0
, max_large_objects_bytes :: Word64
max_large_objects_bytes = 0
, max_compact_bytes :: Word64
max_compact_bytes = 0
, max_slop_bytes :: Word64
max_slop_bytes = 0
, max_mem_in_use_bytes :: Word64
max_mem_in_use_bytes = 0
, cumulative_live_bytes :: Word64
cumulative_live_bytes = 0
, copied_bytes :: Word64
copied_bytes = 0
, par_copied_bytes :: Word64
par_copied_bytes = 0
, cumulative_par_max_copied_bytes :: Word64
cumulative_par_max_copied_bytes = 0
# if MIN_VERSION_base(4,11,0)
, cumulative_par_balanced_copied_bytes :: Word64
cumulative_par_balanced_copied_bytes = 0
# if MIN_VERSION_base(4,12,0)
, init_cpu_ns :: Int64
init_cpu_ns = 0
, init_elapsed_ns :: Int64
init_elapsed_ns = 0
# endif
# endif
, mutator_cpu_ns :: Int64
mutator_cpu_ns = 0
, mutator_elapsed_ns :: Int64
mutator_elapsed_ns = 0
, gc_cpu_ns :: Int64
gc_cpu_ns = 0
, gc_elapsed_ns :: Int64
gc_elapsed_ns = 0
, cpu_ns :: Int64
cpu_ns = 0
, elapsed_ns :: Int64
elapsed_ns = 0
, gc :: GCDetails
gc = GCDetails
emptyGCDetails
}
emptyGCDetails :: Stats.GCDetails
emptyGCDetails :: GCDetails
emptyGCDetails = GCDetails :: Word32
-> Word32
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Int64
-> Int64
-> Int64
-> GCDetails
Stats.GCDetails
{ gcdetails_gen :: Word32
gcdetails_gen = 0
, gcdetails_threads :: Word32
gcdetails_threads = 0
, gcdetails_allocated_bytes :: Word64
gcdetails_allocated_bytes = 0
, gcdetails_live_bytes :: Word64
gcdetails_live_bytes = 0
, gcdetails_large_objects_bytes :: Word64
gcdetails_large_objects_bytes = 0
, gcdetails_compact_bytes :: Word64
gcdetails_compact_bytes = 0
, gcdetails_slop_bytes :: Word64
gcdetails_slop_bytes = 0
, gcdetails_mem_in_use_bytes :: Word64
gcdetails_mem_in_use_bytes = 0
, gcdetails_copied_bytes :: Word64
gcdetails_copied_bytes = 0
, gcdetails_par_max_copied_bytes :: Word64
gcdetails_par_max_copied_bytes = 0
# if MIN_VERSION_base(4,11,0)
, gcdetails_par_balanced_copied_bytes :: Word64
gcdetails_par_balanced_copied_bytes = 0
# endif
, gcdetails_sync_elapsed_ns :: Int64
gcdetails_sync_elapsed_ns = 0
, gcdetails_cpu_ns :: Int64
gcdetails_cpu_ns = 0
, gcdetails_elapsed_ns :: Int64
gcdetails_elapsed_ns = 0
}
#else
getGcStats :: IO Stats.GCStats
# if MIN_VERSION_base(4,6,0)
getGcStats = do
enabled <- Stats.getGCStatsEnabled
if enabled
then Stats.getGCStats
else return emptyGCStats
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
gcParTotBytesCopied :: Stats.GCStats -> Int64
# if MIN_VERSION_base(4,6,0)
gcParTotBytesCopied = Stats.parTotBytesCopied
# else
gcParTotBytesCopied = Stats.parAvgBytesCopied
# endif
#endif
type Sample = M.HashMap T.Text Value
sampleAll :: Store -> IO Sample
sampleAll :: Store -> IO Sample
sampleAll store :: 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 (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
sampleGroups :: [GroupSampler] -> IO [(T.Text, Value)]
sampleGroups :: [GroupSampler] -> IO [(Text, Value)]
sampleGroups cbSamplers :: [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 (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)
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{..} = do
a
a <- IO a
groupSampleAction
[(Text, Value)] -> IO [(Text, Value)]
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 (\ (n :: Text
n, f :: 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)
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
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: 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
showList :: [Value] -> [Char] -> [Char]
$cshowList :: [Value] -> [Char] -> [Char]
show :: Value -> [Char]
$cshow :: Value -> [Char]
showsPrec :: GroupId -> Value -> [Char] -> [Char]
$cshowsPrec :: GroupId -> Value -> [Char] -> [Char]
Show)
sampleOne :: MetricSampler -> IO Value
sampleOne :: MetricSampler -> IO Value
sampleOne (CounterS m :: IO Int64
m) = Int64 -> Value
Counter (Int64 -> Value) -> IO Int64 -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int64
m
sampleOne (GaugeS m :: IO Int64
m) = Int64 -> Value
Gauge (Int64 -> Value) -> IO Int64 -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int64
m
sampleOne (LabelS m :: 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 m :: 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
readAllRefs :: M.HashMap T.Text (Either MetricSampler GroupId)
-> IO [(T.Text, Value)]
readAllRefs :: HashMap Text (Either MetricSampler GroupId) -> IO [(Text, Value)]
readAllRefs m :: 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) | (name :: Text
name, Left ref :: 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
$ \ (name :: Text
name, ref :: MetricSampler
ref) -> do
Value
val <- MetricSampler -> IO Value
sampleOne MetricSampler
ref
(Text, Value) -> IO (Text, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Value
val)