Move the JSON encoding into a separate ekg-json package
This commit is contained in:
parent
9fa806dfb6
commit
3889e2a1a0
2 changed files with 8 additions and 94 deletions
|
@ -1,5 +1,3 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module System.Remote.Json
|
module System.Remote.Json
|
||||||
(
|
(
|
||||||
encodeAll
|
encodeAll
|
||||||
|
@ -7,102 +5,17 @@ module System.Remote.Json
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson.Encode as A
|
import qualified Data.Aeson.Encode as A
|
||||||
import qualified Data.Aeson.Types as A
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.HashMap.Strict as M
|
|
||||||
import Data.Int (Int64)
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Prelude hiding (read)
|
|
||||||
|
|
||||||
import System.Metrics
|
import System.Metrics
|
||||||
import qualified System.Metrics.Distribution as Distribution
|
import qualified System.Metrics.Json as Json
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
-- | Encode metrics as nested JSON objects. See 'Json.sampleToJson'
|
||||||
-- * JSON serialization
|
-- for a description of the encoding.
|
||||||
|
|
||||||
data MetricType =
|
|
||||||
CounterType
|
|
||||||
| GaugeType
|
|
||||||
| LabelType
|
|
||||||
| DistributionType
|
|
||||||
|
|
||||||
metricType :: MetricType -> T.Text
|
|
||||||
metricType CounterType = "c"
|
|
||||||
metricType GaugeType = "g"
|
|
||||||
metricType LabelType = "l"
|
|
||||||
metricType DistributionType = "d"
|
|
||||||
|
|
||||||
-- | 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
|
|
||||||
--
|
|
||||||
-- > {
|
|
||||||
-- > "foo": {
|
|
||||||
-- > "bar": {
|
|
||||||
-- > "type:", "c",
|
|
||||||
-- > "val": 10
|
|
||||||
-- > },
|
|
||||||
-- > "baz": {
|
|
||||||
-- > "type": "l",
|
|
||||||
-- > "val": "label"
|
|
||||||
-- > }
|
|
||||||
-- > }
|
|
||||||
-- > }
|
|
||||||
--
|
|
||||||
encodeAll :: Sample -> L.ByteString
|
encodeAll :: Sample -> L.ByteString
|
||||||
encodeAll metrics =
|
encodeAll = A.encode . Json.sampleToJson
|
||||||
A.encode $ buildOne metrics $ A.emptyObject
|
|
||||||
where
|
|
||||||
buildOne :: M.HashMap T.Text Value -> A.Value -> A.Value
|
|
||||||
buildOne m o = M.foldlWithKey' build o m
|
|
||||||
|
|
||||||
build :: A.Value -> T.Text -> Value -> A.Value
|
|
||||||
build m name val = go m (T.splitOn "." name) val
|
|
||||||
|
|
||||||
go :: A.Value -> [T.Text] -> Value -> A.Value
|
|
||||||
go (A.Object m) [str] val = A.Object $ M.insert str metric m
|
|
||||||
where metric = buildOneM 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
|
|
||||||
|
|
||||||
buildOneM :: Value -> A.Value
|
|
||||||
buildOneM (Counter n) = goOne n CounterType
|
|
||||||
buildOneM (Gauge n) = goOne n GaugeType
|
|
||||||
buildOneM (Label l) = goOne l LabelType
|
|
||||||
buildOneM (Distribution l) = goDistribution l
|
|
||||||
|
|
||||||
goDistribution :: Distribution.Stats -> A.Value
|
|
||||||
goDistribution stats = A.object [
|
|
||||||
("mean", A.toJSON $! Distribution.mean stats),
|
|
||||||
("variance", A.toJSON $! Distribution.variance stats),
|
|
||||||
("count", A.toJSON $! Distribution.count stats),
|
|
||||||
("sum", A.toJSON $! Distribution.sum stats),
|
|
||||||
("min", A.toJSON $! Distribution.min stats),
|
|
||||||
("max", A.toJSON $! Distribution.max stats),
|
|
||||||
("type", A.toJSON (metricType DistributionType))]
|
|
||||||
|
|
||||||
goOne :: A.ToJSON a => a -> MetricType -> A.Value
|
|
||||||
goOne val ty = A.object [
|
|
||||||
("val", A.toJSON val), ("type", A.toJSON (metricType ty))]
|
|
||||||
{-# SPECIALIZE goOne :: Int64 -> MetricType -> A.Value #-}
|
|
||||||
{-# SPECIALIZE goOne :: T.Text -> MetricType -> A.Value #-}
|
|
||||||
|
|
||||||
|
-- | Encode metric a JSON object. See 'Json.valueToJson'
|
||||||
|
-- for a description of the encoding.
|
||||||
encodeOne :: Value -> L.ByteString
|
encodeOne :: Value -> L.ByteString
|
||||||
encodeOne = A.encode . buildOneM
|
encodeOne = A.encode . Json.valueToJson
|
||||||
|
|
||||||
typeMismatch :: String -- ^ The expected type
|
|
||||||
-> A.Value -- ^ The actual value encountered
|
|
||||||
-> a
|
|
||||||
typeMismatch expected actual =
|
|
||||||
error $ "when expecting a " ++ expected ++ ", encountered " ++ name ++
|
|
||||||
" instead"
|
|
||||||
where
|
|
||||||
name = case actual of
|
|
||||||
A.Object _ -> "Object"
|
|
||||||
A.Array _ -> "Array"
|
|
||||||
A.String _ -> "String"
|
|
||||||
A.Number _ -> "Number"
|
|
||||||
A.Bool _ -> "Boolean"
|
|
||||||
A.Null -> "Null"
|
|
||||||
|
|
|
@ -41,6 +41,7 @@ library
|
||||||
base >= 4.5 && < 4.9,
|
base >= 4.5 && < 4.9,
|
||||||
bytestring < 1.0,
|
bytestring < 1.0,
|
||||||
ekg-core >= 0.1 && < 0.2,
|
ekg-core >= 0.1 && < 0.2,
|
||||||
|
ekg-json >= 0.1 && < 0.2,
|
||||||
filepath < 1.5,
|
filepath < 1.5,
|
||||||
network < 2.7,
|
network < 2.7,
|
||||||
snap-core < 0.10,
|
snap-core < 0.10,
|
||||||
|
|
Loading…
Reference in a new issue