ekg 0.2.0.0 → 0.3.0.0
raw patch · 12 files changed
+603/−195 lines, 12 filesdep +timebinary-addedPVP ok
version bump matches the API change (PVP)
Dependencies added: time
API changes (from Hackage documentation)
- System.Remote.Counter: dec :: Counter -> IO ()
- System.Remote.Counter: set :: Counter -> Int -> IO ()
- System.Remote.Counter: subtract :: Counter -> Int -> IO ()
+ System.Remote.Gauge: add :: Gauge -> Int -> IO ()
+ System.Remote.Gauge: data Gauge
+ System.Remote.Gauge: dec :: Gauge -> IO ()
+ System.Remote.Gauge: inc :: Gauge -> IO ()
+ System.Remote.Gauge: modify :: (Int -> Int) -> Gauge -> IO ()
+ System.Remote.Gauge: set :: Gauge -> Int -> IO ()
+ System.Remote.Gauge: subtract :: Gauge -> Int -> IO ()
+ System.Remote.Monitoring: getGauge :: Text -> Server -> IO Gauge
+ System.Remote.Monitoring: instance Ref Counter
+ System.Remote.Monitoring: instance Ref Gauge
+ System.Remote.Monitoring: instance ToJSON Assocs
+ System.Remote.Monitoring: instance ToJSON Combined
+ System.Remote.Monitoring: instance ToJSON Group
+ System.Remote.Monitoring: instance ToJSON Json
Files
- System/Remote/Counter.hs +3/−20
- System/Remote/Gauge.hs +55/−0
- System/Remote/Gauge/Internal.hs +20/−0
- System/Remote/Monitoring.hs +262/−78
- assets/cross-16-ns.png binary
- assets/dialog_close.png binary
- assets/graph-icon.png binary
- assets/index.html +46/−11
- assets/monitor.css +26/−0
- assets/monitor.js +185/−60
- ekg.cabal +6/−2
- examples/Basic.hs +0/−24
System/Remote/Counter.hs view
@@ -1,14 +1,13 @@ {-# LANGUAGE BangPatterns #-} -- | This module defines a type for mutable, integer-valued counters.--- All operations on counters are thread-safe.+-- Counters are non-negative, monotonically increasing values and can+-- be used to track e.g. the number of requests served since program+-- start. All operations on counters are thread-safe. module System.Remote.Counter ( Counter , inc- , dec , add- , subtract- , set ) where import Data.IORef (atomicModifyIORef)@@ -22,24 +21,8 @@ !_ <- atomicModifyIORef ref $ \ n -> let n' = n + 1 in (n', n') return () --- | Decrease the counter by one.-dec :: Counter -> IO ()-dec (C ref) = do- !_ <- atomicModifyIORef ref $ \ n -> let n' = n - 1 in (n', n')- return ()- -- | Increase the counter by the given amount. add :: Counter -> Int -> IO () add (C ref) i = do !_ <- atomicModifyIORef ref $ \ n -> let n' = n + i in (n', n') return ()---- | Decrease the counter by the given amount.-subtract :: Counter -> Int -> IO ()-subtract (C ref) i = do- !_ <- atomicModifyIORef ref $ \ n -> let n' = n - i in (n', n')- return ()---- | Set the counter to the given value.-set :: Counter -> Int -> IO ()-set (C ref) !i = atomicModifyIORef ref $ \ _ -> (i, ())
+ System/Remote/Gauge.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE BangPatterns #-}+-- | This module defines a type for mutable, integer-valued gauges.+-- Gauges are variable values and can be used to track e.g. the+-- current number of concurrent connections. All operations on gauges+-- are thread-safe.+module System.Remote.Gauge+ (+ Gauge+ , inc+ , dec+ , add+ , subtract+ , set+ , modify+ ) where++import Data.IORef (atomicModifyIORef)+import Prelude hiding (subtract)++import System.Remote.Gauge.Internal++-- | Increase the gauge by one.+inc :: Gauge -> IO ()+inc (C ref) = do+ !_ <- atomicModifyIORef ref $ \ n -> let n' = n + 1 in (n', n')+ return ()++-- | Decrease the gauge by one.+dec :: Gauge -> IO ()+dec (C ref) = do+ !_ <- atomicModifyIORef ref $ \ n -> let n' = n - 1 in (n', n')+ return ()++-- | Increase the gauge by the given amount.+add :: Gauge -> Int -> IO ()+add (C ref) i = do+ !_ <- atomicModifyIORef ref $ \ n -> let n' = n + i in (n', n')+ return ()++-- | Decrease the gauge by the given amount.+subtract :: Gauge -> Int -> IO ()+subtract (C ref) i = do+ !_ <- atomicModifyIORef ref $ \ n -> let n' = n - i in (n', n')+ return ()++-- | Set the gauge to the given value.+set :: Gauge -> Int -> IO ()+set (C ref) !i = atomicModifyIORef ref $ \ _ -> (i, ())++-- | Set the gauge to the result of applying the given function to the+-- value.+modify :: (Int -> Int) -> Gauge -> IO ()+modify f (C ref) = do+ !_ <- atomicModifyIORef ref $ \ i -> let i' = f i in (i', i')+ return ()
+ System/Remote/Gauge/Internal.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS_HADDOCK not-home #-}+module System.Remote.Gauge.Internal+ (+ Gauge(..)+ , new+ , read+ ) where++import Data.IORef (IORef, newIORef, readIORef)+import Prelude hiding (read)++-- | A mutable, integer-valued gauge.+newtype Gauge = C { unC :: IORef Int }++-- | Create a new, zero initialized, gauge.+new :: IO Gauge+new = C `fmap` newIORef 0++read :: Gauge -> IO Int+read = readIORef . unC
System/Remote/Monitoring.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE ExistentialQuantification, OverloadedStrings, RecordWildCards #-} -- | 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).@@ -29,9 +29,10 @@ , serverThreadId , forkServer - -- * User-defined counters- -- $counters+ -- * User-defined counters and gauges+ -- $userdefined , getCounter+ , getGauge ) where import Control.Applicative ((<$>), (<|>))@@ -51,9 +52,11 @@ import Data.Maybe (listToMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as T+import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word8) import qualified GHC.Stats as Stats import Paths_ekg (getDataDir)+import Prelude hiding (read) import Snap.Core (MonadSnap, Request, Snap, finishWith, getHeaders, getRequest, getResponse, method, Method(GET), modifyResponse, pass, route, rqParams, rqPathInfo, setContentType, setResponseStatus,@@ -65,6 +68,8 @@ import System.Remote.Counter (Counter) import qualified System.Remote.Counter.Internal as Counter+import System.Remote.Gauge (Gauge)+import qualified System.Remote.Gauge.Internal as Gauge -- $configuration --@@ -82,20 +87,45 @@ -- leave it enabled. -- $api--- To use the machine-readable REST API, send an GET request to the--- host and port passed to 'forkServer' and set the Accept header to--- \"application\/json\".+-- To use the machine-readable REST API, send an HTTP GET request to+-- the host and port passed to 'forkServer'. The following resources+-- (i.e. URLs) are available: ----- The server returns a JSON object with one attribute per--- user-defined counter (created using 'getCounter'). In addition,--- the object includes the following attributes:+-- [\/] JSON object containing all counters and gauges. Counters and+-- gauges are stored as nested objects under the @counters@ and+-- @gauges@ attributes, respectively. Content types: \"text\/html\"+-- (default), \"application\/json\" --+-- [\/combined] Flattened JSON object containing all counters and+-- gauges. Content types: \"application\/json\"+--+-- [\/counters] JSON object containing all counters. Content types:+-- \"application\/json\"+--+-- [\/counters/\<counter name\>] Value of a single counter, as a+-- string. The name should be UTF-8 encoded. Content types:+-- \"text\/plain\"+--+-- [\/gauges] JSON object containing all gauges. Content types:+-- \"application\/json\"+--+-- [\/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.+--+-- Built-in counters:+-- -- [@bytes_allocated@] Total number of bytes allocated -- -- [@num_gcs@] Number of garbage collections performed ----- [@max_bytes_used@] Maximum number of live bytes seen so far--- -- [@num_bytes_usage_samples@] Number of byte usage samples taken -- -- [@cumulative_bytes_used@] Sum of all byte usage samples, can be@@ -105,14 +135,6 @@ -- -- [@bytes_copied@] Number of bytes copied during GC ----- [@current_bytes_used@] Current number of live bytes------ [@current_bytes_slop@] Current number of bytes lost to slop------ [@max_bytes_slop@] Maximum number of bytes lost to slop at any one time so far------ [@peak_megabytes_allocated@] Maximum number of megabytes allocated--- -- [@mutator_cpu_seconds@] CPU time spent running mutator threads. -- This does not include any profiling overhead or initialization. --@@ -127,6 +149,18 @@ -- -- [@wall_seconds@] Total wall clock time elapsed since start --+-- Built-in gauges:+--+-- [@max_bytes_used@] Maximum number of live bytes seen so far+--+-- [@current_bytes_used@] Current number of live bytes+--+-- [@current_bytes_slop@] Current number of bytes lost to slop+--+-- [@max_bytes_slop@] Maximum number of bytes lost to slop at any one time so far+--+-- [@peak_megabytes_allocated@] Maximum number of megabytes allocated+-- -- [@par_avg_bytes_copied@] Number of bytes copied during GC, minus -- space held by mutable lists held by the capabilities. Can be used -- with 'parMaxBytesCopied' to determine how well parallel GC utilized@@ -137,16 +171,6 @@ -- 'parAvgBytesCopied' divided by 'parMaxBytesCopied' approaches 1 for -- a maximally sequential run and approaches the number of threads -- (set by the RTS flag @-N@) for a maximally parallel run.------ It's possible to retrieve individual counters by------ * appending the counter name to the URL (e.g. \"/my_counter\"), and------ * setting the Accept header to \"text\/plain\".------ The reason that single counters cannot be returned as JSON is that--- JSON doesn't allow for certain values (e.g. integers) to occur at--- the top-level. ------------------------------------------------------------------------ -- * The monitoring server@@ -154,11 +178,15 @@ -- Map of user-defined counters. type Counters = M.HashMap T.Text Counter +-- Map of user-defined gauges.+type Gauges = M.HashMap T.Text Gauge+ -- | 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) } -- | The thread ID of the server. You can kill the server by killing@@ -171,15 +199,17 @@ -- either a numeric network address (dotted quad for IPv4, -- 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 two content types are--- available: \"application\/json\" and \"text\/html\".+-- setting the Accept header. At the moment three content types are+-- available: \"application\/json\", \"text\/html\", and+-- \"text\/plain\". forkServer :: S.ByteString -- ^ Host to listen on (e.g. \"localhost\") -> Int -- ^ Port to listen on (e.g. 8000) -> IO Server forkServer host port = do counters <- newIORef M.empty- tid <- forkIO $ httpServe conf (monitor counters)- return $! Server tid counters+ gauges <- newIORef M.empty+ tid <- forkIO $ httpServe conf (monitor counters gauges)+ return $! Server tid counters gauges where conf = Config.setVerbose False $ Config.setErrorLog Config.ConfigNoLog $ Config.setAccessLog Config.ConfigNoLog $@@ -188,17 +218,25 @@ Config.defaultConfig --------------------------------------------------------------------------- * User-defined counters+-- * User-defined counters and gauges --- $counters+-- $userdefined -- The monitoring server can store and serve user-defined,--- integer-valued counters. Each counter is associated with a name,--- which is used when the counter is displayed in the UI or returned--- in a JSON object.+-- 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. --+-- 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+-- recommended as it might make it harder for clients to distinguish+-- the two.+-- -- To create and use a counter, simply call 'getCounter' to create it--- and then call e.g. 'Counter.inc' or 'Counter.add' to modify its--- value. Example:+-- and then call e.g. 'System.Remote.Counter.inc' or+-- 'System.Remote.Counter.add' to modify its value. Example: -- -- > main = do -- > handle <- forkServer "localhost" 8000@@ -207,7 +245,40 @@ -- > inc counter -- > loop -- > loop+--+-- To create a guage, use 'getGauge' instead of 'getCounter' and then+-- call e.g. 'System.Remote.Gauge.set' or+-- 'System.Remote.Gauge.modify'. +class Ref r where+ new :: IO r+ read :: r -> IO Int++instance Ref Counter where+ new = Counter.new+ read = Counter.read++instance Ref Gauge where+ new = Gauge.new+ read = Gauge.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+ => T.Text -- ^ 'Ref' name+ -> IORef (M.HashMap T.Text r) -- ^ Server that will serve the 'Ref'+ -> IO r+getRef name mapRef = do+ empty <- new+ ref <- atomicModifyIORef mapRef $ \ m ->+ case M.lookup name m of+ Nothing -> let m' = M.insert name empty m+ in (m', empty)+ Just ref -> (m, ref)+ return ref+{-# INLINABLE getRef #-}+ -- | Return the counter associated with the given name and server. -- Multiple calls to 'getCounter' with the same arguments will return -- the same counter. The first time 'getCounter' is called for a@@ -216,25 +287,45 @@ getCounter :: T.Text -- ^ Counter name -> Server -- ^ Server that will serve the counter -> IO Counter-getCounter name server = do- emptyCounter <- Counter.new- counter <- atomicModifyIORef (userCounters server) $ \ m ->- case M.lookup name m of- Nothing -> let m' = M.insert name emptyCounter m- in (m', emptyCounter)- Just counter -> (m, counter)- return counter+getCounter name server = getRef name (userCounters server) +-- | Return the gauge associated with the given name and server.+-- Multiple calls to 'getGauge' with the same arguments will return+-- the same gauge. The first time 'getGauge' is called for a given+-- name and server, a new, zero-initialized gauge will be returned.+getGauge :: T.Text -- ^ Gauge name+ -> Server -- ^ Server that will serve the gauge+ -> IO Gauge+getGauge name server = getRef name (userGauges server)+ ------------------------------------------------------------------------ -- * JSON serialization --- All the stats exported by the server (i.e. GC stats plus user+-- | All the stats exported by the server (i.e. GC stats plus user -- defined counters).-data Stats = Stats !Stats.GCStats ![(T.Text, Int)]+data Stats = Stats+ !Stats.GCStats -- GC statistics+ ![(T.Text, Json)] -- Counters+ ![(T.Text, Json)] -- Gauges+ {-# UNPACK #-} !Double -- Milliseconds since epoch instance A.ToJSON Stats where- toJSON (Stats (Stats.GCStats {..}) cs) = A.object $- [ "bytes_allocated" .= bytesAllocated+ toJSON (Stats gcStats@(Stats.GCStats {..}) counters gauges t) = A.object $+ [ "server_timestamp_millis" .= t+ , "counters" .= Assocs (gcCounters ++ counters)+ , "gauges" .= Assocs (gcGauges ++ gauges)+ ]+ where+ (gcCounters, gcGauges) = partitionGcStats gcStats++-- | 'Stats' encoded as a flattened JSON object.+newtype Combined = Combined Stats++instance A.ToJSON Combined where+ toJSON (Combined (Stats (Stats.GCStats {..}) counters gauges t)) =+ A.object $+ [ "server_timestamp_millis" .= t+ , "bytes_allocated" .= bytesAllocated , "num_gcs" .= numGcs , "max_bytes_used" .= maxBytesUsed , "num_bytes_usage_samples" .= numByteUsageSamples@@ -252,18 +343,45 @@ , "wall_seconds" .= wallSeconds , "par_avg_bytes_copied" .= parAvgBytesCopied , "par_max_bytes_copied" .= parMaxBytesCopied- ] ++ map (\ (k, v) -> k .= v) cs+ ] ++ map (uncurry (.=)) counters +++ map (uncurry (.=)) gauges +-- | A list of string keys and JSON-encodable values. Used to render+-- a list of key-value pairs as a JSON object.+newtype Assocs = Assocs [(T.Text, Json)]++instance A.ToJSON Assocs where+ toJSON (Assocs xs) = A.object $ map (uncurry (.=)) xs++-- | A group of either counters or gauges.+data Group = Group+ ![(T.Text, Json)]+ {-# UNPACK #-} !Double -- Milliseconds since epoch++instance A.ToJSON Group where+ toJSON (Group xs t) =+ A.object $ ("server_timestamp_millis" .= t) : map (uncurry (.=)) xs+ ------------------------------------------------------------------------ -- * HTTP request handler -- | A handler that can be installed into an existing Snap application.-monitor :: IORef Counters -> Snap ()-monitor counters = do+monitor :: IORef Counters -> IORef Gauges -> Snap ()+monitor counters gauges = do dataDir <- liftIO getDataDir route [- ("/", method GET (format "application/json" (serveAll counters)))- , ("/:counter", method GET (format "text/plain" (serveOne counters)))+ ("", method GET (format "application/json"+ (serveAll counters gauges)))+ , ("combined", method GET (format "application/json"+ (serveCombined counters gauges)))+ , ("counters", method GET (format "application/json"+ (serveMany counters)))+ , ("counters/:name", method GET (format "text/plain"+ (serveOne counters)))+ , ("gauges", method GET (format "application/json"+ (serveMany gauges)))+ , ("gauges/:name", method GET (format "text/plain"+ (serveOne gauges))) ] <|> serveDirectory (dataDir </> "assets") @@ -281,9 +399,29 @@ Just hdr | hdr == fmt -> action _ -> pass --- | Serve all counters, as a JSON object.-serveAll :: IORef Counters -> Snap ()-serveAll counters = do+-- | 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 mapRef = do+ m <- readIORef mapRef+ forM (M.toList m) $ \ (name, ref) -> do+ val <- read ref+ return (name, Json val)+{-# INLINABLE readAllRefs #-}++-- | Serve a collection of counters or gauges, as a JSON object.+serveMany :: Ref r => IORef (M.HashMap T.Text r) -> Snap ()+serveMany mapRef = do+ list <- liftIO $ readAllRefs mapRef+ modifyResponse $ setContentType "application/json"+ time <- liftIO getTimeMillis+ 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 req <- getRequest -- Workaround: Snap still matches requests to /foo to this handler -- if the Accept header is "application/json", even though such@@ -291,35 +429,39 @@ unless (S.null $ rqPathInfo req) pass modifyResponse $ setContentType "application/json" gcStats <- liftIO Stats.getGCStats- counterList <- liftIO readAllCounters- writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList- where- -- Get a snapshot of all counter values. Note that we're not- -- guaranteed to see a consistent snapshot if we consider more- -- than one counter at once.- readAllCounters :: IO [(T.Text, Int)]- readAllCounters = do- m <- readIORef counters- forM (M.toList m) $ \ (name, ref) -> do- val <- Counter.read ref- return (name, val)+ counterList <- liftIO $ readAllRefs counters+ gaugeList <- liftIO $ readAllRefs gauges+ time <- liftIO getTimeMillis+ writeLBS $ A.encode $ A.toJSON $ Stats gcStats counterList gaugeList 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+ modifyResponse $ setContentType "application/json"+ gcStats <- liftIO Stats.getGCStats+ counterList <- liftIO $ readAllRefs counters+ gaugeList <- liftIO $ readAllRefs gauges+ time <- liftIO getTimeMillis+ writeLBS $ A.encode $ A.toJSON $ Combined $+ Stats gcStats counterList gaugeList time+ -- | Serve a single counter, as plain text.-serveOne :: IORef Counters -> Snap ()-serveOne counters = do+serveOne :: Ref r => IORef (M.HashMap T.Text r) -> Snap ()+serveOne refs = do modifyResponse $ setContentType "text/plain"- m <- liftIO $ readIORef counters+ m <- liftIO $ readIORef refs req <- getRequest let mname = T.decodeUtf8 <$> join- (listToMaybe <$> Map.lookup "counter" (rqParams req))+ (listToMaybe <$> Map.lookup "name" (rqParams req)) case mname of Nothing -> pass Just name -> case M.lookup name m of Just counter -> do- val <- liftIO $ Counter.read counter+ val <- liftIO $ read counter writeBS $ S8.pack $ show val Nothing ->- -- Try built-in (e.g. GC) counters+ -- Try built-in (e.g. GC) refs case Map.lookup name builtinCounters of Just f -> do gcStats <- liftIO Stats.getGCStats@@ -328,6 +470,7 @@ modifyResponse $ setResponseStatus 404 "Not Found" r <- getResponse finishWith r+{-# INLINABLE serveOne #-} -- | A list of all built-in (e.g. GC) counters, together with a -- pretty-printing function for each.@@ -353,6 +496,40 @@ , ("par_max_bytes_copied" , show . Stats.parMaxBytesCopied) ] +-- Existential wrapper used for OO-style polymorphism.+data Json = forall a. A.ToJSON a => Json a++instance A.ToJSON Json where+ toJSON (Json x) = A.toJSON x++-- | Partition GC statistics into counters and gauges.+partitionGcStats :: Stats.GCStats+ -> ([(T.Text, Json)], [(T.Text, Json)])+partitionGcStats (Stats.GCStats {..}) = (counters, gauges)+ where+ counters = [+ ("bytes_allocated" , Json bytesAllocated)+ , ("num_gcs" , Json numGcs)+ , ("num_bytes_usage_samples" , Json numByteUsageSamples)+ , ("cumulative_bytes_used" , Json cumulativeBytesUsed)+ , ("bytes_copied" , Json bytesCopied)+ , ("mutator_cpu_seconds" , Json mutatorCpuSeconds)+ , ("mutator_wall_seconds" , Json mutatorWallSeconds)+ , ("gc_cpu_seconds" , Json gcCpuSeconds)+ , ("gc_wall_seconds" , Json gcWallSeconds)+ , ("cpu_seconds" , Json cpuSeconds)+ , ("wall_seconds" , Json wallSeconds)+ ]+ gauges = [+ ("max_bytes_used" , Json maxBytesUsed)+ , ("current_bytes_used" , Json currentBytesUsed)+ , ("current_bytes_slop" , Json currentBytesSlop)+ , ("max_bytes_slop" , Json maxBytesSlop)+ , ("peak_megabytes_allocated" , Json peakMegabytesAllocated)+ , ("par_avg_bytes_copied" , Json parAvgBytesCopied)+ , ("par_max_bytes_copied" , Json parMaxBytesCopied)+ ]+ ------------------------------------------------------------------------ -- Utilities for working with accept headers @@ -378,3 +555,10 @@ breakDiscard w s = let (x, y) = S.break (== w) s in (x, S.drop 1 y)++------------------------------------------------------------------------+-- Utilities for working with timestamps++-- | Return the number of milliseconds since epoch.+getTimeMillis :: IO Double+getTimeMillis = (realToFrac . (* 1000)) `fmap` getPOSIXTime
+ assets/cross-16-ns.png view
binary file changed (absent → 737 bytes)
+ assets/dialog_close.png view
binary file changed (absent → 501 bytes)
+ assets/graph-icon.png view
binary file changed (absent → 865 bytes)
assets/index.html view
@@ -8,7 +8,7 @@ <link rel="stylesheet" href="monitor.css" type="text/css"> <script language="javascript" type="text/javascript" src="http://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js"></script> <script language="javascript" type="text/javascript" src="jquery.flot.min.js"></script>- <title>ekg-0.2.0.0</title>+ <title>ekg-0.3.0.0</title> </head> <body> <div class="bar">@@ -24,27 +24,44 @@ </select> | <button id="pause-ui">Pause UI</button> </div>- <span class="title">ekg-0.2.0.0</span>+ <span class="title">ekg-0.3.0.0</span> </div> <div class="container">- <div class="span-16 plots">- <h3>Current residency</h3>- <div id="current-bytes-used-plot" class="plot"></div>+ <div id="message-box" class="icon-alert span-24" style="display: none;">+ Lost connection to server.+ </div> - <h3>Allocation rate</h3>- <div id="allocation-rate-plot" class="plot"></div>+ <div id="plots" class="span-16">++ <div id="current-bytes-used-plot" class="plot-container">+ <h3>Current residency</h3>+ <div class="plot"></div>+ </div>++ <div id="allocation-rate-plot" class="plot-container">+ <h3>Allocation rate</h3>+ <div class="plot"></div>+ </div> - <h3>Productivity</h3>- <div id="productivity-plot" class="plot"></div>+ <div id="productivity-plot" class="plot-container">+ <h3>Productivity</h3>+ <div class="plot"></div>+ </div> </div> <div class="span-8 last">- <h3>GC Stats</h3>+ <h3>GC and memory statistics</h3> <table>+ <thead>+ <tr>+ <th class="span-5">Statistic</th>+ <th class="span-3 last">Value</th>+ </tr>+ </thead> <tbody> <tr>- <td class="span-5">Maximum residency</td>+ <td>Maximum residency</td> <td id="max-bytes-used" class="span-3 value">0</td> </tr> <tr>@@ -76,6 +93,24 @@ <h3>Counters</h3> <table id="counter-table">+ <thead>+ <tr>+ <th class="span-5">Name</th>+ <th class="span-3 last">Value</th>+ </tr>+ </thead>+ <tbody>+ </tbody>+ </table>++ <h3>Gauges</h3>+ <table id="gauge-table">+ <thead>+ <tr>+ <th class="span-5">Name</th>+ <th class="span-3 last">Value</th>+ </tr>+ </thead> <tbody> </tbody> </table>
assets/monitor.css view
@@ -47,6 +47,22 @@ } /**+ * Message box+ *+ * Taken from: http://woork.blogspot.com/2008/03/css-message-box-collection.html+ */++.icon-alert {+ border: solid 1px #CB2026;+ background: #F6CBCA url(cross-16-ns.png) 8px 6px no-repeat;+ color: #D0282A;+ padding: 4px 0;+ text-align: center;+ font-weight: bold;+ margin-bottom: 10px;+}++/** * Plots */ @@ -56,10 +72,20 @@ margin-bottom: 1.5em; } +.close-button {+ float: right;+ cursor: pointer;+}+ /** * Table */ .value { text-align: right;+}++.graph-button {+ cursor: pointer;+ vertical-align: middle; }
assets/monitor.js view
@@ -1,33 +1,52 @@-$(function () {+$(document).ready(function () {+ "use strict";+ // Number formatters- function formatSuffix(val, prec) {- if (val == null)- return "N/A"+ 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 prec = prec || 1;- if (val >= 1000000000)+ function formatSuffix(val, opt_prec) {+ if (val === null) {+ return "N/A";+ }++ var prec = opt_prec || 1;+ if (val >= 1000000000) { return (val / 1000000000).toFixed(prec) + " GB";- else if (val >= 1000000)+ } else if (val >= 1000000) { return (val / 1000000).toFixed(prec) + " MB";- else if (val >= 1000)+ } else if (val >= 1000) { return (val / 1000).toFixed(prec) + " kB";- else+ } else { return val.toFixed(prec) + " B";+ } } function formatRate(val, prec) {- if (val == null)- return "N/A"+ if (val === null) {+ return "N/A";+ } return formatSuffix(val, prec) + "/s"; } - function formatPercent(val, prec) {- if (val == null)- return "N/A"+ function formatPercent(val, opt_prec) {+ if (val === null) {+ return "N/A";+ } - var prec = prec || 1;- return val.toFixed(prec) + " %"+ var prec = opt_prec || 1;+ return val.toFixed(prec) + " %"; } // Set up polling interval control@@ -38,7 +57,7 @@ // Allow the UI to be paused var paused = false;- $('#pause-ui').click(function() {+ $('#pause-ui').click(function () { if (paused) { $(this).text("Pause UI"); paused = false;@@ -53,6 +72,18 @@ return formatSuffix(val, axis.tickDecimals); } + function suffixFormatterGeneric(val, axis) {+ if (val >= 1000000000) {+ return (val / 1000000000).toFixed(axis.tickDecimals) + " G";+ } else if (val >= 1000000) {+ return (val / 1000000).toFixed(axis.tickDecimals) + " M";+ } else if (val >= 1000) {+ return (val / 1000).toFixed(axis.tickDecimals) + " k";+ } else {+ return val.toFixed(axis.tickDecimals);+ }+ }+ function rateFormatter(val, axis) { return formatRate(val, axis.tickDecimals); }@@ -63,19 +94,38 @@ // Fetch data periodically and notify interested parties. var listeners = [];- var fetchData = function() {+ + function subscribe(fn) {+ listeners.push(fn);+ }++ function unsubscribe(fn) {+ listeners = listeners.filter(function (el) {+ if (el !== fn) {+ return el;+ }+ });+ }++ function fetchData() { function onDataReceived(stats) {- var now = new Date().getTime();- for(var i = 0; i < listeners.length; i++)- listeners[i](stats, now);+ $("#message-box").hide();+ for (var i = 0; i < listeners.length; i++) {+ listeners[i](stats, stats.server_timestamp_millis);+ } }- ++ function onError() {+ $("#message-box").show();+ }+ $.ajax({ dataType: 'json', success: onDataReceived,+ error: onError, cache: false });- + setTimeout(fetchData, updateInterval); }; fetchData();@@ -88,26 +138,28 @@ var options = $.extend(true, {}, defaultOptions, opts) var data = new Array(series.length); var maxPoints = 60;- for(var i = 0; i < series.length; i++)+ for(var i = 0; i < series.length; i++) { data[i] = [];+ } var plot = $.plot(elem, [], options); var prev_stats, prev_time; function onDataReceived(stats, time) { for(var i = 0; i < series.length; i++) {- if (data[i].length >= maxPoints)+ if (data[i].length >= maxPoints) { data[i] = data[i].slice(1);- + }+ data[i].push([time, series[i].fn(stats, time, prev_stats, prev_time)]); }- + // zip lengends with data- res = []+ var res = [] for(var i = 0; i < series.length; i++) res.push({ label: series[i].label, data: data[i] });- + if (!paused) { plot.setData(res); plot.setupGrid();@@ -116,8 +168,9 @@ prev_stats = stats; prev_time = time; }- - listeners.push(onDataReceived);++ subscribe(onDataReceived);+ return onDataReceived; } function addCounter(elem, fn, formatter) {@@ -128,69 +181,122 @@ prev_stats = stats; prev_time = time; }- - listeners.push(onDataReceived);++ subscribe(onDataReceived); } - function addDynamicCounters() {+ function addDynamicPlot(key, button, graph_fn, label_fn) {+ function getStats(stats, time, prev_stats, prev_time) {+ return graph_fn(key, stats, time, prev_stats, prev_time);+ }++ $("#plots:last").append(+ '<div id="' + key + '-plot" class="plot-container">' ++ '<img src="dialog_close.png" class="close-button"><h3>' + key ++ '</h3><div class="plot"></div></div>');+ var plot = $("#plots > .plot-container:last > div");+ var observer = addPlot(plot,+ [{ label: label_fn(key), fn: getStats }],+ { yaxis: { tickFormatter: suffixFormatterGeneric } });++ var plotContainer = $("#" + key + "-plot");+ var closeButton = plotContainer.find("img");+ closeButton.hide();+ closeButton.click(function () {+ plotContainer.remove();+ button.show();+ unsubscribe(observer);+ });++ plotContainer.hover(+ function () {+ closeButton.show();+ },+ function () {+ closeButton.hide();+ }+ );+ }++ function addDynamicCounters(table, group_fn, graph_fn, label_fn) { var counters = {}; function onDataReceived(stats, time) {- $.each(stats, function(key, value) {+ $.each(group_fn(stats), function (key, value) { var elem; if (key in counters) { elem = counters[key]; } else { // Add UI element- $("#counter-table > tbody:last").append(- '<tr><td>' + key + '</td><td class="value">N/A</td></tr>');- elem = $("#counter-table > tbody > tr > td:last");+ table.find("tbody:last").append(+ '<tr><td>' + key ++ ' <img src="graph-icon.png" class="graph-button"' ++ ' alt="Add graph" title="Add graph"></td>' ++ '<td class="value">N/A</td></tr>');+ elem = table.find("tbody > tr > td:last"); counters[key] = elem;++ var button = table.find("tbody > tr:last > td:first > img");+ button.click(function () {+ addDynamicPlot(key, button, graph_fn, label_fn);+ $(this).hide();+ }); } if (!paused)- elem.text(value);+ elem.text(commaify(value)); }); } - listeners.push(onDataReceived);+ subscribe(onDataReceived); } - $(document).ready(function() {+ function initAll() { // Metrics- var current_bytes_used = function(stats) { return stats.current_bytes_used };- var max_bytes_used = function(stats) { return stats.max_bytes_used };- var max_bytes_slop = function(stats) { return stats.max_bytes_slop };- var current_bytes_slop = function(stats) { return stats.current_bytes_slop };- var productivity_wall_percent = function(stats, time, prev_stats, prev_time) {+ var current_bytes_used = function (stats) {+ return stats.gauges.current_bytes_used;+ };+ var max_bytes_used = function (stats) {+ return stats.gauges.max_bytes_used;+ };+ var max_bytes_slop = function (stats) {+ return stats.gauges.max_bytes_slop;+ };+ var current_bytes_slop = function (stats) {+ return stats.gauges.current_bytes_slop;+ };+ var productivity_wall_percent = function (stats, time, prev_stats, prev_time) { if (prev_stats == undefined) return null;- var mutator_seconds = stats.mutator_wall_seconds -- prev_stats.mutator_wall_seconds;- var gc_seconds = stats.gc_wall_seconds - prev_stats.gc_wall_seconds;+ var mutator_seconds = stats.counters.mutator_wall_seconds -+ prev_stats.counters.mutator_wall_seconds;+ 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) {+ var productivity_cpu_percent = function (stats, time, prev_stats, prev_time) { if (prev_stats == undefined) return null;- var mutator_seconds = stats.mutator_cpu_seconds -- prev_stats.mutator_cpu_seconds;- var gc_seconds = stats.gc_cpu_seconds - prev_stats.gc_cpu_seconds;+ var mutator_seconds = stats.counters.mutator_cpu_seconds -+ prev_stats.counters.mutator_cpu_seconds;+ 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) {+ var allocation_rate = function (stats, time, prev_stats, prev_time) { if (prev_stats == undefined) return null;- return 1000 * (stats.bytes_allocated - prev_stats.bytes_allocated) /+ return 1000 * (stats.counters.bytes_allocated -+ prev_stats.counters.bytes_allocated) / (time - prev_time); } // Plots- addPlot($("#current-bytes-used-plot"),+ addPlot($("#current-bytes-used-plot > div"), [{ label: "residency", fn: current_bytes_used }], { yaxis: { tickFormatter: suffixFormatter } });- addPlot($("#allocation-rate-plot"),+ addPlot($("#allocation-rate-plot > div"), [{ label: "rate", fn: allocation_rate }], { yaxis: { tickFormatter: rateFormatter } });- addPlot($("#productivity-plot"),+ addPlot($("#productivity-plot > div"), [{ label: "wall clock time", fn: productivity_wall_percent }, { label: "cpu time", fn: productivity_cpu_percent }], { yaxis: { tickDecimals: 1, tickFormatter: percentFormatter } });@@ -204,6 +310,25 @@ addCounter($("#productivity-cpu"), productivity_cpu_percent, formatPercent) addCounter($("#allocation-rate"), allocation_rate, formatRate) - addDynamicCounters();- });+ addDynamicCounters($("#counter-table"), function (stats) {+ return stats.counters;+ }, function (key, stats, time, prev_stats, prev_time) {+ if (prev_stats == undefined)+ return null;+ return 1000 * (stats.counters[key] - prev_stats.counters[key]) /+ (time - prev_time);+ }, function (label) {+ return label + "/s";+ });++ addDynamicCounters($("#gauge-table"), function (stats) {+ return stats.gauges;+ }, function (key, stats, time) {+ return stats.gauges[key];+ }, function (label) {+ return label;+ });+ }++ initAll(); });
ekg.cabal view
@@ -1,5 +1,5 @@ name: ekg-version: 0.2.0.0+version: 0.3.0.0 synopsis: Remote monitoring of processes description: This library lets you remotely monitor a running process over HTTP.@@ -16,14 +16,17 @@ data-files: assets/index.html assets/monitor.js assets/monitor.css assets/jquery.flot.min.js assets/blueprint/screen.css assets/blueprint/print.css assets/blueprint/ie.css- examples/Basic.hs+ assets/dialog_close.png assets/graph-icon.png+ assets/cross-16-ns.png library exposed-modules: System.Remote.Counter+ System.Remote.Gauge System.Remote.Monitoring other-modules: Paths_ekg System.Remote.Counter.Internal+ System.Remote.Gauge.Internal build-depends: aeson < 0.6, base >= 4.5 && < 5,@@ -33,6 +36,7 @@ snap-core < 0.8, snap-server < 0.8, text < 0.12,+ time < 1.5, transformers < 0.3, unordered-containers < 0.2 ghc-options: -Wall
− examples/Basic.hs
@@ -1,24 +0,0 @@-{-# 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 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- let loop n = do- evaluate $ mean [1..n]- threadDelay 2000- Counter.inc counter- loop n- loop 1000000