arbor-monad-metric-datadog 0.0.3 → 1.0.0

raw patch · 5 files changed

+68/−36 lines, 5 filesdep ~arbor-monad-metricdep ~containersnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: arbor-monad-metric, containers

API changes (from Hackage documentation)

Files

• arbor-monad-metric-datadog.cabal +8/−4
• src/Arbor/Monad/Metric/Datadog.hs +20/−23
• src/Arbor/Monad/Metric/Datadog/Internal.hs +14/−0
• src/Arbor/Monad/Metric/Datadog/Internal/Show.hs +4/−0
• test/Arbor/Monad/Datadog/MetricSpec.hs +22/−9

@@ -1,5 +1,5 @@ name:           arbor-monad-metric-datadog-version:        0.0.3+version:        1.0.0 description:    Please see the README on Github at <https://github.com/arbor/arbor-monad-metric-datadog#readme> synopsis:       Metric library backend for datadog. category:       Metrics@@ -23,6 +23,8 @@ library   exposed-modules:       Arbor.Monad.Metric.Datadog+      Arbor.Monad.Metric.Datadog.Internal+      Arbor.Monad.Metric.Datadog.Internal.Show   other-modules:       Paths_arbor_monad_metric_datadog   hs-source-dirs:@@ -32,7 +34,7 @@   build-depends:       base                          >= 4.7      && < 5     , arbor-datadog                 >= 0.0.0    && < 0.1-    , arbor-monad-metric            >= 0.0.2    && < 0.1+    , arbor-monad-metric            >= 1.1.0    && < 1.2     , bytestring                    >= 0.10.8   && < 0.11     , containers                    >= 0.5.10   && < 0.6     , generic-lens                  >= 1.0.0.2  && < 1.2@@ -49,10 +51,12 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Arbor.Monad.Metric.Datadog       Arbor.Monad.Datadog.MetricApp       Arbor.Monad.Datadog.MetricSpec       Arbor.Monad.Datadog.UdpServer+      Arbor.Monad.Metric.Datadog+      Arbor.Monad.Metric.Datadog.Internal+      Arbor.Monad.Metric.Datadog.Internal.Show       Paths_arbor_monad_metric_datadog   hs-source-dirs:       test@@ -62,7 +66,7 @@   build-depends:       base                          >= 4.7      && < 5     , arbor-datadog                 >= 0.0.0    && < 0.1-    , arbor-monad-metric            >= 0.0.2    && < 0.1+    , arbor-monad-metric     , arbor-monad-metric-datadog     , bytestring                    >= 0.10.8   && < 0.11     , containers                    >= 0.5.10   && < 0.6

@@ -7,57 +7,54 @@   , mkEvent   ) where -import Arbor.Monad.Metric.Type   (Counter (..), Gauge (..), MonadMetrics, getMetricMapTVar)+import Arbor.Monad.Metric.Datadog.Internal+import Arbor.Monad.Metric.Datadog.Internal.Show+import Arbor.Monad.Metric.Type                  (Counter, Gauge, MonadMetrics, getMetricMapTVar) import Control.Lens import Control.Monad.IO.Class import Data.Foldable import Data.Generics.Product.Any import Data.Proxy-import Data.Semigroup            ((<>))+import Data.Semigroup                           ((<>))  import qualified Arbor.Monad.Metric        as C import qualified Arbor.Network.StatsD      as S import qualified Arbor.Network.StatsD.Type as Z import qualified Control.Concurrent.STM    as STM import qualified Data.Map.Strict           as M+import qualified Data.Set                  as S import qualified Data.Text                 as T  logStats :: (S.MonadStats m, MonadMetrics m) => m () logStats = do   tCounterMap <- getMetricMapTVar   (counters, _)  <- liftIO . STM.atomically $ STM.swapTVar tCounterMap M.empty >>= C.extractValues (Proxy @Counter)-  traverse_ S.sendMetric $ mkMetricsCounterTagged "counters" counters-  traverse_ S.sendMetric $ mkMetricsCounterNonTagged counters+  traverse_ S.sendMetric $ mkMetricsCounter counters    tGaugeMap <- getMetricMapTVar   (gauge, _)  <- liftIO . STM.atomically $ STM.swapTVar tGaugeMap M.empty >>= C.extractValues (Proxy @Gauge)-  traverse_ S.sendMetric $ mkMetricsGaugeTagged "gauge" gauge-  traverse_ S.sendMetric $ mkMetricsGaugeNonTagged gauge+  traverse_ S.sendMetric $ mkMetricsGauge gauge  metricName :: String -> T.Text metricName n = T.replace " " "_" (T.pack n) --- create metric m, but tag with stat:[actual stat name]-mkMetricsGaugeTagged :: String -> [(Gauge, Double)] -> [Z.Metric]-mkMetricsGaugeTagged m =-  fmap (\(Gauge n, i) -> S.gauge (Z.MetricName (metricName m)) id i & the @"tags" %~ ([S.tag "stat" (T.pack n)] ++))- -- create metrics for each counter-mkMetricsGaugeNonTagged :: [(Gauge, Double)] -> [S.Metric]-mkMetricsGaugeNonTagged =-  fmap (\(Gauge n, i) -> S.gauge (Z.MetricName (metricName n)) id i)---- create metric m, but tag with stat:[actual stat name]-mkMetricsCounterTagged :: String -> [(Counter, Int)] -> [Z.Metric]-mkMetricsCounterTagged m =-  fmap (\(Counter n, i) -> S.addCounter (Z.MetricName (metricName m)) id i & the @"tags" %~ ([S.tag "stat" (T.pack n)] ++))+mkMetricsGauge :: [(Gauge, Double)] -> [S.Metric]+mkMetricsGauge = fmap (uncurry mkGauge)+  where mkGauge :: Gauge -> Double -> S.Metric+        mkGauge g v = S.gauge (Z.MetricName (metricName (T.unpack name))) id v & the @"tags" .~ (toStat <$> tags)+          where name = g ^. the @"name"+                tags = g ^. the @"tags" & S.toList  -- create metrics for each counter-mkMetricsCounterNonTagged :: [(Counter, Int)] -> [S.Metric]-mkMetricsCounterNonTagged =-  fmap (\(Counter n, i) -> S.addCounter (Z.MetricName (metricName n)) id i)+mkMetricsCounter :: [(Counter, Int)] -> [S.Metric]+mkMetricsCounter = fmap (uncurry mkCounter)+  where mkCounter :: Counter -> Int -> S.Metric+        mkCounter g v = S.addCounter (Z.MetricName (metricName (T.unpack name))) id v & the @"tags" .~ (toStat <$> tags)+          where name = g ^. the @"name"+                tags = g ^. the @"tags" & S.toList  mkEvent :: [(String, Int)] -> String -> Z.Tag -> String -> Z.Event mkEvent stats etitle etag fn = S.event (T.pack etitle) desc & the @"tags" %~ ([etag] ++)   where desc = T.intercalate "\n" $ T.pack <$> ("File processed: " <> fn) : info-        info = (\(n, i) -> n <> ": " <> show i) <$> stats+        info = (\(n, i) -> n <> ": " <> showInt i) <$> stats

