diff --git a/System/Metrics.hs b/System/Metrics.hs index 8b41cff..79b9a73 100644 --- a/System/Metrics.hs +++ b/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,6 +627,7 @@ 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) @@ -611,6 +635,7 @@ 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 diff --git a/System/Metrics/Heartbeat.hs b/System/Metrics/Heartbeat.hs new file mode 100644 index 0000000..f4ab82f --- /dev/null +++ b/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 diff --git a/ekg-core.cabal b/ekg-core.cabal index 4b8492b..9969aef 100644 --- a/ekg-core.cabal +++ b/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