ekg 0.3.0.5 → 0.3.1.0

raw patch · 8 files changed

+233/−72 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• System/Remote/Label.hs +27/−0
• System/Remote/Label/Internal.hs +21/−0
• System/Remote/Monitoring.hs +87/−48
• assets/index.html +13/−0
• assets/monitor.css +4/−0
• assets/monitor.js +50/−23
• ekg.cabal +4/−1
• examples/Basic.hs +27/−0

@@ -0,0 +1,27 @@+{-# LANGUAGE BangPatterns #-}+-- | This module defines a type for mutable, string-valued labels.+-- Labels are variable values and can be used to track e.g. the+-- command line arguments or other free-form values. All operations on+-- labels are thread-safe.+module System.Remote.Label+    (+      Label+    , set+    , modify+    ) where++import Data.IORef (atomicModifyIORef)+import qualified Data.Text as T++import System.Remote.Label.Internal++-- | Set the label to the given value.+set :: Label -> T.Text -> IO ()+set (C ref) !i = atomicModifyIORef ref $ \ _ -> (i, ())++-- | Set the label to the result of applying the given function to the+-- value.+modify :: (T.Text -> T.Text) -> Label -> IO ()+modify f (C ref) = do+    !_ <- atomicModifyIORef ref $ \ i -> let i' = f i in (i', i')+    return ()

@@ -0,0 +1,21 @@+{-# OPTIONS_HADDOCK not-home #-}+module System.Remote.Label.Internal+    (+      Label(..)+    , new+    , read+    ) where++import Data.IORef (IORef, newIORef, readIORef)+import qualified Data.Text as T+import Prelude hiding (read)++-- | A mutable, text-valued label.+newtype Label = C { unC :: IORef T.Text }++-- | Create a new empty label.+new :: IO Label+new = C `fmap` newIORef T.empty++read :: Label -> IO T.Text+read = readIORef . unC

@@ -1,9 +1,10 @@-{-# LANGUAGE ExistentialQuantification, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE ExistentialQuantification, OverloadedStrings, RecordWildCards,+  FunctionalDependencies #-} -- | This module provides remote monitoring of a running process over -- HTTP.  It can be used to run an HTTP server that provides both a--- web-based user interface and a machine-readable API (e.g. JSON).+-- web-based user interface and a machine-readable API (e.g. JSON.) -- The former can be used by a human to get an overview of what the--- program is doing and the latter can be used be automated monitoring+-- program is doing and the latter can be used by automated monitoring -- tools. -- -- Typical usage is to start the monitoring server at program startup@@ -29,10 +30,11 @@     , serverThreadId     , forkServer -      -- * User-defined counters and gauges+      -- * User-defined counters, gauges, and labels       -- $userdefined     , getCounter     , getGauge+    , getLabel     ) where  import Control.Applicative ((<$>), (<|>))@@ -70,6 +72,8 @@ import qualified System.Remote.Counter.Internal as Counter import System.Remote.Gauge (Gauge) import qualified System.Remote.Gauge.Internal as Gauge+import System.Remote.Label (Label)+import qualified System.Remote.Label.Internal as Label  -- $configuration --@@ -96,8 +100,8 @@ -- @gauges@ attributes, respectively.  Content types: \"text\/html\" -- (default), \"application\/json\" ----- [\/combined] Flattened JSON object containing all counters and--- gauges.  Content types: \"application\/json\"+-- [\/combined] Flattened JSON object containing all counters, gauges,+-- and labels.  Content types: \"application\/json\" -- -- [\/counters] JSON object containing all counters.  Content types: -- \"application\/json\"@@ -112,14 +116,20 @@ -- [\/gauges/\<gauge name\>] Value of a single gauge, as a string. -- The name should be UTF-8 encoded.  Content types: \"text\/plain\" ----- Counters and gauges are stored as attributes of the returned JSON--- objects, one attribute per counter or gauge.  In addition to--- user-defined counters and gauges, the below built-in counters and--- gauges are also returned.  Furthermore, the top-level JSON object--- of any resource contains the @server_timestamp_millis@ attribute,--- which indicates the server time, in milliseconds, when the sample--- was taken.+-- [\/labels] JSON object containing all labels.  Content types:+-- \"application\/json\" --+-- [\/labels/\<label name\>] Value of a single label, as a string.+-- The name should be UTF-8 encoded.  Content types: \"text\/plain\"+--+-- Counters, gauges and labels are stored as attributes of the+-- returned JSON objects, one attribute per counter, gauge or label.+-- In addition to user-defined counters, gauges, and labels, the below+-- built-in counters and gauges are also returned.  Furthermore, the+-- top-level JSON object of any resource contains the+-- @server_timestamp_millis@ attribute, which indicates the server+-- time, in milliseconds, when the sample was taken.+-- -- Built-in counters: -- -- [@bytes_allocated@] Total number of bytes allocated@@ -181,12 +191,16 @@ -- Map of user-defined gauges. type Gauges = M.HashMap T.Text Gauge +-- Map of user-defined labels.+type Labels = M.HashMap T.Text Label+ -- | A handle that can be used to control the monitoring server. -- Created by 'forkServer'. data Server = Server {       threadId :: {-# UNPACK #-} !ThreadId     , userCounters :: !(IORef Counters)     , userGauges :: !(IORef Gauges)+    , userLabels :: !(IORef Labels)     }  -- | The thread ID of the server.  You can kill the server by killing@@ -197,7 +211,7 @@ -- | Start an HTTP server in a new thread.  The server replies to GET -- requests to the given host and port.  The host argument can be -- either a numeric network address (dotted quad for IPv4,--- colon-separated hex for IPv6) or a hostname (e.g. \"localhost\").+-- colon-separated hex for IPv6) or a hostname (e.g. \"localhost\".) -- The client can control the Content-Type used in responses by -- setting the Accept header.  At the moment three content types are -- available: \"application\/json\", \"text\/html\", and@@ -208,8 +222,9 @@ forkServer host port = do     counters <- newIORef M.empty     gauges <- newIORef M.empty-    tid <- forkIO $ httpServe conf (monitor counters gauges)-    return $! Server tid counters gauges+    labels <- newIORef M.empty+    tid <- forkIO $ httpServe conf (monitor counters gauges labels)+    return $! Server tid counters gauges labels   where conf = Config.setVerbose False $                Config.setErrorLog Config.ConfigNoLog $                Config.setAccessLog Config.ConfigNoLog $@@ -218,16 +233,18 @@                Config.defaultConfig  --------------------------------------------------------------------------- * User-defined counters and gauges+-- * User-defined counters, gauges and labels  -- $userdefined -- The monitoring server can store and serve user-defined,--- integer-valued counters and gauges.  A counter is a monotonically--- increasing value (e.g. TCP connections established since program--- start). A gauge is a variable value (e.g. the current number of--- concurrent connections.)  Each counter or gauge is associated with--- a name, which is used when the counter or gauge is displayed in the--- UI or returned in a JSON object.+-- integer-valued counters and gauges, and string-value labels.  A+-- counter is a monotonically increasing value (e.g. TCP connections+-- established since program start.) A gauge is a variable value+-- (e.g. the current number of concurrent connections.) A label is a+-- free-form string value (e.g. exporting the command line arguments+-- or host name.)  Each counter, gauge, and label is associated with a+-- name, which is used when it is displayed in the UI or returned in a+-- JSON object. -- -- Even though it's technically possible to have a counter and a gauge -- with the same name, associated with the same server, it's not@@ -246,26 +263,30 @@ -- >             loop -- >     loop ----- To create a guage, use 'getGauge' instead of 'getCounter' and then+-- To create a gauge, use 'getGauge' instead of 'getCounter' and then -- call e.g. 'System.Remote.Gauge.set' or--- 'System.Remote.Gauge.modify'.+-- 'System.Remote.Gauge.modify'.  Similar for labels. -class Ref r where+class Ref r t | r -> t where     new :: IO r-    read :: r -> IO Int+    read :: r -> IO t -instance Ref Counter where+instance Ref Counter Int where     new = Counter.new     read = Counter.read -instance Ref Gauge where+instance Ref Gauge Int where     new = Gauge.new     read = Gauge.read +instance Ref Label T.Text where+    new = Label.new+    read = Label.read+ -- | Lookup a 'Ref' by name in the given map.  If no 'Ref' exists -- under the given name, create a new one, insert it into the map and -- return it.-getRef :: Ref r+getRef :: Ref r t        => T.Text                      -- ^ 'Ref' name        -> IORef (M.HashMap T.Text r)  -- ^ Server that will serve the 'Ref'        -> IO r@@ -298,6 +319,15 @@          -> IO Gauge getGauge name server = getRef name (userGauges server) +-- | Return the label associated with the given name and server.+-- Multiple calls to 'getLabel' with the same arguments will return+-- the same label.  The first time 'getLabel' is called for a given+-- name and server, a new, empty label will be returned.+getLabel :: T.Text  -- ^ Label name+         -> Server  -- ^ Server that will serve the label+         -> IO Label+getLabel name server = getRef name (userLabels server)+ ------------------------------------------------------------------------ -- * JSON serialization @@ -307,13 +337,15 @@     !Stats.GCStats          -- GC statistics     ![(T.Text, Json)]       -- Counters     ![(T.Text, Json)]       -- Gauges+    ![(T.Text, Json)]       -- Labels     {-# UNPACK #-} !Double  -- Milliseconds since epoch  instance A.ToJSON Stats where-    toJSON (Stats gcStats@(Stats.GCStats {..}) counters gauges t) = A.object $+    toJSON (Stats gcStats@(Stats.GCStats {..}) counters gauges labels t) = A.object $         [ "server_timestamp_millis" .= t         , "counters"                .= Assocs (gcCounters ++ counters)         , "gauges"                  .= Assocs (gcGauges ++ gauges)+        , "labels"                  .= Assocs (labels)         ]       where         (gcCounters, gcGauges) = partitionGcStats gcStats@@ -322,7 +354,7 @@ newtype Combined = Combined Stats  instance A.ToJSON Combined where-    toJSON (Combined (Stats (Stats.GCStats {..}) counters gauges t)) =+    toJSON (Combined (Stats (Stats.GCStats {..}) counters gauges labels t)) =         A.object $         [ "server_timestamp_millis"  .= t         , "bytes_allocated"          .= bytesAllocated@@ -344,7 +376,8 @@         , "par_avg_bytes_copied"     .= parAvgBytesCopied         , "par_max_bytes_copied"     .= parMaxBytesCopied         ] ++ map (uncurry (.=)) counters ++-        map (uncurry (.=)) gauges+        map (uncurry (.=)) gauges +++        map (uncurry (.=)) labels  -- | A list of string keys and JSON-encodable values.  Used to render -- a list of key-value pairs as a JSON object.@@ -366,14 +399,14 @@ -- * HTTP request handler  -- | A handler that can be installed into an existing Snap application.-monitor :: IORef Counters -> IORef Gauges -> Snap ()-monitor counters gauges = do+monitor :: IORef Counters -> IORef Gauges -> IORef Labels -> Snap ()+monitor counters gauges labels = do     dataDir <- liftIO getDataDir     route [           ("", method GET (format "application/json"-                           (serveAll counters gauges)))+                           (serveAll counters gauges labels)))         , ("combined", method GET (format "application/json"-                                   (serveCombined counters gauges)))+                                   (serveCombined counters gauges labels)))         , ("counters", method GET (format "application/json"                                    (serveMany counters)))         , ("counters/:name", method GET (format "text/plain"@@ -382,6 +415,10 @@                                  (serveMany gauges)))         , ("gauges/:name", method GET (format "text/plain"                                        (serveOne gauges)))+        , ("labels", method GET (format "application/json"+                                 (serveMany labels)))+        , ("labels/:name", method GET (format "text/plain"+                                       (serveOne labels)))         ]         <|> serveDirectory (dataDir </> "assets") @@ -401,7 +438,7 @@  -- | Get a snapshot of all values.  Note that we're not guaranteed to -- see a consistent snapshot of the whole map.-readAllRefs :: Ref r => IORef (M.HashMap T.Text r) -> IO [(T.Text, Json)]+readAllRefs :: (Ref r t, A.ToJSON t) => IORef (M.HashMap T.Text r) -> IO [(T.Text, Json)] readAllRefs mapRef = do     m <- readIORef mapRef     forM (M.toList m) $ \ (name, ref) -> do@@ -410,7 +447,7 @@ {-# INLINABLE readAllRefs #-}  -- | Serve a collection of counters or gauges, as a JSON object.-serveMany :: Ref r => IORef (M.HashMap T.Text r) -> Snap ()+serveMany :: (Ref r t, A.ToJSON t) => IORef (M.HashMap T.Text r) -> Snap () serveMany mapRef = do     list <- liftIO $ readAllRefs mapRef     modifyResponse $ setContentType "application/json"@@ -418,10 +455,10 @@     writeLBS $ A.encode $ A.toJSON $ Group list time {-# INLINABLE serveMany #-} --- | Serve all counter and gauges, built-in or not, as a nested JSON--- object.-serveAll :: IORef Counters -> IORef Gauges -> Snap ()-serveAll counters gauges = do+-- | Serve all counter, gauges and labels, built-in or not, as a+-- nested JSON object.+serveAll :: IORef Counters -> IORef Gauges -> IORef Labels -> Snap ()+serveAll counters gauges labels = do     req <- getRequest     -- Workaround: Snap still matches requests to /foo to this handler     -- if the Accept header is "application/json", even though such@@ -431,23 +468,25 @@     gcStats <- liftIO Stats.getGCStats     counterList <- liftIO $ readAllRefs counters     gaugeList <- liftIO $ readAllRefs gauges+    labelList <- liftIO $ readAllRefs labels     time <- liftIO getTimeMillis-    writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList gaugeList time+    writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList gaugeList labelList time  -- | Serve all counters and gauges, built-in or not, as a flattened -- JSON object.-serveCombined :: IORef Counters -> IORef Gauges -> Snap ()-serveCombined counters gauges = do+serveCombined :: IORef Counters -> IORef Gauges -> IORef Labels -> Snap ()+serveCombined counters gauges labels = do     modifyResponse $ setContentType "application/json"     gcStats <- liftIO Stats.getGCStats     counterList <- liftIO $ readAllRefs counters     gaugeList <- liftIO $ readAllRefs gauges+    labelList <- liftIO $ readAllRefs labels     time <- liftIO getTimeMillis     writeLBS $ A.encode $ A.toJSON $ Combined $-        Stats gcStats counterList gaugeList time+        Stats gcStats counterList gaugeList labelList time  -- | Serve a single counter, as plain text.-serveOne :: Ref r => IORef (M.HashMap T.Text r) -> Snap ()+serveOne :: (Ref r t, Show t) => IORef (M.HashMap T.Text r) -> Snap () serveOne refs = do     modifyResponse $ setContentType "text/plain"     m <- liftIO $ readIORef refs

@@ -118,6 +118,19 @@             <tbody>             </tbody>           </table>++          <h3>Labels</h3>+          <table id="label-table" class="condensed-table">+            <thead>+              <tr>+                <th class="span4">Name</th>+                <th class="span1">Value</th>+              </tr>+            </thead>+            <tbody>+            </tbody>+          </table>+         </div>       </div>     </div>

@@ -46,6 +46,10 @@     text-align: right; } +.string {+    text-align: left;+}+ .graph-button {     cursor: pointer;     vertical-align: middle;

@@ -4,15 +4,15 @@     // Number formatters     function commaify(n)     {-	var nStr = n.toString();-	var x = nStr.split('.');-	var x1 = x[0];-	var x2 = x.length > 1 ? '.' + x[1] : '';-	var rgx = /(\d+)(\d{3})/;-	while (rgx.test(x1)) {-	    x1 = x1.replace(rgx, '$1' + ',' + '$2');-	}-	return x1 + x2;+        var nStr = n.toString();+        var x = nStr.split('.');+        var x1 = x[0];+        var x2 = x.length > 1 ? '.' + x[1] : '';+        var rgx = /(\d+)(\d{3})/;+        while (rgx.test(x1)) {+            x1 = x1.replace(rgx, '$1' + ',' + '$2');+        }+        return x1 + x2;     }      function formatSuffix(val, opt_prec) {@@ -94,7 +94,7 @@      // Fetch data periodically and notify interested parties.     var listeners = [];-    +     function subscribe(fn) {         listeners.push(fn);     }@@ -132,7 +132,7 @@         });          setTimeout(fetchData, updateInterval);-    };+    }     fetchData();      function addPlot(elem, series, opts) {@@ -140,7 +140,7 @@             series: { shadowSize: 0 },  // drawing is faster without shadows             xaxis: { mode: "time", tickSize: [10, "second"] }         };-        var options = $.extend(true, {}, defaultOptions, opts)+        var options = $.extend(true, {}, defaultOptions, opts);         var data = new Array(series.length);         var maxPoints = 60;         for(var i = 0; i < series.length; i++) {@@ -161,7 +161,7 @@             }              // zip lengends with data-            var res = []+            var res = [];             for(var i = 0; i < series.length; i++)                 res.push({ label: series[i].label, data: data[i] }); @@ -255,6 +255,29 @@         subscribe(onDataReceived);     } +    function addDynamicLabels(table, group_fn) {+        var labels = {};+        function onDataReceived(stats, time) {+            $.each(group_fn(stats), function (key, value) {+                var elem;+                if (key in labels) {+                    elem = labels[key];+                } else {+                    // Add UI element+                    table.find("tbody:last").append(+                        '<tr><td>' + key + '</td>' ++                            '<td class="string">N/A</td></tr>');+                    elem = table.find("tbody > tr > td:last");+                    labels[key] = elem;+                }+                if (!paused)+                    elem.text(value);+            });+        }++        subscribe(onDataReceived);+    }+     function initAll() {         // Metrics         var current_bytes_used = function (stats) {@@ -277,7 +300,7 @@             var gc_seconds = stats.counters.gc_wall_seconds -                 prev_stats.counters.gc_wall_seconds;             return 100 * mutator_seconds / (mutator_seconds + gc_seconds);-        }+        };         var productivity_cpu_percent = function (stats, time, prev_stats, prev_time) {             if (prev_stats == undefined)                 return null;@@ -286,14 +309,14 @@             var gc_seconds = stats.counters.gc_cpu_seconds -                 prev_stats.counters.gc_cpu_seconds;             return 100 * mutator_seconds / (mutator_seconds + gc_seconds);-        }+        };         var allocation_rate = function (stats, time, prev_stats, prev_time) {             if (prev_stats == undefined)                 return null;             return 1000 * (stats.counters.bytes_allocated -                            prev_stats.counters.bytes_allocated) /                 (time - prev_time);-        }+        };          // Plots         addPlot($("#current-bytes-used-plot > div"),@@ -308,13 +331,13 @@                 { yaxis: { tickDecimals: 1, tickFormatter: percentFormatter } });          // Counters-        addCounter($("#max-bytes-used"), max_bytes_used, formatSuffix)-        addCounter($("#current-bytes-used"), current_bytes_used, formatSuffix)-        addCounter($("#max-bytes-slop"), max_bytes_slop, formatSuffix)-        addCounter($("#current-bytes-slop"), current_bytes_slop, formatSuffix)-        addCounter($("#productivity-wall"), productivity_wall_percent, formatPercent)-        addCounter($("#productivity-cpu"), productivity_cpu_percent, formatPercent)-        addCounter($("#allocation-rate"), allocation_rate, formatRate)+        addCounter($("#max-bytes-used"), max_bytes_used, formatSuffix);+        addCounter($("#current-bytes-used"), current_bytes_used, formatSuffix);+        addCounter($("#max-bytes-slop"), max_bytes_slop, formatSuffix);+        addCounter($("#current-bytes-slop"), current_bytes_slop, formatSuffix);+        addCounter($("#productivity-wall"), productivity_wall_percent, formatPercent);+        addCounter($("#productivity-cpu"), productivity_cpu_percent, formatPercent);+        addCounter($("#allocation-rate"), allocation_rate, formatRate);          addDynamicCounters($("#counter-table"), function (stats) {             return stats.counters;@@ -333,6 +356,10 @@             return stats.gauges[key];         }, function (label) {             return label;+        });++        addDynamicLabels($("#label-table"), function (stats) {+            return stats.labels;         });     } 

@@ -1,5 +1,5 @@ name:                ekg-version:             0.3.0.5+version:             0.3.1.0 synopsis:            Remote monitoring of processes description:   This library lets you remotely monitor a running process over HTTP.@@ -19,15 +19,18 @@                      assets/chart_line_add.png assets/cross.png extra-source-files:  LICENSE.icons LICENSE.javascript README.md                      assets/jquery-1.6.4.js assets/jquery.flot.js+                     examples/Basic.hs  library   exposed-modules:     System.Remote.Counter                        System.Remote.Gauge+                       System.Remote.Label                        System.Remote.Monitoring    other-modules:       Paths_ekg                        System.Remote.Counter.Internal                        System.Remote.Gauge.Internal+                       System.Remote.Label.Internal    build-depends:       aeson < 0.7,                        base >= 4.5 && < 5,

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Example program that continously computes the mean of a list of+-- numbers.+module Main where++import Control.Concurrent+import Control.Exception+import qualified System.Remote.Counter as Counter+import qualified System.Remote.Label as Label+import System.Remote.Monitoring++mean :: Fractional a => [a] -> a+mean xs = sum xs / fromIntegral (length xs)++main :: IO ()+main = do+    handle <- forkServer "localhost" 8000+    counter <- getCounter "iterations" handle+    label <- getLabel "args" handle+    Label.set label "some text string"+    let loop n = do+            evaluate $ mean [1..n]+            threadDelay 2000+            Counter.inc counter+            loop n+    loop 1000000