composite-ekg (empty) → 0.1.1.0

raw patch · 3 files changed

+109/−0 lines, 3 filesdep +Framesdep +basedep +basic-preludesetup-changed

Dependencies added: Frames, base, basic-prelude, composite-base, ekg, ekg-core, lens, text, vinyl

Files

• Setup.hs +2/−0
• composite-ekg.cabal +35/−0
• src/Composite/Ekg.hs +72/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,35 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           composite-ekg+version:        0.1.1.0+synopsis:       EKG Metrics for Vinyl/Frames records+description:    Integration between EKG and Vinyl/Frames records allowing records holding registered metrics to be easily constructed from a type declaration.+category:       Records+homepage:       https://github.com/ConferHealth/composite#readme+author:         Confer Health, Inc+maintainer:     oss@confer.care+copyright:      2017 Confer Health, Inc.+license:        BSD3+build-type:     Simple+cabal-version:  >= 1.10++library+  hs-source-dirs:+      src+  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NoImplicitPrelude OverloadedStrings PolyKinds ScopedTypeVariables StandaloneDeriving StrictData TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns+  ghc-options: -Wall -O2+  build-depends:+      base >= 4.7 && < 5+    , basic-prelude+    , composite-base+    , ekg+    , ekg-core+    , Frames+    , lens+    , text+    , vinyl+  exposed-modules:+      Composite.Ekg+  default-language: Haskell2010

@@ -0,0 +1,72 @@+module Composite.Ekg (EkgMetric(ekgMetric)) where++import BasicPrelude+import Composite.Base (NamedField(fieldName))+import Control.Lens (view, Wrapped(type Unwrapped), _Unwrapped)+import Data.Char (isUpper, toLower)+import qualified Data.Text as Text+import Data.Proxy (Proxy(Proxy))+import Data.Vinyl.Core (Rec((:&), RNil))+import Data.Vinyl.Functor (Identity(Identity))+import Frames (Record, (:->))+import System.Metrics (Store, createCounter, createGauge, createLabel, createDistribution)+import System.Metrics.Counter (Counter)+import System.Metrics.Gauge (Gauge)+import System.Metrics.Label (Label)+import System.Metrics.Distribution (Distribution)++-- |Type class for constructing a configured EKG metric store for record type of named fields+--+-- For example, given:+--+-- > type FActiveUsers    = "activeUsers"           :-> Gauge+-- > type FResponseTimes  = "endpointResponseTimes" :-> Distribution+-- > type FOrdersPlaced   = "ordersPlaced"          :-> Counter+-- > type EkgMetrics = '[FActiveUsers, FResponseTimes, FRevenue]+--+-- And then used in:+--+-- > configureMetrics :: IO (Rec EkgMetrics)+-- > configureMetrics = do+-- >   store <- newStore+-- >   metrics <- ekgMetric "myapp" store+-- >   _ <- forkServerWith store "localhost" 8080+-- >   pure metrics+--+-- Compare to a more traditional:+--+-- > metrics <- EkgMetrics+-- >  <$> createGauge "myapp.active_users store+-- >  <*> createDistribution "myapp.endpoint_response_times" store+-- >  <*> createCounter "myapp.orders_placed" store+--+-- The former is more concise and harder to make naming errors particularly in larger store sets+class EkgMetric a where+  ekgMetric :: Text -> Store -> IO a++instance forall a s rs. (EkgMetric a, EkgMetric (Record rs), NamedField (s :-> a)) => EkgMetric (Record ((s :-> a) ': rs)) where+  ekgMetric prefix store =+    (:&)+      <$> (Identity . view _Unwrapped <$> ekgMetric (prefix <> "." <> (upperScores . fieldName) (Proxy :: Proxy (s :-> a))) store)+      <*> ekgMetric prefix store++instance EkgMetric (Record '[]) where+  ekgMetric _ _ = pure RNil++instance EkgMetric Counter where+  ekgMetric = createCounter++instance EkgMetric Gauge where+  ekgMetric = createGauge++instance EkgMetric Label where+  ekgMetric = createLabel++instance EkgMetric Distribution where+  ekgMetric = createDistribution++upperScores :: Text -> Text+upperScores = Text.dropWhile (== '_') . Text.concatMap score+  where score :: Char -> Text+        score c | isUpper c = "_" <> Text.singleton (toLower c)+        score c = Text.singleton c