Add support for time-since-last-action heartbeat metrics

System/Metrics.hs

@@ -47,6 +47,7 @@ module System.Metrics
     , registerCounter
     , registerGauge
     , registerLabel
+    , registerHeartbeat
     , registerDistribution
     , registerGroup
 
@@ -55,6 +56,7 @@ module System.Metrics
     , createCounter
     , createGauge
     , createLabel
+    , createHeartbeat
     , createDistribution
 
       -- ** Predefined metrics
@@ -84,6 +86,8 @@ 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.Heartbeat (Heartbeat)
+import qualified System.Metrics.Heartbeat as Heartbeat
 import System.Metrics.Label (Label)
 import qualified System.Metrics.Label as Label
 
@@ -136,6 +140,7 @@ data GroupSampler = forall a. GroupSampler
 data MetricSampler = CounterS !(IO Int64)
                    | GaugeS !(IO Int64)
                    | LabelS !(IO T.Text)
+                   | HeartbeatS !(IO Int64)
                    | DistributionS !(IO Distribution.Stats)
 
 -- | Create a new, empty metric store.
@@ -181,6 +186,15 @@ registerLabel :: T.Text     -- ^ Label name
 registerLabel name sample store =
     register name (LabelS sample) store
 
+-- | Register a heartbeat metric. The provided action to read the value
+-- must be thread-safe. Also see 'createHeartbeat'.
+registerHeartbeat :: T.Text     -- ^ Label name
+                  -> IO Int64 -- ^ Action to read the current metric value
+                  -> Store      -- ^ Metric store
+                  -> IO ()
+registerHeartbeat name sample store =
+    register name (HeartbeatS sample) store
+
 -- | Register a distribution metric. The provided action to read the
 -- value must be thread-safe. Also see 'createDistribution'.
 registerDistribution
@@ -314,6 +328,15 @@ createLabel name store = do
     registerLabel name (Label.read label) store
     return label
 
+-- | Create and register heartbeat initialized to the current time.
+createHeartbeat :: T.Text  -- ^ Label name
+            -> Store   -- ^ Metric store
+            -> IO Heartbeat
+createHeartbeat name store = do
+    heartbeat <- Heartbeat.new
+    registerHeartbeat name (Heartbeat.read heartbeat) store
+    return heartbeat
+
 -- | Create and register an event tracker.
 createDistribution :: T.Text  -- ^ Distribution name
                    -> Store   -- ^ Metric store
@@ -604,13 +627,15 @@ sampleGroups cbSamplers = concat `fmap` sequence (map runOne cbSamplers)
 data Value = Counter {-# UNPACK #-} !Int64
            | Gauge {-# UNPACK #-} !Int64
            | Label {-# UNPACK #-} !T.Text
+           | Heartbeat {-# UNPACK #-} !Int64
            | Distribution !Distribution.Stats
            deriving (Eq, Show)
 
 sampleOne :: MetricSampler -> IO Value
 sampleOne (CounterS m)      = Counter <$> m
 sampleOne (GaugeS m)        = Gauge <$> m
 sampleOne (LabelS m)        = Label <$> m
+sampleOne (HeartbeatS m)    = Heartbeat <$> m
 sampleOne (DistributionS m) = Distribution <$> m
 
 -- | Get a snapshot of all values.  Note that we're not guaranteed to

System/Metrics/Heartbeat.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE BangPatterns #-}
+-- | This module defines a type for mutable heartbeat times.
+-- Heartbeats can be used to track the time elapsed since a critical
+-- operation was last performed. All operations on heartbeasts are thread-safe.
+module System.Metrics.Heartbeat
+    (
+      Heartbeat
+    , new
+    , read
+    , set
+    , reset
+    ) where
+
+import           Data.Int        (Int64)
+import           Data.IORef      (IORef, atomicWriteIORef, newIORef, readIORef)
+import           Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
+import           Prelude         hiding (read)
+
+-- | A mutable time of last execution.
+newtype Heartbeat = C (IORef UTCTime)
+
+-- | Create a new heartbeat, with the time-of-last execution as the
+-- creation time of the heartbeat.
+new :: IO Heartbeat
+new = do
+  now <- getCurrentTime
+  C `fmap` newIORef now
+
+-- | Get the number of seconds since the last time the heartbeat was
+-- reset.
+read :: Heartbeat -> IO Int64
+read (C ref) = do
+  lastHeartbeat <- readIORef ref
+  now           <- getCurrentTime
+  let since     =  now `diffUTCTime` lastHeartbeat
+
+  return $ round since
+
+-- | Set the time of last execution to the given value.
+set :: Heartbeat -> UTCTime -> IO ()
+set (C ref) !t = atomicWriteIORef ref t
+
+-- | Reset the heartbeat using the current time.
+reset :: Heartbeat -> IO ()
+reset heartbeat = getCurrentTime >>= set heartbeat

ekg-core.cabal

@@ -24,6 +24,7 @@ library
     System.Metrics.Distribution
     System.Metrics.Distribution.Internal
     System.Metrics.Gauge
+    System.Metrics.Heartbeat
     System.Metrics.Label
 
   other-modules:
@@ -36,6 +37,7 @@ library
     base >= 4.6 && < 4.12,
     containers >= 0.5 && < 0.6,
     text < 1.3,
+    time > 1.0 && < 2.0,
     unordered-containers < 0.3
 
   default-language:    Haskell2010