From e74133eb70b83d43d3907cf73c2ee67b3d75ebbc Mon Sep 17 00:00:00 2001 From: Johan Tibell Date: Mon, 21 Apr 2014 15:53:30 +0200 Subject: [PATCH] Add distribution event type --- .gitignore | 5 ++-- System/Remote/Distribution.hs | 23 ++++++++++++++++ System/Remote/Json.hs | 49 +++++++++++++++++++++++------------ System/Remote/Monitoring.hs | 11 ++++++++ assets/monitor.js | 14 +++++++--- ekg.cabal | 1 + examples/Basic.hs | 16 +++++++++++- 7 files changed, 96 insertions(+), 23 deletions(-) create mode 100644 System/Remote/Distribution.hs diff --git a/.gitignore b/.gitignore index edf75c1..8916e10 100644 --- a/.gitignore +++ b/.gitignore @@ -3,9 +3,10 @@ *.p_hi *.prof *.tix +.DS_Store +.cabal-sandbox/ .hpc/ /dist/* -.cabal-sandbox/ -.DS_Store cabal.config cabal.sandbox.config +examples/Basic diff --git a/System/Remote/Distribution.hs b/System/Remote/Distribution.hs new file mode 100644 index 0000000..7df70e0 --- /dev/null +++ b/System/Remote/Distribution.hs @@ -0,0 +1,23 @@ +-- | This module defines a type for tracking statistics about a series +-- of events. An event could be handling of a request and the value +-- associated with the event -- the value you'd pass to 'add' -- could +-- be the amount of time spent serving that request. All operations +-- are thread safe. +module System.Remote.Distribution + ( Distribution.Distribution + , Distribution.new + , Distribution.add + , Distribution.addN + , Distribution.read + + -- * Gathered statistics + , Distribution.Stats + , Distribution.mean + , Distribution.variance + , Distribution.count + , Distribution.sum + , Distribution.min + , Distribution.max + ) where + +import qualified System.Metrics.Distribution as Distribution diff --git a/System/Remote/Json.hs b/System/Remote/Json.hs index ecbd4b7..928e666 100644 --- a/System/Remote/Json.hs +++ b/System/Remote/Json.hs @@ -10,10 +10,12 @@ import qualified Data.Aeson.Encode as A import qualified Data.Aeson.Types as A import qualified Data.ByteString.Lazy as L import qualified Data.HashMap.Strict as M +import Data.Int (Int64) import qualified Data.Text as T import Prelude hiding (read) import System.Metrics +import qualified System.Metrics.Distribution as Distribution ------------------------------------------------------------------------ -- * JSON serialization @@ -22,11 +24,13 @@ data MetricType = CounterType | GaugeType | LabelType + | DistributionType metricType :: MetricType -> T.Text -metricType CounterType = "c" -metricType GaugeType = "g" -metricType LabelType = "l" +metricType CounterType = "c" +metricType GaugeType = "g" +metricType LabelType = "l" +metricType DistributionType = "d" -- | Encode metrics as nested JSON objects. Each "." in the metric -- name introduces a new level of nesting. For example, the metrics @@ -34,8 +38,14 @@ metricType LabelType = "l" -- -- > { -- > "foo": { --- > "bar": 10, --- > "baz": "label" +-- > "bar": { +-- > "type:", "c", +-- > "val": 10 +-- > }, +-- > "baz": { +-- > "type": "l", +-- > "val": "label" +-- > } -- > } -- > } -- @@ -58,24 +68,29 @@ encodeAll metrics = go v _ _ = typeMismatch "Object" v buildOneM :: Value -> A.Value -buildOneM (Counter n) = goOne n CounterType -buildOneM (Gauge n) = goOne n GaugeType -buildOneM (Label l) = goOne l LabelType +buildOneM (Counter n) = goOne n CounterType +buildOneM (Gauge n) = goOne n GaugeType +buildOneM (Label l) = goOne l LabelType +buildOneM (Distribution l) = goDistribution l + +goDistribution :: Distribution.Stats -> A.Value +goDistribution stats = A.object [ + ("mean", A.toJSON $! Distribution.mean stats), + ("variance", A.toJSON $! Distribution.variance stats), + ("count", A.toJSON $! Distribution.count stats), + ("sum", A.toJSON $! Distribution.sum stats), + ("min", A.toJSON $! Distribution.min stats), + ("max", A.toJSON $! Distribution.max stats), + ("type", A.toJSON (metricType DistributionType))] goOne :: A.ToJSON a => a -> MetricType -> A.Value goOne val ty = A.object [ ("val", A.toJSON val), ("type", A.toJSON (metricType ty))] +{-# SPECIALIZE goOne :: Int64 -> MetricType -> A.Value #-} +{-# SPECIALIZE goOne :: T.Text -> MetricType -> A.Value #-} encodeOne :: Value -> L.ByteString -encodeOne (Counter n) = encodeMetric n CounterType -encodeOne (Gauge n) = encodeMetric n GaugeType -encodeOne (Label l) = encodeMetric l LabelType - -encodeMetric :: A.ToJSON a => a -> MetricType -> L.ByteString -encodeMetric val ty = A.encode $ A.object [ - ("val", A.toJSON val), ("type", A.toJSON (metricType ty))] -{-# SPECIALIZE encodeMetric :: Int -> MetricType -> L.ByteString #-} -{-# SPECIALIZE encodeMetric :: T.Text -> MetricType -> L.ByteString #-} +encodeOne = A.encode . buildOneM typeMismatch :: String -- ^ The expected type -> A.Value -- ^ The actual value encountered diff --git a/System/Remote/Monitoring.hs b/System/Remote/Monitoring.hs index 3584e8f..2f103e1 100644 --- a/System/Remote/Monitoring.hs +++ b/System/Remote/Monitoring.hs @@ -40,6 +40,7 @@ module System.Remote.Monitoring , getCounter , getGauge , getLabel + , getDistribution ) where import Control.Concurrent (ThreadId, forkIO) @@ -51,6 +52,7 @@ import Prelude hiding (read) import qualified System.Metrics as Metrics import System.Remote.Counter (Counter) +import System.Remote.Distribution (Distribution) import System.Remote.Gauge (Gauge) import System.Remote.Label (Label) import System.Remote.Snap @@ -237,3 +239,12 @@ getLabel :: T.Text -- ^ Label name -> Server -- ^ Server that will serve the label -> IO Label getLabel name server = Metrics.createLabel name (serverMetricStore server) + +-- | Return a new distribution associated with the given name and +-- server. Multiple calls to 'getDistribution' with the same arguments +-- will result in an 'error'. +getDistribution :: T.Text -- ^ Distribution name + -> Server -- ^ Server that will serve the distribution + -> IO Distribution +getDistribution name server = + Metrics.createDistribution name (serverMetricStore server) diff --git a/assets/monitor.js b/assets/monitor.js index 658da82..befe48a 100644 --- a/assets/monitor.js +++ b/assets/monitor.js @@ -228,6 +228,7 @@ $(document).ready(function () { function addMetrics(table) { var COUNTER = "c"; var GAUGE = "g"; + var DISTRIBUTION = "d"; var metrics = {}; function makeDataGetter(key) { @@ -246,7 +247,9 @@ $(document).ready(function () { }); return 1000 * (value.val - prev_value.val) / (time - prev_time); - } else { // value.type === GAUGE + } else if (value.type === DISTRIBUTION) { + return value.mean; + } else { // value.type === GAUGE || value.type === LABEL return value.val; } } @@ -289,7 +292,12 @@ $(document).ready(function () { }); } if (!paused) { - var val = value.val; + if (value.type === DISTRIBUTION) { + var val = value.mean.toPrecision(8) + '\n+/-' + + Math.sqrt(value.variance).toPrecision(8) + ' sd'; + } else { // COUNTER, GAUGE, LABEL + var val = value.val; + } if ($.inArray(value.type, [COUNTER, GAUGE]) !== -1) { val = commaify(val); } @@ -301,7 +309,7 @@ $(document).ready(function () { function onDataReceived(stats, time) { function build(prefix, obj) { $.each(obj, function (suffix, value) { - if (value.hasOwnProperty("val")) { + if (value.hasOwnProperty("type")) { var key = prefix + suffix; addElem(key, value); } else { diff --git a/ekg.cabal b/ekg.cabal index 099b17f..07ce402 100644 --- a/ekg.cabal +++ b/ekg.cabal @@ -26,6 +26,7 @@ cabal-version: >= 1.8 library exposed-modules: System.Remote.Counter + System.Remote.Distribution System.Remote.Gauge System.Remote.Label System.Remote.Monitoring diff --git a/examples/Basic.hs b/examples/Basic.hs index 5ee9e89..2ff5f27 100644 --- a/examples/Basic.hs +++ b/examples/Basic.hs @@ -7,6 +7,8 @@ module Main where import Control.Concurrent import Control.Exception import Data.List +import Data.Time.Clock.POSIX (getPOSIXTime) +import qualified System.Remote.Event as Event import qualified System.Remote.Counter as Counter import qualified System.Remote.Label as Label import System.Remote.Monitoring @@ -23,10 +25,22 @@ main = do handle <- forkServer "localhost" 8000 counter <- getCounter "iterations" handle label <- getLabel "args" handle + event <- getEvent "runtime" handle Label.set label "some text string" let loop n = do - evaluate $ mean [1..n] + t <- timed $ evaluate $ mean [1..n] + Event.add event t threadDelay 2000 Counter.inc counter loop n loop 1000000 + +timed :: IO a -> IO Double +timed m = do + start <- getTime + m + end <- getTime + return $! end - start + +getTime :: IO Double +getTime = realToFrac `fmap` getPOSIXTime