{-# 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 metrics :: 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 m :: Sample
m o :: 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 m :: Value
m name :: Text
name val :: Value
val = Value -> [Text] -> Value -> Value
go Value
m (Text -> Text -> [Text]
T.splitOn "." Text
name) Value
val
go :: A.Value -> [T.Text] -> Metrics.Value -> A.Value
go :: Value -> [Text] -> Value -> Value
go (A.Object m :: Object
m) [str :: Text
str] val :: 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 m :: Object
m) (str :: Text
str:rest :: [Text]
rest) val :: 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
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 m' :: 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 v :: Value
v _ _ = String -> Value -> Value
forall a. String -> Value -> a
typeMismatch "Object" Value
v
typeMismatch :: String
-> A.Value
-> a
typeMismatch :: String -> Value -> a
typeMismatch expected :: String
expected actual :: Value
actual =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "when expecting a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
" instead"
where
name :: String
name = case Value
actual of
A.Object _ -> "Object"
A.Array _ -> "Array"
A.String _ -> "String"
A.Number _ -> "Number"
A.Bool _ -> "Boolean"
A.Null -> "Null"
valueToJson :: Metrics.Value -> A.Value
valueToJson :: Value -> Value
valueToJson (Metrics.Counter n :: Int64
n) = Int64 -> MetricType -> Value
forall a. ToJSON a => a -> MetricType -> Value
scalarToJson Int64
n MetricType
CounterType
valueToJson (Metrics.Gauge n :: Int64
n) = Int64 -> MetricType -> Value
forall a. ToJSON a => a -> MetricType -> Value
scalarToJson Int64
n MetricType
GaugeType
valueToJson (Metrics.Label l :: Text
l) = Text -> MetricType -> Value
forall a. ToJSON a => a -> MetricType -> Value
scalarToJson Text
l MetricType
LabelType
valueToJson (Metrics.Distribution l :: Stats
l) = Stats -> Value
distrubtionToJson Stats
l
scalarToJson :: A.ToJSON a => a -> MetricType -> A.Value
scalarToJson :: a -> MetricType -> Value
scalarToJson val :: a
val ty :: MetricType
ty = [Pair] -> Value
A.object
["val" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
val, "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 CounterType = "c"
metricType GaugeType = "g"
metricType LabelType = "l"
metricType DistributionType = "d"
distrubtionToJson :: Distribution.Stats -> A.Value
distrubtionToJson :: Stats -> Value
distrubtionToJson stats :: Stats
stats = [Pair] -> Value
A.object
[ "mean" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.mean Stats
stats
, "variance" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.variance Stats
stats
, "count" Text -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Int64
Distribution.count Stats
stats
, "sum" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.sum Stats
stats
, "min" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.min Stats
stats
, "max" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Stats -> Double
Distribution.max Stats
stats
, "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 s :: 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 v :: Value
v) = Value -> Value
valueToJson Value
v