{-# LANGUAGE OverloadedStrings #-}
module System.Metrics.Json
(
sampleToJson
, valueToJson
, Sample(..)
, Value(..)
) where
import Data.Aeson ((.=))
import qualified Data.Aeson.Types as A
import qualified Data.HashMap.Strict as M
import Data.Int (Int64)
import qualified Data.Text as T
import qualified System.Metrics as Metrics
import qualified System.Metrics.Distribution as Distribution
sampleToJson :: Metrics.Sample -> A.Value
sampleToJson :: Sample -> Value
sampleToJson Sample
metrics =
Sample -> Value -> Value
buildOne Sample
metrics (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Value
A.emptyObject
where
buildOne :: M.HashMap T.Text Metrics.Value -> A.Value -> A.Value
buildOne :: Sample -> Value -> Value
buildOne Sample
m Value
o = (Value -> Text -> Value -> Value) -> Value -> Sample -> Value
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
M.foldlWithKey' Value -> Text -> Value -> Value
build Value
o Sample
m
build :: A.Value -> T.Text -> Metrics.Value -> A.Value
build :: Value -> Text -> Value -> Value
build Value
m Text
name Value
val = Value -> [Text] -> Value -> Value
go Value
m (Text -> Text -> [Text]
T.splitOn Text
"." Text
name) Value
val
go :: A.Value -> [T.Text] -> Metrics.Value -> A.Value
go :: Value -> [Text] -> Value -> Value
go (A.Object Object
m) [Text
str] Value
val = Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
str Value
metric Object
m
where metric :: Value
metric = Value -> Value
valueToJson Value
val
go (A.Object Object
m) (Text
str:[Text]
rest) Value
val = case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
str Object
m of
Maybe Value
Nothing -> Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
str (Value -> [Text] -> Value -> Value
go Value
A.emptyObject [Text]
rest Value
val) Object
m
Just Value
m' -> Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Text
str (Value -> [Text] -> Value -> Value
go Value
m' [Text]
rest Value
val) Object
m
go Value
v [Text]
_ Value
_ = String -> Value -> Value
forall a. String -> Value -> a
typeMismatch String
"Object" Value
v
typeMismatch :: String
-> A.Value
-> a
typeMismatch :: String -> Value -> a
typeMismatch String
expected Value
actual =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"when expecting a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" instead"
where
name :: String
name = case Value
actual of
A.Object Object
_ -> String
"Object"
A.Array Array
_ -> String
"Array"
A.String Text
_ -> String
"String"
A.Number Scientific
_ -> String
"Number"
A.Bool Bool
_ -> String
"Boolean"
Value
A.Null -> String
"Null"
valueToJson :: Metrics.Value -> A.Value
valueToJson :: Value -> Value
valueToJson (Metrics.Counter Int64
n) = Int64 -> MetricType -> Value
forall a. ToJSON a => a -> MetricType -> Value
scalarToJson Int64
n MetricType
CounterType
valueToJson (Metrics.Gauge Int64
n) = Int64 -> MetricType -> Value
forall a. ToJSON a => a -> MetricType -> Value
scalarToJson Int64
n MetricType
GaugeType
valueToJson (Metrics.Label Text
l) = Text -> MetricType -> Value
forall a. ToJSON a => a -> MetricType -> Value
scalarToJson Text
l MetricType
LabelType
valueToJson (Metrics.Distribution Stats
l) = Stats -> Value
distrubtionToJson Stats
l
scalarToJson :: A.ToJSON a => a -> MetricType -> A.Value
scalarToJson :: a -> MetricType -> Value
scalarToJson a
val MetricType
ty = [Pair] -> Value
A.object
[Text
"val" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
val, Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MetricType -> Text
metricType MetricType
ty]
{-# SPECIALIZE scalarToJson :: Int64 -> MetricType -> A.Value #-}
{-# SPECIALIZE scalarToJson :: T.Text -> MetricType -> A.Value #-}
data MetricType =
CounterType
| GaugeType
| LabelType
| DistributionType
metricType :: MetricType -> T.Text
metricType :: MetricType -> Text
metricType MetricType
CounterType = Text
"c"
metricType MetricType
GaugeType = Text
"g"
metricType MetricType
LabelType = Text
"l"
metricType MetricType
DistributionType = Text
"d"
distrubtionToJson :: Distribution.Stats -> A.Value
distrubtionToJson :: Stats -> Value
distrubtionToJson Stats
stats = [Pair] -> Value
A.object
[ Text
"mean" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.mean Stats
stats
, Text
"variance" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.variance Stats
stats
, Text
"count" Text -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Int64
Distribution.count Stats
stats
, Text
"sum" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.sum Stats
stats
, Text
"min" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.min Stats
stats
, Text
"max" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.max Stats
stats
, Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MetricType -> Text
metricType MetricType
DistributionType
]
newtype Sample = Sample Metrics.Sample
deriving Int -> Sample -> String -> String
[Sample] -> String -> String
Sample -> String
(Int -> Sample -> String -> String)
-> (Sample -> String)
-> ([Sample] -> String -> String)
-> Show Sample
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Sample] -> String -> String
$cshowList :: [Sample] -> String -> String
show :: Sample -> String
$cshow :: Sample -> String
showsPrec :: Int -> Sample -> String -> String
$cshowsPrec :: Int -> Sample -> String -> String
Show
instance A.ToJSON Sample where
toJSON :: Sample -> Value
toJSON (Sample Sample
s) = Sample -> Value
sampleToJson Sample
s
newtype Value = Value Metrics.Value
deriving Int -> Value -> String -> String
[Value] -> String -> String
Value -> String
(Int -> Value -> String -> String)
-> (Value -> String) -> ([Value] -> String -> String) -> Show Value
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Value] -> String -> String
$cshowList :: [Value] -> String -> String
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> String -> String
$cshowsPrec :: Int -> Value -> String -> String
Show
instance A.ToJSON Value where
toJSON :: Value -> Value
toJSON (Value Value
v) = Value -> Value
valueToJson Value
v