monad-metrics-0.1.0.0: src/Control/Monad/Metrics.hs
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-|
Module : Control.Monad.Metrics
Description : An easy interface to recording metrics.
Copyright : (c) Matt Parsons, 2017
Taylor Fausak, 2016
License : MIT
Maintainer : parsonsmatt@gmail.com
Stability : experimental
Portability : POSIX
This module presents an easy interface that you can use to collect metrics about your application.
It uses EKG under the hood and is inspired by Taylor Fausak's blunt application.
This module is designed to be imported qualified.
-}
module Control.Monad.Metrics
( -- * The Type Class
MonadMetrics(..)
-- * Initializing
, Metrics
, initialize
, initializeWith
-- * Collecting Metrics
, increment
, counter
, counter'
, gauge
, gauge'
, distribution
, timed
, timed'
, label
, label'
, Resolution(..)
) where
import Control.Monad (liftM)
import Data.Monoid (mempty)
import Control.Monad.IO.Class
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import System.Clock (Clock (..), TimeSpec (..),
getTime)
import qualified System.Metrics as EKG
import System.Metrics.Counter as Counter
import System.Metrics.Distribution as Distribution
import System.Metrics.Gauge as Gauge
import System.Metrics.Label as Label
import Prelude
import Control.Monad.Metrics.Internal
-- | A class is an instance of 'MonadMetrics' if it can provide a 'Metrics'
-- somehow. Commonly, this will be implemented as a 'ReaderT' where some
-- field in the environment is the 'Metrics' data.
--
-- Since v0.1.0.0
class MonadMetrics m where
getMetrics :: m Metrics
-- | Initializes a 'Metrics' value with the given 'System.Metrics.Store'.
--
-- Since 0.1.0.0
initializeWith :: EKG.Store -> IO Metrics
initializeWith metricsStore = do
metricsCounters <- newIORef mempty
metricsDistributions <- newIORef mempty
metricsGauges <- newIORef mempty
metricsLabels <- newIORef mempty
return Metrics{..}
-- | Initializes a 'Metrics' value, creating a new 'System.Metrics.Store'
-- for it.
--
-- Since v0.1.0.0
initialize :: IO Metrics
initialize = EKG.newStore >>= initializeWith
-- | Increment the named counter by 1.
--
-- Since v0.1.0.0
increment :: (MonadIO m, MonadMetrics m) => Text -> m ()
increment name = counter name 1
-- | Adds the value to the named 'System.Metrics.Counter.Counter'.
--
-- Since v0.1.0.0
counter' :: (MonadIO m, MonadMetrics m, Integral int) => Text -> int -> m ()
counter' =
modifyMetric Counter.add fromIntegral EKG.createCounter metricsCounters
-- | A type specialized version of 'counter'' to avoid ambiguous type
-- errors.
--
-- Since v0.1.0.0
counter :: (MonadIO m, MonadMetrics m) => Text -> Int -> m ()
counter = counter'
-- | Add the value to the named 'System.Metrics.Distribution.Distribution'.
--
-- Since v0.1.0.0
distribution :: (MonadIO m, MonadMetrics m) => Text -> Double -> m ()
distribution =
modifyMetric Distribution.add id EKG.createDistribution metricsDistributions
-- | Set the value of the named 'System.Metrics.Distribution.Gauge'.
--
-- Since v0.1.0.0
gauge' :: (MonadIO m, MonadMetrics m, Integral int) => Text -> int -> m ()
gauge' =
modifyMetric Gauge.set fromIntegral EKG.createGauge metricsGauges
-- | A type specialized version of 'gauge'' to avoid ambiguous types.
--
-- Since v0.1.0.0
gauge :: (MonadIO m, MonadMetrics m) => Text -> Int -> m ()
gauge = gauge'
-- | Record the time taken to perform the named action. The number is
-- stored in a 'System.Metrics.Disribution.Distribution' and is converted
-- to the specified 'Resolution'.
--
-- Since v0.1.0.0
timed' :: (MonadIO m, MonadMetrics m) => Resolution -> Text -> m a -> m a
timed' resolution name action = do
start <- liftIO $ getTime Monotonic
result <- action
end <- liftIO $ getTime Monotonic
distribution name (diffTime resolution start end)
return result
-- | Record the time of executing the given action in seconds. Defers to
-- 'timed''.
--
-- Since v0.1.0.0
timed :: (MonadIO m, MonadMetrics m) => Text -> m a -> m a
timed = timed' Seconds
label :: (MonadIO m, MonadMetrics m) => Text -> Text -> m ()
label = modifyMetric Label.set id EKG.createLabel metricsLabels
label' :: (MonadIO m, MonadMetrics m, Show a) => Text -> a -> m ()
label' l = label l . Text.pack . show
-------------------------------------------------------------------------------
diffTime :: Resolution -> TimeSpec -> TimeSpec -> Double
diffTime res (TimeSpec seca nseca) (TimeSpec secb nsecb) =
let sec = seca - secb
nsec = nseca - nsecb
in convertTimeSpecTo res (TimeSpec sec nsec)
convertTimeSpecTo :: Resolution -> TimeSpec -> Double
convertTimeSpecTo res (TimeSpec secs' nsecs') =
case res of
Nanoseconds -> nsecs + sToNs secs
Microseconds -> nsToUs nsecs + sToUs secs
Milliseconds -> nsToMs nsecs + sToMs secs
Seconds -> nsToS nsecs + secs
Minutes -> sToMin (nsToS nsecs + secs)
Hours -> sToHour (nsToS nsecs + secs)
Days -> sToDay (nsToS nsecs + secs)
where
nsecs = fromIntegral nsecs'
secs = fromIntegral secs'
nsToUs, nsToMs, nsToS, sToMin, sToHour, sToDay, sToNs, sToUs, sToMs :: Double -> Double
nsToUs = (/ 10^3)
nsToMs = (/ 10^6)
nsToS = (/ 10^9)
sToMin = (/ 60)
sToHour = sToMin . sToMin
sToDay = (/ 24) . sToHour
sToNs = (* 10^9)
sToUs = (* 10^6)
sToMs = (* 10^3)
modifyMetric
:: (MonadMetrics m, MonadIO m)
=> (t -> t1 -> IO b) -- ^ The action to add a value to a metric.
-> (t2 -> t1) -- ^ A conversion function from input to metric value.
-> (Text -> EKG.Store -> IO t) -- ^ The function for creating a new metric.
-> (Metrics -> IORef (Map Text t)) -- ^ A way of getting the current metrics.
-> Text -- ^ The name of the metric to use.
-> t2 -- ^ The value the end user can provide.
-> m b
modifyMetric adder converter creator getter name value = do
bar <- lookupOrCreate getter creator name
liftIO $ adder bar (converter value)
lookupOrCreate
:: (MonadMetrics m, MonadIO m, Ord k)
=> (Metrics -> IORef (Map k a)) -> (k -> EKG.Store -> IO a) -> k -> m a
lookupOrCreate getter creator name = do
ref <- liftM getter getMetrics
container <- liftIO $ readIORef ref
case Map.lookup name container of
Nothing -> do
c <- liftIO . creator name =<< liftM metricsStore getMetrics
liftIO $ modifyIORef ref (Map.insert name c)
return c
Just c -> return c