From b2b7c9b421abc7ab1b45b23690113ae51fffec05 Mon Sep 17 00:00:00 2001 From: Johan Tibell Date: Fri, 31 Jul 2015 11:58:28 +0100 Subject: [PATCH] Initial import of code from the ekg package The code was moved from the System.Remote.Json module with minimal modifications. --- .gitignore | 12 ++++ LICENSE | 30 +++++++++ Setup.hs | 2 + System/Metrics/Json.hs | 137 +++++++++++++++++++++++++++++++++++++++++ ekg-json.cabal | 32 ++++++++++ 5 files changed, 213 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 Setup.hs create mode 100644 System/Metrics/Json.hs create mode 100644 ekg-json.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8916e10 --- /dev/null +++ b/.gitignore @@ -0,0 +1,12 @@ +*.hi +*.o +*.p_hi +*.prof +*.tix +.DS_Store +.cabal-sandbox/ +.hpc/ +/dist/* +cabal.config +cabal.sandbox.config +examples/Basic diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..85db1ae --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Johan Tibell + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Johan Tibell nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Metrics/Json.hs b/System/Metrics/Json.hs new file mode 100644 index 0000000..a4cc25d --- /dev/null +++ b/System/Metrics/Json.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Encoding of metrics as JSON. The encoding defined by the +-- functions in this module are standardized and used by the ekg web +-- UI. The purpose of this module is to let other web servers and +-- frameworks than the one used by the ekg package expose ekg metrics. +module System.Metrics.Json + ( -- * Converting metrics to JSON values + sampleToJson + , valueToJson + + -- ** Newtype wrappers with instances + , Sample(..) + , Value(..) + ) where + +import Data.Aeson ((.=)) +import qualified Data.Aeson.Encode as A +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 + +------------------------------------------------------------------------ +-- * Converting metrics to JSON values + + +-- | 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" +-- > } +-- > } +-- > } +-- +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 + + build :: A.Value -> T.Text -> Metrics.Value -> A.Value + build m name val = go m (T.splitOn "." name) 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 + +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" + +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 + +-- | 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 #-} + +data MetricType = + CounterType + | GaugeType + | LabelType + | DistributionType + +metricType :: MetricType -> T.Text +metricType CounterType = "c" +metricType GaugeType = "g" +metricType LabelType = "l" +metricType DistributionType = "d" + +-- | Convert a distribution to a JSON value. +distrubtionToJson :: Distribution.Stats -> A.Value +distrubtionToJson 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 + ] + +------------------------------------------------------------------------ +-- ** Newtype wrappers with instances + +-- | Newtype wrapper that provides a 'A.ToJSON' instances for the +-- underlying 'Metrics.Sample' without creating an orphan instance. +newtype Sample = Sample Metrics.Sample + deriving Show + +-- | Uses 'sampleToJson'. +instance A.ToJSON Sample where + toJSON (Sample s) = sampleToJson s + +-- | Newtype wrapper that provides a 'A.ToJSON' instances for the +-- underlying 'Metrics.Value' without creating an orphan instance. +newtype Value = Value Metrics.Value + deriving Show + +-- | Uses 'valueToJson'. +instance A.ToJSON Value where + toJSON (Value v) = valueToJson v diff --git a/ekg-json.cabal b/ekg-json.cabal new file mode 100644 index 0000000..8409260 --- /dev/null +++ b/ekg-json.cabal @@ -0,0 +1,32 @@ +name: ekg-json +version: 0.1.0.0 +synopsis: JSON encoding of ekg metrics +description: + Encodes ekg metrics as JSON, using the same encoding as used by the + ekg package, thus allowing ekg metrics to be served by other HTTP + servers than the one used by the ekg package. +homepage: https://github.com/tibbe/ekg-json +bug-reports: https://github.com/tibbe/ekg-json/issues +license: BSD3 +license-file: LICENSE +author: Johan Tibell +maintainer: johan.tibell@gmail.com +category: Distribution +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: + System.Metrics.Json + build-depends: + aeson < 0.11, + base >= 4.5 && < 4.9, + ekg-core >= 0.1 && < 0.2, + text < 1.3, + unordered-containers < 0.3 + + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/tibbe/ekg-json.git