summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhaskellworks <>2018-12-06 01:05:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-12-06 01:05:00 (GMT)
commitb120b6749c1272a0f1c2e38d9c6d84f6f68d56a1 (patch)
tree36d831e580ed0cf7c39474f2d45839994cb9a770
parent4442ccc2924d329e9c69b16b7b4ed85fa47991cd (diff)
version 1.0.0HEAD1.0.0master
-rw-r--r--arbor-monad-metric-datadog.cabal12
-rw-r--r--src/Arbor/Monad/Metric/Datadog.hs43
-rw-r--r--src/Arbor/Monad/Metric/Datadog/Internal.hs14
-rw-r--r--src/Arbor/Monad/Metric/Datadog/Internal/Show.hs4
-rw-r--r--test/Arbor/Monad/Datadog/MetricSpec.hs31
5 files changed, 68 insertions, 36 deletions
diff --git a/arbor-monad-metric-datadog.cabal b/arbor-monad-metric-datadog.cabal
index 479b42c..07cae91 100644
--- a/arbor-monad-metric-datadog.cabal
+++ b/arbor-monad-metric-datadog.cabal
@@ -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 @@ source-repository head
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 @@ library
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 @@ test-suite arbor-monad-metric-datadog-test
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 @@ test-suite arbor-monad-metric-datadog-test
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
diff --git a/src/Arbor/Monad/Metric/Datadog.hs b/src/Arbor/Monad/Metric/Datadog.hs
index bece201..d08dc8b 100644
--- a/src/Arbor/Monad/Metric/Datadog.hs
+++ b/src/Arbor/Monad/Metric/Datadog.hs
@@ -7,57 +7,54 @@ module Arbor.Monad.Metric.Datadog
, 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
diff --git a/src/Arbor/Monad/Metric/Datadog/Internal.hs b/src/Arbor/Monad/Metric/Datadog/Internal.hs
new file mode 100644
index 0000000..d64a6d8
--- /dev/null
+++ b/src/Arbor/Monad/Metric/Datadog/Internal.hs
@@ -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
diff --git a/src/Arbor/Monad/Metric/Datadog/Internal/Show.hs b/src/Arbor/Monad/Metric/Datadog/Internal/Show.hs
new file mode 100644
index 0000000..fddc00c
--- /dev/null
+++ b/src/Arbor/Monad/Metric/Datadog/Internal/Show.hs
@@ -0,0 +1,4 @@
+module Arbor.Monad.Metric.Datadog.Internal.Show where
+
+showInt :: Int -> String
+showInt = show
diff --git a/test/Arbor/Monad/Datadog/MetricSpec.hs b/test/Arbor/Monad/Datadog/MetricSpec.hs
index 151bddd..3097f7e 100644
--- a/test/Arbor/Monad/Datadog/MetricSpec.hs
+++ b/test/Arbor/Monad/Datadog/MetricSpec.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
@@ -6,16 +8,19 @@ module Arbor.Monad.Datadog.MetricSpec
) 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 @@ handler tMsgs addr msg = do
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 @@ spec = describe "Arbor.Monad.MetricSpec" $ do
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"
+ ]