summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhaskellworks <>2018-12-05 23:12:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-12-05 23:12:00 (GMT)
commit8ae8c8a12c49e43282fc41b84ff903888ceae7ad (patch)
tree32600ec762674990c51982b93bedeb7dbe1ef003
parent9e5b53408ba2b6a7bcb4988b349da87d592ff7a8 (diff)
version 1.0.01.0.0
-rw-r--r--arbor-monad-metric.cabal7
-rw-r--r--src/Arbor/Monad/Metric.hs12
-rw-r--r--src/Arbor/Monad/Metric/Type.hs15
-rw-r--r--test/Arbor/Monad/MetricSpec.hs49
-rw-r--r--test/Arbor/Monad/UdpServer.hs36
5 files changed, 57 insertions, 62 deletions
diff --git a/arbor-monad-metric.cabal b/arbor-monad-metric.cabal
index 71375e3..ed53882 100644
--- a/arbor-monad-metric.cabal
+++ b/arbor-monad-metric.cabal
@@ -1,5 +1,5 @@
name: arbor-monad-metric
-version: 0.0.4
+version: 1.0.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
@@ -39,6 +39,7 @@ library
, mtl >= 2.2.2 && < 2.3
, resourcet >= 1.2.1 && < 1.3
, stm >= 2.4.0 && < 2.6
+ , text >= 1.2.3 && < 1.3
, transformers >= 0.5.2 && < 0.6
default-language: Haskell2010
@@ -46,11 +47,10 @@ test-suite arbor-monad-metric-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
- Arbor.Monad.MetricSpec
- Arbor.Monad.UdpServer
Arbor.Monad.Metric
Arbor.Monad.Metric.Generic
Arbor.Monad.Metric.Type
+ Arbor.Monad.MetricSpec
Paths_arbor_monad_metric
hs-source-dirs:
test
@@ -72,5 +72,6 @@ test-suite arbor-monad-metric-test
, network
, resourcet
, stm
+ , text
, transformers
default-language: Haskell2010
diff --git a/src/Arbor/Monad/Metric.hs b/src/Arbor/Monad/Metric.hs
index 35d9967..79d495e 100644
--- a/src/Arbor/Monad/Metric.hs
+++ b/src/Arbor/Monad/Metric.hs
@@ -10,13 +10,17 @@ module Arbor.Monad.Metric
, Metrics(..)
, newMetricsIO
, extractValues
+
+ , counter
+ , gauge
) where
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)
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
@@ -37,3 +41,9 @@ extractValues pk m = do
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 []
diff --git a/src/Arbor/Monad/Metric/Type.hs b/src/Arbor/Monad/Metric/Type.hs
index 7c8a012..3b55ca7 100644
--- a/src/Arbor/Monad/Metric/Type.hs
+++ b/src/Arbor/Monad/Metric/Type.hs
@@ -16,18 +16,21 @@ import Control.Monad.Trans.Resource
import Data.Generics.Product.Any
import Data.Proxy
import Data.Semigroup
+import Data.Text (Text)
import GHC.Generics
import qualified Control.Concurrent.STM as STM
import qualified Data.Map.Strict as M
-newtype Counter = Counter
- { name :: String
- } deriving (Eq, Ord, Show)
+data Counter = Counter
+ { name :: Text
+ , tags :: [Text]
+ } deriving (Eq, Ord, Show, Generic)
-newtype Gauge = Gauge
- { name :: String
- } deriving (Eq, Ord, Show)
+data Gauge = Gauge
+ { name :: Text
+ , tags :: [Text]
+ } deriving (Eq, Ord, Show, Generic)
type MetricMap k v = M.Map k (STM.TVar v)
diff --git a/test/Arbor/Monad/MetricSpec.hs b/test/Arbor/Monad/MetricSpec.hs
index 1c8e559..1a0bfce 100644
--- a/test/Arbor/Monad/MetricSpec.hs
+++ b/test/Arbor/Monad/MetricSpec.hs
@@ -1,14 +1,26 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TypeApplications #-}
+
module Arbor.Monad.MetricSpec
( spec
) 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.Generics.Product.Any
+import Data.Proxy
+import Data.Semigroup
-import qualified Arbor.Monad.UdpServer as UDP
+import qualified Arbor.Monad.Metric as M
+import qualified Arbor.Monad.Metric.Type as MT
+import qualified Arbor.Monad.MetricApp as A
import qualified Control.Concurrent.STM as STM
import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map.Strict as M
import qualified Network.Socket as S hiding (recv, recvFrom, send, sendTo)
import qualified Network.Socket.ByteString as S
@@ -20,19 +32,24 @@ import Test.Hspec
{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
{-# ANN module ("HLint: redundant bracket" :: String) #-}
-handler :: STM.TVar [BS.ByteString] -> UDP.UdpHandler
-handler tMsgs addr msg = do
- STM.atomically $ STM.modifyTVar tMsgs (msg:)
- putStrLn $ "From " ++ show addr ++ ": " ++ show msg
-
spec :: Spec
spec = describe "Arbor.Monad.MetricSpec" $ do
- it "Metrics library actually sends statsd messages over UDP" $ requireTest $ do
- tMessages <- liftIO $ STM.newTVarIO []
- sock <- liftIO $ UDP.createUdpServer "5555"
- threadId <- liftIO $ forkIO $ do
- UDP.runUdpServer sock (handler tMessages)
- liftIO $ threadDelay 1000000
- liftIO $ killThread threadId
- messages <- liftIO $ STM.readTVarIO tMessages
- messages === []
+ 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
+ MT.getMetrics
+
+ countersMap <- liftIO $ STM.readTVarIO $ metrics ^. the @"counters"
+ gaugesMap <- liftIO $ STM.readTVarIO $ metrics ^. the @"gauges"
+
+ 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)
+ ]
+
+ gauges === [ (M.gauge "test.gauge" , 20)
+ , (M.gauge "test.gauge" & the @"tags" .~ ["foo"] , 30)
+ ]
diff --git a/test/Arbor/Monad/UdpServer.hs b/test/Arbor/Monad/UdpServer.hs
deleted file mode 100644
index 5ab4c6f..0000000
--- a/test/Arbor/Monad/UdpServer.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-module Arbor.Monad.UdpServer
- ( createUdpServer
- , runUdpServer
- , UdpHandler
- ) where
-
-import Network.Socket
-
-import qualified Data.ByteString as BS
-import qualified Network.Socket.ByteString as BS
-
-type UdpHandler = SockAddr -> BS.ByteString -> IO ()
-
-createUdpServer :: ()
- => String -- ^ Port number or name; 514 is default
- -> IO Socket
-createUdpServer port = withSocketsDo $ do
- addrinfos <- getAddrInfo
- (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
- Nothing (Just port)
- let serveraddr = head addrinfos
-
- sock <- socket (addrFamily serveraddr) Datagram defaultProtocol
-
- bind sock (addrAddress serveraddr)
- return sock
-
-runUdpServer :: ()
- => Socket
- -> UdpHandler
- -> IO ()
-runUdpServer sock handler = withSocketsDo $ procMessages sock
- where procMessages sock = do
- (msg, addr) <- BS.recvFrom sock 1024
- handler addr msg
- procMessages sock