{-# 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 GroupId
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 Text
name IO Int64
sample 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 Text
name IO Int64
sample 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 Text
name IO Text
sample 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 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)
stateNextId :: GroupId
stateGroups :: IntMap GroupSampler
stateMetrics :: HashMap Text (Either MetricSampler GroupId)
stateNextId :: State -> GroupId
stateGroups :: State -> IntMap GroupSampler
stateMetrics :: State -> HashMap Text (Either MetricSampler GroupId)
..} ->
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
Bool
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', ())
Bool
True -> Text -> (State, ())
forall a. Text -> a
alreadyInUseError Text
name
alreadyInUseError :: T.Text -> a
alreadyInUseError :: 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."
registerGroup
:: M.HashMap T.Text
(a -> Value)
-> IO a
-> Store
-> IO ()
registerGroup :: 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)
stateNextId :: GroupId
stateGroups :: IntMap GroupSampler
stateMetrics :: HashMap Text (Either MetricSampler GroupId)
stateNextId :: State -> GroupId
stateGroups :: State -> IntMap GroupSampler
stateMetrics :: State -> HashMap Text (Either MetricSampler GroupId)
..} ->
let !state' :: State
state' = State :: 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
+ 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
createCounter :: T.Text
-> Store
-> IO Counter
createCounter :: Text -> Store -> IO Counter
createCounter Text
name 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 Text
name 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 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 (m :: * -> *) a. Monad m => a -> m a
return Label
label
createDistribution :: T.Text
-> 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 (m :: * -> *) a. Monad m => a -> m a
return Distribution
event
#if MIN_VERSION_base(4,10,0)
nsToMs :: Int64 -> Int64
nsToMs :: Int64 -> Int64
nsToMs 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
/ (Double
1000000.0 :: Double))
#else
sToMs :: Double -> Int64
sToMs s = round (s * 1000.0)
#endif
registerGcMetrics :: Store -> IO ()
registerGcMetrics :: Store -> IO ()
registerGcMetrics 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
[ (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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)
, (Text
"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` (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" , 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)
, (Text
"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)
, (Text
"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
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> GCDetails
-> RTSStats
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 :: Int64
init_cpu_ns = Int64
0
, init_elapsed_ns :: Int64
init_elapsed_ns = Int64
0
# endif
# endif
, mutator_cpu_ns :: Int64
mutator_cpu_ns = Int64
0
, mutator_elapsed_ns :: Int64
mutator_elapsed_ns = Int64
0
, gc_cpu_ns :: Int64
gc_cpu_ns = Int64
0
, gc_elapsed_ns :: Int64
gc_elapsed_ns = Int64
0
, cpu_ns :: Int64
cpu_ns = Int64
0
, elapsed_ns :: Int64
elapsed_ns = Int64
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
-> Int64
-> Int64
-> GCDetails
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
# endif
, gcdetails_sync_elapsed_ns :: Int64
gcdetails_sync_elapsed_ns = Int64
0
, gcdetails_cpu_ns :: Int64
gcdetails_cpu_ns = Int64
0
, gcdetails_elapsed_ns :: Int64
gcdetails_elapsed_ns = Int64
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 = 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 [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{IO a
HashMap Text (a -> Value)
groupSamplerMetrics :: HashMap Text (a -> Value)
groupSampleAction :: IO a
groupSamplerMetrics :: ()
groupSampleAction :: ()
..} = 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 (\ (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)
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 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 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 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
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 (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Value
val)