arbor-monad-metric 1.0.0 → 1.1.0

raw patch · 7 files changed

+138/−21 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• arbor-monad-metric.cabal +6/−1
• src/Arbor/Monad/Metric.hs +11/−12
• src/Arbor/Monad/Metric/Api/String.hs +33/−0
• src/Arbor/Monad/Metric/Api/Text.hs +33/−0
• src/Arbor/Monad/Metric/Type.hs +8/−2
• test/Arbor/Monad/MetricApp.hs +39/−0
• test/Arbor/Monad/MetricSpec.hs +8/−6

@@ -1,5 +1,5 @@ name:           arbor-monad-metric-version:        1.0.0+version:        1.1.0 description:    Please see the README on Github at <https://github.com/arbor/arbor-monad-metric#readme> synopsis:       Core metric library for publishing metrics. category:       Metrics@@ -23,6 +23,8 @@ library   exposed-modules:       Arbor.Monad.Metric+      Arbor.Monad.Metric.Api.String+      Arbor.Monad.Metric.Api.Text       Arbor.Monad.Metric.Generic       Arbor.Monad.Metric.Type   other-modules:@@ -48,8 +50,11 @@   main-is: Spec.hs   other-modules:       Arbor.Monad.Metric+      Arbor.Monad.Metric.Api.String+      Arbor.Monad.Metric.Api.Text       Arbor.Monad.Metric.Generic       Arbor.Monad.Metric.Type+      Arbor.Monad.MetricApp       Arbor.Monad.MetricSpec       Paths_arbor_monad_metric   hs-source-dirs:

@@ -4,23 +4,28 @@ module Arbor.Monad.Metric   ( MonadMetrics   , Z.getMetrics-  , metric-  , Counter(..)-  , Gauge(..)-  , Metrics(..)   , newMetricsIO   , extractValues +  , metric++  , Counter+  , Gauge+  , Metrics+  , Tag+   , counter   , gauge+  , tag+  , tags   ) where +import Arbor.Monad.Metric.Api.Text import Arbor.Monad.Metric.Generic  (metric)-import Arbor.Monad.Metric.Type     (Counter, Gauge, MetricFamily (..), MetricMap, Metrics (Metrics), MonadMetrics)+import Arbor.Monad.Metric.Type     (Counter, Gauge, MetricFamily (..), MetricMap, Metrics (Metrics), MonadMetrics, Tag) import Control.Concurrent.STM.TVar import Control.Monad.STM           (STM) import Data.Proxy-import Data.Text                   (Text)  import qualified Arbor.Monad.Metric.Type as Z import qualified Control.Concurrent.STM  as STM@@ -41,9 +46,3 @@   let tvars = M.elems m   nums <- fmap (metricStateToValue pk <$>) . sequence $ readTVar <$> tvars   return (zip names nums, tvars)--counter :: Text -> Counter-counter name = Z.Counter name []--gauge :: Text -> Gauge-gauge name = Z.Gauge name []

