Add distribution event type

.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

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

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

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)

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 {

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

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