From b981da9b21a7b874c56677f3dab869a3e7f24591 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Sat, 3 Feb 2018 20:35:29 +0100 Subject: [PATCH 1/2] Add Dimensional wrapper for metrics. Breaking change: the Sample type now holds dimensions as key-value pairs. --- System/Metrics.hs | 90 ++++++++++++++++++++++++++++++----- System/Metrics/Dimensional.hs | 88 ++++++++++++++++++++++++++++++++++ ekg-core.cabal | 1 + 3 files changed, 168 insertions(+), 11 deletions(-) create mode 100644 System/Metrics/Dimensional.hs diff --git a/System/Metrics.hs b/System/Metrics.hs index 4daf71d..b6baa5a 100644 --- a/System/Metrics.hs +++ b/System/Metrics.hs @@ -49,6 +49,7 @@ module System.Metrics , registerLabel , registerDistribution , registerGroup + , registerDimensional -- ** Convenience functions -- $convenience @@ -56,6 +57,10 @@ module System.Metrics , createGauge , createLabel , createDistribution + , createDimensionalCounter + , createDimensionalGauge + , createDimensionalLabel + , createDimensionalDistribution -- ** Predefined metrics -- $predefined @@ -70,7 +75,9 @@ module System.Metrics import Control.Applicative ((<$>)) import Control.Monad (forM) +import Data.Either (partitionEithers) import Data.Int (Int64) +import Data.Monoid ((<>)) import qualified Data.IntMap.Strict as IM import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) import qualified Data.HashMap.Strict as M @@ -86,6 +93,8 @@ import System.Metrics.Gauge (Gauge) import qualified System.Metrics.Gauge as Gauge import System.Metrics.Label (Label) import qualified System.Metrics.Label as Label +import System.Metrics.Dimensional (Dimensional) +import qualified System.Metrics.Dimensional as Dimensional -- $naming -- Compound metric names should be separated using underscores. @@ -137,6 +146,7 @@ data MetricSampler = CounterS !(IO Int64) | GaugeS !(IO Int64) | LabelS !(IO T.Text) | DistributionS !(IO Distribution.Stats) + | DimensionalS !Dimensional.Dimensions !(IO (M.HashMap Dimensional.Point Value)) -- | Create a new, empty metric store. newStore :: IO Store @@ -192,6 +202,16 @@ registerDistribution registerDistribution name sample store = register name (DistributionS sample) store +-- | Registers a dimensional metric. +registerDimensional + :: Dimensional a + -> (a -> IO Value) -- ^ Function to sample the dimensional metric to a Value. + -> Store -- ^ Metric store + -> IO () +registerDimensional d f store = + let x = readIORef (Dimensional._points d) >>= traverse f in + register (Dimensional._name d) (DimensionalS (Dimensional._dimensions d) x) store + register :: T.Text -> MetricSampler -> Store @@ -323,6 +343,48 @@ createDistribution name store = do registerDistribution name (Distribution.read event) store return event +-- | Create and register a zero-initialized dimensional counter. +createDimensionalCounter :: T.Text -- ^ Counter name + -> Store -- ^ Metric store + -> Dimensional.Dimensions -- ^ Dimension names. + -> IO (Dimensional Counter) +createDimensionalCounter name store dims = do + counter <- Dimensional.newDimensional Counter.new name "" dims + registerDimensional counter (fmap Counter . Counter.read) store + return counter + +-- | Create and register a zero-initialized dimensional gauge. +createDimensionalGauge :: T.Text -- ^ Gauge name + -> Store -- ^ Metric store + -> Dimensional.Dimensions -- ^ Dimension names. + -> IO (Dimensional Gauge) +createDimensionalGauge name store dims = do + gauge <- Dimensional.newDimensional Gauge.new name "" dims + registerDimensional gauge (fmap Gauge . Gauge.read) store + return gauge + +-- | Create and register a zero-initialized dimensional label. +createDimensionalLabel :: T.Text -- ^ Label name + -> Store -- ^ Metric store + -> Dimensional.Dimensions -- ^ Dimension names. + -> IO (Dimensional Label) +createDimensionalLabel name store dims = do + label <- Dimensional.newDimensional Label.new name "" dims + registerDimensional label (fmap Label . Label.read) store + return label + +-- | Create and register a zero-initialized dimensional distribution. +createDimensionalDistribution :: T.Text -- ^ Distribution name + -> Store -- ^ Metric store + -> Dimensional.Dimensions -- ^ Dimension names. + -> IO (Dimensional Distribution) +createDimensionalDistribution name store dims = do + distribution <- Dimensional.newDimensional Distribution.new name "" dims + registerDimensional distribution (fmap Distribution . Distribution.read) store + return distribution + + + ------------------------------------------------------------------------ -- * Predefined metrics @@ -512,7 +574,7 @@ gcParTotBytesCopied = Stats.parAvgBytesCopied -- metrics atomically. -- | A sample of some metrics. -type Sample = M.HashMap T.Text Value +type Sample = M.HashMap (T.Text, [(T.Text, T.Text)]) Value -- | Sample all metrics. Sampling is /not/ atomic in the sense that -- some metrics might have been mutated before they're sampled but @@ -523,9 +585,10 @@ sampleAll store = do let metrics = stateMetrics state groups = stateGroups state cbSample <- sampleGroups $ IM.elems groups - sample <- readAllRefs metrics - let allSamples = sample ++ cbSample - return $! M.fromList allSamples + (dimSamples, sample) <- partitionEithers <$> readAllRefs metrics + let noDimSamples = [((k,[]),v) | (k,v) <- sample ++ cbSample] + let flatDimSamples = [ ((k,zip ds dvs),v) | (k, ds, pointVals) <- dimSamples, (dvs,v) <- pointVals] + return $! M.fromList (noDimSamples ++ flatDimSamples) -- | Sample all metric groups. sampleGroups :: [GroupSampler] -> IO [(T.Text, Value)] @@ -543,17 +606,22 @@ data Value = Counter {-# 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 (DistributionS m) = Distribution <$> m +type Value2 = Either (Dimensional.Dimensions, [(Dimensional.Point, Value)]) Value + +sampleOne :: MetricSampler -> IO Value2 +sampleOne (CounterS m) = Right . Counter <$> m +sampleOne (GaugeS m) = Right . Gauge <$> m +sampleOne (LabelS m) = Right . Label <$> m +sampleOne (DistributionS m) = Right . Distribution <$> m +sampleOne (DimensionalS dims m) = Left . (\pairs -> (dims, pairs)) . M.toList <$> m -- | Get a snapshot of all values. Note that we're not guaranteed to -- see a consistent snapshot of the whole map. readAllRefs :: M.HashMap T.Text (Either MetricSampler GroupId) - -> IO [(T.Text, Value)] + -> IO [Either (T.Text, Dimensional.Dimensions, [(Dimensional.Point, Value)]) (T.Text, Value)] readAllRefs m = do forM ([(name, ref) | (name, Left ref) <- M.toList m]) $ \ (name, ref) -> do val <- sampleOne ref - return (name, val) + return $ case val of + Left (dims, pairs) -> Left (name, dims, pairs) + Right v -> Right (name, v) diff --git a/System/Metrics/Dimensional.hs b/System/Metrics/Dimensional.hs new file mode 100644 index 0000000..78fb80d --- /dev/null +++ b/System/Metrics/Dimensional.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +module System.Metrics.Dimensional where + +import qualified System.Metrics.Counter as Counter +import qualified System.Metrics.Distribution as Distribution +import qualified System.Metrics.Gauge as Gauge +import qualified System.Metrics.Label as Label + +import Prelude hiding (lookup) +import GHC.Exception (Exception) +import Control.Exception (throwIO) +import Data.Text (Text) +import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) +import Data.HashMap.Strict (HashMap, empty) +import qualified Data.HashMap.Strict as HashMap + +type Name = Text +type Explanation = Text +type Dimensions = [Text] +type Point = [Text] + +data Dimensional a = Dimensional { + _create :: !(IO a) + , _name :: !Name + , _explanation :: !Explanation + , _dimensions :: !Dimensions + , _points :: !(IORef (HashMap Point a)) + } + +newDimensional :: IO a -> Name -> Explanation -> Dimensions -> IO (Dimensional a) +newDimensional new name explanation dimensions = + Dimensional new name explanation dimensions <$> newIORef empty + +data DimensionError + = DimensionError !Name !Dimensions !Point + deriving (Show, Ord, Eq) +instance Exception DimensionError + +data LookupFailure + = UnmatchedDimensions DimensionError + | NotFound + deriving (Show, Ord, Eq) + +lookup :: Dimensional a -> Point -> IO (Either LookupFailure a) +lookup d pt + | not $ matchDimensions (_dimensions d) pt = pure $ Left (UnmatchedDimensions err) + | otherwise = do + toLookupResult . HashMap.lookup pt <$> readIORef (_points d) + where + err :: DimensionError + err = DimensionError (_name d) (_dimensions d) pt + + toLookupResult Nothing = Left NotFound + toLookupResult (Just x) = Right x + +matchDimensions :: Dimensions -> Point -> Bool +matchDimensions ds ps = length ds == length ps + +create :: Dimensional a -> Point -> IO a +create d pt + | not $ matchDimensions (_dimensions d) pt = throwIO err + | otherwise = do + v <- _create d + atomicModifyIORef' (_points d) (\store -> (HashMap.insert pt v store, ())) + return v + where + err :: DimensionError + err = DimensionError (_name d) (_dimensions d) pt + +lookupOrCreate :: Dimensional a -> Point -> IO a +lookupOrCreate d pt = lookup d pt >>= \case + Left NotFound -> create d pt + Left (UnmatchedDimensions err) -> throwIO err + Right x -> return x + +type Counter = Dimensional Counter.Counter +type Gauge = Dimensional Gauge.Gauge +type Label = Dimensional Label.Label +type Distribution = Dimensional Distribution.Distribution + +example :: IO () +example = do + c <- newDimensional Counter.new "foo" "a foo" ["url", "status"] + let url = "/hello" + let status = "200" + x <- lookupOrCreate c [url, status] + Counter.inc x diff --git a/ekg-core.cabal b/ekg-core.cabal index f4287df..3c62a76 100644 --- a/ekg-core.cabal +++ b/ekg-core.cabal @@ -20,6 +20,7 @@ library exposed-modules: System.Metrics System.Metrics.Counter + System.Metrics.Dimensional System.Metrics.Distribution System.Metrics.Distribution.Internal System.Metrics.Gauge From 9ee1cb60c7dba7642327f1443a4f43d19a390b72 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Sat, 3 Feb 2018 20:59:58 +0100 Subject: [PATCH 2/2] Version bump. --- ekg-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ekg-core.cabal b/ekg-core.cabal index 3c62a76..1dba3a4 100644 --- a/ekg-core.cabal +++ b/ekg-core.cabal @@ -1,5 +1,5 @@ name: ekg-core -version: 0.1.1.3 +version: 0.2.0.0 synopsis: Tracking of system metrics description: This library lets you defined and track system metrics.