@@ -0,0 +1,33 @@+module Arbor.Monad.Metric.Api.String+  ( Counter+  , Gauge+  , Tag++  , tags+  , tag+  , counter+  , gauge+  ) where++import Arbor.Monad.Metric.Type (Counter, Gauge, Tag)+import Data.Bifunctor+import Data.Set                (Set)++import qualified Arbor.Monad.Metric.Api.Text as T+import qualified Data.Text                   as T++counter :: String -> Counter+counter = T.counter . T.pack+{-# INLINE counter #-}++gauge :: String -> Gauge+gauge = T.gauge . T.pack+{-# INLINE gauge #-}++tag :: String -> String -> Tag+tag name value = T.tag (T.pack name) (T.pack value)+{-# INLINE tag #-}++tags :: [(String, String)] -> Set Tag+tags = T.tags . fmap (bimap T.pack T.pack)+{-# INLINE tags #-}

@@ -0,0 +1,33 @@+module Arbor.Monad.Metric.Api.Text+  ( Counter+  , Gauge+  , Tag++  , tags+  , tag+  , counter+  , gauge+  ) where++import Arbor.Monad.Metric.Type (Counter, Gauge, Tag)+import Data.Set                (Set)+import Data.Text               (Text)++import qualified Arbor.Monad.Metric.Type as Z+import qualified Data.Set                as S++counter :: Text -> Counter+counter name = Z.Counter name S.empty+{-# INLINE counter #-}++gauge :: Text -> Gauge+gauge name = Z.Gauge name S.empty+{-# INLINE gauge #-}++tag :: Text -> Text -> Tag+tag = Z.Tag+{-# INLINE tag #-}++tags :: [(Text, Text)] -> Set Tag+tags nvs = S.fromList (uncurry tag <$> nvs)+{-# INLINE tags #-}

@@ -21,15 +21,21 @@  import qualified Control.Concurrent.STM as STM import qualified Data.Map.Strict        as M+import qualified Data.Set               as S +data Tag = Tag+  { name  :: Text+  , value :: Text+  } deriving (Eq, Ord, Show, Generic)+ data Counter = Counter   { name :: Text-  , tags :: [Text]+  , tags :: S.Set Tag   } deriving (Eq, Ord, Show, Generic)  data Gauge = Gauge   { name :: Text-  , tags :: [Text]+  , tags :: S.Set Tag   } deriving (Eq, Ord, Show, Generic)  type MetricMap k v = M.Map k (STM.TVar v)

@@ -0,0 +1,39 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}++module Arbor.Monad.MetricApp+  ( runMetricApp+  ) where++import Arbor.Monad.Metric+import Control.Monad.Reader+import Data.Generics.Product.Any+import GHC.Generics++import qualified Arbor.Network.StatsD      as S+import qualified Arbor.Network.StatsD.Type as Z++newtype MiniConfig = MiniConfig+  { metrics     :: Metrics+  } deriving (Generic)++instance MonadMetrics MetricApp where+  getMetrics = reader metrics++newtype MetricApp a = MetricApp+  { unMetricApp :: ReaderT MiniConfig IO a+  }+  deriving  ( Functor+            , Applicative+            , Monad+            , MonadIO+            , MonadReader MiniConfig)++runMetricApp :: MetricApp a -> IO a+runMetricApp f = do+  metrics <- newMetricsIO+  let config = MiniConfig metrics+  runReaderT (unMetricApp f) config

@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds             #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE TypeApplications      #-}  module Arbor.Monad.MetricSpec@@ -21,6 +22,7 @@ import qualified Control.Concurrent.STM    as STM import qualified Data.ByteString.Char8     as BS import qualified Data.Map.Strict           as M+import qualified Data.Set                  as S import qualified Network.Socket            as S hiding (recv, recvFrom, send, sendTo) import qualified Network.Socket.ByteString as S @@ -36,9 +38,9 @@ spec = describe "Arbor.Monad.MetricSpec" $ do   it "Metrics library actually tracks metrics it receives" $ requireTest $ do     metrics <- liftIO $ A.runMetricApp $ do-      M.metric (M.counter "test.counter"                        ) 10-      M.metric (M.gauge   "test.gauge"                          ) 20-      M.metric (M.gauge   "test.gauge"  & the @"tags" .~ ["foo"]) 30+      M.metric (M.counter "test.counter"                                        ) 10+      M.metric (M.gauge   "test.gauge"                                          ) 20+      M.metric (M.gauge   "test.gauge"  & the @"tags" .~ M.tags [("foo", "bar")]) 30       MT.getMetrics      countersMap <- liftIO $ STM.readTVarIO $ metrics ^. the @"counters"@@ -47,9 +49,9 @@     counters  <- liftIO $ STM.atomically $ fst <$> M.extractValues @MT.Counter Proxy countersMap     gauges    <- liftIO $ STM.atomically $ fst <$> M.extractValues @MT.Gauge   Proxy gaugesMap -    counters ===  [ (M.counter "test.counter"                         , 10)+    counters ===  [ (M.counter "test.counter"                                         , 10)                   ] -    gauges   ===  [ (M.gauge   "test.gauge"                           , 20)-                  , (M.gauge   "test.gauge"  & the @"tags" .~ ["foo"] , 30)+    gauges   ===  [ (M.gauge   "test.gauge"                                           , 20)+                  , (M.gauge   "test.gauge"  & the @"tags" .~ M.tags [("foo", "bar")] , 30)                   ]