arbor-monad-metric 0.0.4 → 1.0.0

raw patch · 5 files changed

+57/−62 lines, 5 filesdep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: text

API changes (from Hackage documentation)

Files

• arbor-monad-metric.cabal +4/−3
• src/Arbor/Monad/Metric.hs +11/−1
• src/Arbor/Monad/Metric/Type.hs +9/−6
• test/Arbor/Monad/MetricSpec.hs +33/−16
• test/Arbor/Monad/UdpServer.hs +0/−36

@@ -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 @@     , 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 @@   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 @@     , network     , resourcet     , stm+    , text     , transformers   default-language: Haskell2010

@@ -10,13 +10,17 @@   , 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 @@   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 []

@@ -16,18 +16,21 @@ 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) 

@@ -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 @@ {-# 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)+                  ]

@@ -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