monad-metrics 0.1.0.2 → 0.2.0.0

raw patch · 3 files changed

+76/−76 lines, 3 filesdep +hashabledep +unordered-containersdep −containersPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, unordered-containers

Dependencies removed: containers

API changes (from Hackage documentation)

Files

• monad-metrics.cabal +10/−9
• src/Control/Monad/Metrics.hs +25/−55
• src/Control/Monad/Metrics/Internal.hs +41/−12

@@ -1,5 +1,5 @@ name:                monad-metrics-version:             0.1.0.2+version:             0.2.0.0 synopsis:            A convenient wrapper around EKG metrics description:         A convenient wrapper for collecting application metrics. Please see the README.md for more information. homepage:            https://github.com/sellerlabs/monad-metrics#readme@@ -17,14 +17,15 @@   hs-source-dirs:      src   exposed-modules:     Control.Monad.Metrics                      , Control.Monad.Metrics.Internal-  build-depends:       base         >= 4.7     && < 5-                     , clock        >= 0.3     && < 0.8-                     , containers   >= 0.2     && < 0.6-                     , ekg-core     >= 0.1.0.1 && < 0.2-                     , text                       < 1.3-                     , mtl          >= 2       && < 2.3-                     , transformers >= 0.3     && < 0.6-                     , microlens    >= 0.2     && < 0.5+  build-depends:       base                 >= 4.7     && < 5+                     , clock                >= 0.3     && < 0.8+                     , ekg-core             >= 0.1.0.1 && < 0.2+                     , hashable             >= 1.2     && < 1.3+                     , text                               < 1.3+                     , mtl                  >= 2       && < 2.3+                     , transformers         >= 0.3     && < 0.6+                     , unordered-containers >= 0.2     && < 0.3+                     , microlens            >= 0.2     && < 0.5   default-language:    Haskell2010  test-suite monad-metrics-test

