Adapt ToJSON instance for tagged dimensions.

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,39 +30,65 @@ 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"
+-- >         ]
+-- >       }
+-- >     ]
 -- >   }
 -- > }
 --
 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,15 +143,16 @@ 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
     , "sum" .= Distribution.sum stats
     , "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

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