From c170382ea775c8668ed22f51e1acf887dd47c4d6 Mon Sep 17 00:00:00 2001 From: Lucas DiCioccio Date: Thu, 20 Apr 2017 19:50:47 +0000 Subject: [PATCH] Adapt ToJSON instance for tagged dimensions. --- System/Metrics/Json.hs | 103 +++++++++++++++++++++++++++-------------- ekg-json.cabal | 7 +-- 2 files changed, 72 insertions(+), 38 deletions(-) diff --git a/System/Metrics/Json.hs b/System/Metrics/Json.hs index 03a5b84..32168fe 100644 --- a/System/Metrics/Json.hs +++ b/System/Metrics/Json.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | Encoding of ekg metrics as JSON. The encoding defined by the @@ -14,6 +15,7 @@ module System.Metrics.Json , Value(..) ) where +import qualified Data.Vector as Vec import Data.Aeson ((.=)) import qualified Data.Aeson.Encode as A import qualified Data.Aeson.Types as A @@ -28,19 +30,37 @@ import qualified System.Metrics.Distribution as Distribution -- | Encode metrics as nested JSON objects. Each "." in the metric --- name introduces a new level of nesting. For example, the metrics --- @[("foo.bar", 10), ("foo.baz", "label")]@ are encoded as +-- name (i.e., the first tag) introduces a new level of nesting. For example, +-- the metrics @[("foo.bar":[], 10), ("foo.baz":["dim0:1","dim1:hello"], "label-abc"), ("foo.baz":["dim0:1","dim1:world"], "label-def") ]@ are +-- encoded as -- -- > { -- > "foo": { --- > "bar": { --- > "type:", "c", --- > "val": 10 --- > }, --- > "baz": { --- > "type": "l", --- > "val": "label" --- > } +-- > "bar": [ +-- > { +-- > "type": "c", +-- > "val": 10, +-- > "dims": [] +-- > }, +-- > ], +-- > "baz": [ +-- > { +-- > "type": "l", +-- > "val": "label-abc", +-- > "dims": [ +-- > "dim0:1", +-- > "dim1:hello" +-- > ] +-- > }, +-- > { +-- > "type": "l", +-- > "val": "label-def", +-- > "dims": [ +-- > "dim0:1", +-- > "dim1:world" +-- > ] +-- > } +-- > ] -- > } -- > } -- @@ -48,19 +68,27 @@ sampleToJson :: Metrics.Sample -> A.Value sampleToJson metrics = buildOne metrics $ A.emptyObject where - buildOne :: M.HashMap T.Text Metrics.Value -> A.Value -> A.Value - buildOne m o = M.foldlWithKey' build o m + buildOne :: M.HashMap Metrics.Tags Metrics.Value -> A.Value -> A.Value + buildOne m o = M.foldlWithKey' build o m -- need to "group by" first tag - build :: A.Value -> T.Text -> Metrics.Value -> A.Value - build m name val = go m (T.splitOn "." name) val + build :: A.Value -> Metrics.Tags -> Metrics.Value -> A.Value + build m tags val = + go m (T.splitOn "." $ Metrics.name tags) (Metrics.dimensions tags) val - go :: A.Value -> [T.Text] -> Metrics.Value -> A.Value - go (A.Object m) [str] val = A.Object $ M.insert str metric m - where metric = valueToJson val - go (A.Object m) (str:rest) val = case M.lookup str m of - Nothing -> A.Object $ M.insert str (go A.emptyObject rest val) m - Just m' -> A.Object $ M.insert str (go m' rest val) m - go v _ _ = typeMismatch "Object" v + go :: A.Value -> [T.Text] -> [T.Text] -> Metrics.Value -> A.Value + go v@(A.Object m) [str] dims val = + A.Object $ M.alter f str m + where + f Nothing = Just . A.Array $ Vec.fromList [valueToJson dims val] + f (Just (A.Array arr)) = Just . A.Array $ Vec.cons (valueToJson dims val) arr + + go (A.Object m) (str:rest) dims val = + A.Object $ M.alter f str m + where + f Nothing = Just $ go A.emptyObject rest dims val + f (Just obj) = Just $ go obj rest dims val + + go v _ _ _ = typeMismatch "Object" v typeMismatch :: String -- ^ The expected type -> A.Value -- ^ The actual value encountered @@ -81,22 +109,26 @@ typeMismatch expected actual = -- -- > { -- > "type": "c", --- > "val": 89460 +-- > "val": 89460, +-- > "dims": [ +-- > "some-dim" +-- > ] -- > } -- -valueToJson :: Metrics.Value -> A.Value -valueToJson (Metrics.Counter n) = scalarToJson n CounterType -valueToJson (Metrics.Gauge n) = scalarToJson n GaugeType -valueToJson (Metrics.Label l) = scalarToJson l LabelType -valueToJson (Metrics.Distribution l) = distrubtionToJson l +valueToJson :: [T.Text] -> Metrics.Value -> A.Value +valueToJson dims = \case + (Metrics.Counter n) -> scalarToJson dims n CounterType + (Metrics.Gauge n) -> scalarToJson dims n GaugeType + (Metrics.Label l) -> scalarToJson dims l LabelType + (Metrics.Distribution l) -> distrubtionToJson dims l -- | Convert a scalar metric (i.e. counter, gauge, or label) to a JSON -- value. -scalarToJson :: A.ToJSON a => a -> MetricType -> A.Value -scalarToJson val ty = A.object - ["val" .= val, "type" .= metricType ty] -{-# SPECIALIZE scalarToJson :: Int64 -> MetricType -> A.Value #-} -{-# SPECIALIZE scalarToJson :: T.Text -> MetricType -> A.Value #-} +scalarToJson :: A.ToJSON a => [T.Text] -> a -> MetricType -> A.Value +scalarToJson dims val ty = A.object + ["val" .= val, "type" .= metricType ty, "dims" .= dims] +{-# SPECIALIZE scalarToJson :: [T.Text] -> Int64 -> MetricType -> A.Value #-} +{-# SPECIALIZE scalarToJson :: [T.Text] -> T.Text -> MetricType -> A.Value #-} data MetricType = CounterType @@ -111,8 +143,8 @@ metricType LabelType = "l" metricType DistributionType = "d" -- | Convert a distribution to a JSON value. -distrubtionToJson :: Distribution.Stats -> A.Value -distrubtionToJson stats = A.object +distrubtionToJson :: [T.Text] -> Distribution.Stats -> A.Value +distrubtionToJson dims stats = A.object [ "mean" .= Distribution.mean stats , "variance" .= Distribution.variance stats , "count" .= Distribution.count stats @@ -120,6 +152,7 @@ distrubtionToJson stats = A.object , "min" .= Distribution.min stats , "max" .= Distribution.max stats , "type" .= metricType DistributionType + , "dims" .= dims ] ------------------------------------------------------------------------ @@ -141,4 +174,4 @@ newtype Value = Value Metrics.Value -- | Uses 'valueToJson'. instance A.ToJSON Value where - toJSON (Value v) = valueToJson v + toJSON (Value v) = valueToJson [] v diff --git a/ekg-json.cabal b/ekg-json.cabal index 5f749cd..6c0744a 100644 --- a/ekg-json.cabal +++ b/ekg-json.cabal @@ -1,5 +1,5 @@ name: ekg-json -version: 0.1.0.4 +version: 0.2.0.1 synopsis: JSON encoding of ekg metrics description: Encodes ekg metrics as JSON, using the same encoding as used by the @@ -22,9 +22,10 @@ library build-depends: aeson >=0.4 && < 1.2, base >= 4.5 && < 4.10, - ekg-core >= 0.1 && < 0.2, + ekg-core >= 0.2 && < 0.3, text < 1.3, - unordered-containers < 0.3 + unordered-containers < 0.3, + vector >= 0.11 && < 0.12 default-language: Haskell2010