@@ -1,12 +1,7 @@-{-# LANGUAGE DefaultSignatures          #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE FunctionalDependencies     #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE UndecidableInstances #-}  {-| Module      : Control.Monad.Metrics@@ -60,15 +55,17 @@ import           Control.Monad.IO.Class         (MonadIO (..)) import           Control.Monad.Reader           (MonadReader (..), ReaderT (..)) import           Control.Monad.Trans            (MonadTrans (..))-import           Data.IORef-import           Data.Map                       (Map)-import qualified Data.Map                       as Map+import           Data.Hashable                  (Hashable)+import           Data.HashMap.Strict            (HashMap)+import qualified Data.HashMap.Strict            as HashMap+import           Data.IORef                     (IORef, atomicModifyIORef',+                                                 newIORef) import           Data.Monoid                    (mempty) import           Data.Text                      (Text) import qualified Data.Text                      as Text-import           Lens.Micro import           System.Clock                   (Clock (..), TimeSpec (..),                                                  getTime)+import           System.IO.Unsafe               (unsafeInterleaveIO) import qualified System.Metrics                 as EKG import           System.Metrics.Counter         as Counter import           System.Metrics.Distribution    as Distribution@@ -238,50 +235,19 @@ label' l = label l . Text.pack . show  -- $metrictype--- The 'Metric' type contains an 'IORef' to a 'Map' from 'Text' labels to+-- The 'Metric' type contains an 'IORef' to a 'HashMap' from 'Text' labels to -- the various counters, and a 'EKG.Store' to register them with. If you -- must use the 'Metric' value directly, then you are recommended to use -- the lenses provided for compatibility.  ------------------------------------------------------------------------------- -diffTime :: Resolution -> TimeSpec -> TimeSpec -> Double-diffTime res (TimeSpec seca nseca) (TimeSpec secb nsecb) =-    let sec = seca - secb-        nsec = nseca - nsecb-     in convertTimeSpecTo res (TimeSpec sec nsec)--convertTimeSpecTo :: Resolution -> TimeSpec -> Double-convertTimeSpecTo res (TimeSpec secs' nsecs') =-    case res of-        Nanoseconds  -> nsecs + sToNs secs-        Microseconds -> nsToUs nsecs + sToUs secs-        Milliseconds -> nsToMs nsecs + sToMs secs-        Seconds      -> nsToS nsecs + secs-        Minutes      -> sToMin (nsToS nsecs + secs)-        Hours        -> sToHour (nsToS nsecs + secs)-        Days         -> sToDay (nsToS nsecs + secs)-  where-    nsecs = fromIntegral nsecs'-    secs = fromIntegral secs'--nsToUs, nsToMs, nsToS, sToMin, sToHour, sToDay, sToNs, sToUs, sToMs :: Double -> Double-nsToUs = (/ 10^3)-nsToMs = (/ 10^6)-nsToS = (/ 10^9)-sToMin = (/ 60)-sToHour = sToMin . sToMin-sToDay = (/ 24) . sToHour-sToNs = (* 10^9)-sToUs = (* 10^6)-sToMs = (* 10^3)- modifyMetric     :: (MonadMetrics m, MonadIO m)     => (t -> t1 -> IO b) -- ^ The action to add a value to a metric.     -> (t2 -> t1) -- ^ A conversion function from input to metric value.     -> (Text -> EKG.Store -> IO t) -- ^ The function for creating a new metric.-    -> (Metrics -> IORef (Map Text t)) -- ^ A way of getting the current metrics.+    -> (Metrics -> IORef (HashMap Text t)) -- ^ A way of getting the current metrics.     -> Text -- ^ The name of the metric to use.     -> t2 -- ^ The value the end user can provide.     -> m b@@ -290,14 +256,18 @@     liftIO $ adder bar (converter value)  lookupOrCreate-    :: (MonadMetrics m, MonadIO m, Ord k)-    => (Metrics -> IORef (Map k a)) -> (k -> EKG.Store -> IO a) -> k -> m a+    :: (MonadMetrics m, MonadIO m, Eq k, Hashable k)+    => (Metrics -> IORef (HashMap k a)) -> (k -> EKG.Store -> IO a) -> k -> m a lookupOrCreate getter creator name = do     ref <- liftM getter getMetrics-    container <- liftIO $ readIORef ref-    case Map.lookup name container of-        Nothing -> do-            c <- liftIO . creator name =<< liftM _metricsStore getMetrics-            liftIO $ modifyIORef ref (Map.insert name c)-            return c-        Just c -> return c+    -- unsafeInterleaveIO is used here to defer creating the metric into+    -- the 'atomicModifyIORef'' function. We lazily create the value here,+    -- and the resulting IO action only gets run to create the metric when+    -- the named metric is not present in the map.+    newMetric <- liftIO . unsafeInterleaveIO . creator name =<< liftM _metricsStore getMetrics+    liftIO $ atomicModifyIORef' ref (\container ->+        case HashMap.lookup name container of+            Nothing ->+                (HashMap.insert name newMetric container, newMetric)+            Just metric ->+                (container, metric))

@@ -1,5 +1,3 @@-{-# LANGUAGE RankNTypes #-}- {-| Module      : Control.Monad.Metrics.Internal Description : An easy interface to recording metrics.@@ -16,11 +14,11 @@ -} module Control.Monad.Metrics.Internal where -import           Control.Monad.Reader        (asks) import           Data.IORef-import           Data.Map                    (Map)+import           Data.HashMap.Strict         (HashMap) import           Data.Text                   (Text) import           Lens.Micro+import           System.Clock                (TimeSpec (..)) import           System.Metrics              (Store) import           System.Metrics.Counter      (Counter) import           System.Metrics.Distribution (Distribution)@@ -31,35 +29,35 @@ -- -- * /Since v0.1.0.0/ data Metrics = Metrics-    { _metricsCounters      :: IORef (Map Text Counter)-    , _metricsGauges        :: IORef (Map Text Gauge)-    , _metricsDistributions :: IORef (Map Text Distribution)-    , _metricsLabels        :: IORef (Map Text Label)+    { _metricsCounters      :: IORef (HashMap Text Counter)+    , _metricsGauges        :: IORef (HashMap Text Gauge)+    , _metricsDistributions :: IORef (HashMap Text Distribution)+    , _metricsLabels        :: IORef (HashMap Text Label)     , _metricsStore         :: Store     }  -- | A lens into the 'Counter's provided by the 'Metrics'. -- -- * /Since v0.1.0.0/-metricsCounters :: Lens' Metrics (IORef (Map Text Counter))+metricsCounters :: Lens' Metrics (IORef (HashMap Text Counter)) metricsCounters f (Metrics c g d l s) = fmap (\c' -> Metrics c' g d l s) (f c)  -- | A lens into the 'Gauge's provided by the 'Metrics'. -- -- * /Since v0.1.0.0/-metricsGauges :: Lens' Metrics (IORef (Map Text Gauge))+metricsGauges :: Lens' Metrics (IORef (HashMap Text Gauge)) metricsGauges f (Metrics c g d l s) = fmap (\g' -> Metrics c g' d l s) (f g)  -- | A lens into the 'Distribution's provided by the 'Metrics'. -- -- * /Since v0.1.0.0/-metricsDistributions :: Lens' Metrics (IORef (Map Text Distribution))+metricsDistributions :: Lens' Metrics (IORef (HashMap Text Distribution)) metricsDistributions f (Metrics c g d l s) = fmap (\d' -> Metrics c g d' l s) (f d)  -- | A lens into the 'Label's provided by the 'Metrics'. -- -- * /Since v0.1.0.0/-metricsLabels :: Lens' Metrics (IORef (Map Text Label))+metricsLabels :: Lens' Metrics (IORef (HashMap Text Label)) metricsLabels f (Metrics c g d l s) = fmap (\l' -> Metrics c g d l' s) (f l)  -- | A lens into the 'Store' provided by the 'Metrics'.@@ -81,3 +79,34 @@     | Hours     | Days     deriving (Eq, Show, Ord, Enum)++diffTime :: Resolution -> TimeSpec -> TimeSpec -> Double+diffTime res (TimeSpec seca nseca) (TimeSpec secb nsecb) =+    let secs = seca - secb+        nsecs = nseca - nsecb+     in convertTimeSpecTo res (TimeSpec secs nsecs)++convertTimeSpecTo :: Resolution -> TimeSpec -> Double+convertTimeSpecTo res (TimeSpec secs' nsecs') =+    case res of+        Nanoseconds  -> nsecs + sToNs secs+        Microseconds -> nsToUs nsecs + sToUs secs+        Milliseconds -> nsToMs nsecs + sToMs secs+        Seconds      -> nsToS nsecs + secs+        Minutes      -> sToMin (nsToS nsecs + secs)+        Hours        -> sToHour (nsToS nsecs + secs)+        Days         -> sToDay (nsToS nsecs + secs)+  where+    nsecs = fromIntegral nsecs'+    secs = fromIntegral secs'++nsToUs, nsToMs, nsToS, sToMin, sToHour, sToDay, sToNs, sToUs, sToMs :: Double -> Double+nsToUs = (/ 10^(3 :: Int))+nsToMs = (/ 10^(6 :: Int))+nsToS = (/ 10^(9 :: Int))+sToMin = (/ 60)+sToHour = sToMin . sToMin+sToDay = (/ 24) . sToHour+sToNs = (* 10^(9 :: Int))+sToUs = (* 10^(6 :: Int))+sToMs = (* 10^(3 :: Int))