@@ -0,0 +1,14 @@+{-# LANGUAGE TypeFamilies #-}++module Arbor.Monad.Metric.Datadog.Internal where++import qualified Arbor.Monad.Metric.Type as M+import qualified Arbor.Network.StatsD    as S++class ToStat a where+  type StatType a+  toStat :: a -> StatType a++instance ToStat M.Tag where+  type StatType M.Tag = S.Tag+  toStat (M.Tag n v) = S.tag n v

@@ -0,0 +1,4 @@+module Arbor.Monad.Metric.Datadog.Internal.Show where++showInt :: Int -> String+showInt = show

@@ -1,3 +1,5 @@+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications    #-} @@ -6,16 +8,19 @@   ) where  import Control.Concurrent-import Control.Exception      (bracket)+import Control.Exception         (bracket)+import Control.Lens+import Control.Monad import Control.Monad.IO.Class+import Data.Function+import Data.Generics.Product.Any import Data.Proxy-import Data.Semigroup         ((<>))+import Data.Semigroup            ((<>))  import qualified Arbor.Monad.Datadog.MetricApp as A import qualified Arbor.Monad.Datadog.UdpServer as UDP import qualified Arbor.Monad.Metric            as M import qualified Arbor.Monad.Metric.Datadog    as M-import qualified Arbor.Monad.Metric.Type       as M import qualified Control.Concurrent.STM        as STM import qualified Data.ByteString.Char8         as BS import qualified Data.Map.Strict               as MAP@@ -36,6 +41,9 @@   STM.atomically $ STM.modifyTVar tMsgs (msg:)   putStrLn $ "From " ++ show addr ++ ": " ++ show msg +encodeMetrics :: [BS.ByteString] -> [BS.ByteString]+encodeMetrics = (:[]) . mconcat . fmap (<> "\n")+ spec :: Spec spec = describe "Arbor.Monad.MetricSpec" $ do   it "Metrics library actually sends statsd messages over UDP" $ requireTest $ do@@ -43,13 +51,18 @@     sock <- liftIO $ UDP.createUdpServer "5555"     threadId <- liftIO $ forkIO $ UDP.runUdpServer sock (handler tMessages)     liftIO $ threadDelay 1000000-    let counterExpected = "MetricApp.counters:10|c|#stat:test.counter\nMetricApp.test.counter:10|c\n" :: BS.ByteString-    let gaugeExpected = "MetricApp.gauge:20.000000|g|#stat:test.gauge\nMetricApp.test.gauge:20.000000|g\n" :: BS.ByteString+    -- let counterExpected = "MetricApp.counters:10|c|#stat:test.counter\nMetricApp.test.counter:10|c\n" :: BS.ByteString+    -- let gaugeExpected = "MetricApp.gauge:20.000000|g|#stat:test.gauge\nMetricApp.test.gauge:20.000000|g\n" :: BS.ByteString     liftIO $ A.runMetricApp $ do-      M.metric (M.Counter "test.counter") 10-      M.metric (M.Gauge   "test.gauge"  ) 20+      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       M.logStats     liftIO $ threadDelay 3000000     liftIO $ killThread threadId-    messages <- liftIO $ STM.readTVarIO tMessages-    messages === [counterExpected <> gaugeExpected]+    messages :: [BS.ByteString] <- liftIO $ STM.readTVarIO tMessages+    mconcat (BS.lines <$> messages) ===+      [ "MetricApp.test.counter:10|c"+      , "MetricApp.test.gauge:20.000000|g"+      , "MetricApp.test.gauge:30.000000|g|#foo:bar"+      ]