monad-metrics-extensible 0.1.0.1 → 0.1.1.0

raw patch · 6 files changed

+151/−21 lines, 6 filesdep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +25/−9
• monad-metrics-extensible.cabal +6/−3
• src/System/Metrics/ExtraTrackers.hs +80/−0
• src/System/Metrics/Store.hs +5/−4
• test/Spec.hs +31/−5

@@ -1,5 +1,9 @@ # Changelog for monad-metrics-extensible +## v. 0.1.1.0++Add some utility types and functions: `Timestamp`, `Timer`, `timed`.+ ## v. 0.1.0.1  A very brief documentation in README

@@ -1,5 +1,10 @@ # monad-metrics-extensible +[![Build Status][travis-badge]][travis]+[![Hackage][hackage-badge]][hackage]+[![Stackage LTS][stackage-lts-badge]][stackage-lts]+[![Stackage Nightly][stackage-nightly-badge]][stackage-nightly]+ ## tl;dr  This library simplifies using [ekg](http://hackage.haskell.org/package/ekg)@@ -16,7 +21,7 @@   (hence "extensible" one more time).   You want a combined distribution + counter? No prob! -`import System.Metrics.Extensible` is your entry point of choice!+`System.Metrics.Extensible` is your entry point of choice!  ## A quick example @@ -36,19 +41,19 @@   AnotherCounter  :: SomeMetrics Counter "other_counter"   SomeGauge       :: SomeMetrics Gauge   "some_gauge" ```-The string literals is what will be shown via ekg UI.+The string literals are what will be shown via ekg UI.  There is a couple of requirements:  * The type shall be of the kind `* -> Symbol -> *`. * The first type argument (`Counter` and `Gauge` in the example above)   shall be an instance of `TrackerLike`. All ekg counters are already-  an instance of this class.-* The type shall be comparable, hence we shall also do-```haskell-deriving instance Eq (SomeMetrics ty name)-deriving instance Ord (SomeMetrics ty name)-```+  instances of this class.+* The type shall be comparable, hence we also do+  ```haskell+  deriving instance Eq (SomeMetrics ty name)+  deriving instance Ord (SomeMetrics ty name)+  ```  Then we can write our small program! @@ -67,5 +72,16 @@   the metrics. * `track` is the function that's responsible for updating the metrics.   Its arguments depend on the specific metric that's being tracked:-  for instance, `Counter`s have no arguments, while `Gauge`s accept+  for instance, as can be seen in the example above,+  `Counter`s have no arguments, while `Gauge`s accept   the corresponding new value.+++[travis]:        <https://travis-ci.org/0xd34df00d/monad-metrics-extensible>+[travis-badge]:  <https://travis-ci.org/0xd34df00d/monad-metrics-extensible.svg?branch=master>+[hackage]:       <https://hackage.haskell.org/package/monad-metrics-extensible>+[hackage-badge]: <https://img.shields.io/hackage/v/monad-metrics-extensible.svg>+[stackage-lts-badge]: <http://stackage.org/package/monad-metrics-extensible/badge/lts>+[stackage-nightly-badge]: <http://stackage.org/package/monad-metrics-extensible/badge/nightly>+[stackage-lts]: <http://stackage.org/lts/package/monad-metrics-extensible>+[stackage-nightly]: <http://stackage.org/nightly/package/monad-metrics-extensible>

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 79c192bfb089d6da408408ac335a54cc76caffb9f9520888b58754d4981712fe+-- hash: 69ea4201ba5699f3590e46f8f9ef0a986f900c2f2b489840763c7e2b26c42394  name:           monad-metrics-extensible-version:        0.1.0.1+version:        0.1.1.0 synopsis:       An extensible and type-safe wrapper around EKG metrics description:    Please see the README on GitHub at <https://github.com/0xd34df00d/monad-metrics-extensible#readme> category:       Web@@ -31,6 +31,7 @@   exposed-modules:       Data.Dyn       System.Metrics.Extensible+      System.Metrics.ExtraTrackers       System.Metrics.Monad       System.Metrics.Monad.Class       System.Metrics.Store@@ -50,6 +51,7 @@     , mtl     , stm     , text+    , time   default-language: Haskell2010  test-suite monad-metrics-extensible-test@@ -72,4 +74,5 @@     , mtl     , stm     , text+    , time   default-language: Haskell2010

@@ -0,0 +1,80 @@+{-# LANGUAGE TypeFamilies, DataKinds, ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++module System.Metrics.ExtraTrackers+( Timestamp++, TimerMagnitude(..)+, Timer(..)+, timed+) where++import qualified Data.Text as T+import Control.Monad.IO.Class+import Data.Proxy+import Data.Time.Clock.POSIX+import Data.Typeable+import GHC.TypeLits+import System.CPUTime+import System.Metrics+import System.Metrics.Distribution as TD+import System.Metrics.Label as TL++import System.Metrics.Extensible++newtype Timestamp = Timestamp Label++instance TrackerLike Timestamp where+  type TrackAction Timestamp m = m ()+  track metric = do+    Timestamp l <- getTracker metric+    liftIO $ do+      utc <- getCurrentTime+      TL.set l $ T.pack $ show utc+  createTracker name store = Timestamp <$> createLabel name store+++newtype Timer (magn :: TimerMagnitude) = Timer { getTimerDistribution :: Distribution }++data TimerMagnitude = Msecs | Usecs | Nsecs deriving (Typeable)++class MagnitudeOps (magn :: TimerMagnitude) where+  toString :: Proxy magn -> T.Text+  secFraction :: Proxy magn -> Double++instance MagnitudeOps 'Msecs where+  toString _ = "ms"+  secFraction _ = 1e-3++instance MagnitudeOps 'Usecs where+  toString _ = "us"+  secFraction _ = 1e-6++instance MagnitudeOps 'Nsecs where+  toString _ = "ns"+  secFraction _ = 1e-9++instance (Typeable magn, MagnitudeOps magn) => TrackerLike (Timer magn) where+  type TrackAction (Timer magn) m = Double -> m ()+  track metric timing = do+    Timer timer <- getTracker metric+    liftIO $ TD.add timer timing+  createTracker name store = Timer <$> createDistribution (name <> "_" <> toString (Proxy :: Proxy magn)) store++-- Returns the number of picoseconds+time :: MonadIO m => m a -> m (Integer, a)+time act = do+  start <- liftIO getCPUTime+  res <- act+  end <- liftIO getCPUTime+  pure (end - start, res)++timed :: forall m metric magn name a.+         (MonadMetrics m, KnownSymbol name, Typeable metric, Typeable magn, MagnitudeOps magn, Ord (metric (Timer magn) name))+      => metric (Timer magn) name+      -> m a+      -> m a+timed metric act = do+  (cpuTime, res) <- time act+  track metric $ fromIntegral cpuTime / (1e12 * secFraction (Proxy :: Proxy magn))+  pure res

@@ -14,6 +14,7 @@ import Control.Concurrent import Control.Concurrent.STM.TQueue import Control.Monad.Catch+import Control.Monad.IO.Class import Control.Monad.Identity import Control.Monad.STM import Data.GADT.Compare@@ -62,11 +63,11 @@  newtype MetricsStore = MetricsStore { mReqQueue :: TQueue MetricRequest } -newMetricsStore :: Server -> IO (MetricsStore, IO ())-newMetricsStore srv = do+newMetricsStore :: MonadIO m => Server -> m (MetricsStore, m ())+newMetricsStore srv = liftIO $ do   queue <- newTQueueIO   threadId <- forkIO $ act queue $ MetricsState srv mempty-  pure (MetricsStore queue, killThread threadId)+  pure (MetricsStore queue, liftIO $ killThread threadId)   where     act queue state = do       req <- atomically (readTQueue queue)@@ -89,7 +90,7 @@       putMVar mvar tracker       pure state' -withMetricsStore :: Server -> (MetricsStore -> IO a) -> IO a+withMetricsStore :: (MonadIO m, MonadMask m) => Server -> (MetricsStore -> m a) -> m a withMetricsStore srv f = bracket   (newMetricsStore srv)   snd

@@ -2,28 +2,41 @@ {-# LANGUAGE OverloadedStrings, StandaloneDeriving #-}  import Control.Monad.IO.Class+import Data.Functor+import System.CPUTime import System.Metrics.Counter as TC(read)+import System.Metrics.Distribution as TD(read, sum, count) import System.Metrics.Gauge as TG(read) import System.Remote.Monitoring import Test.Hspec  import System.Metrics.Extensible+import System.Metrics.ExtraTrackers  data TestMetrics ty name where-  Foo1 :: TestMetrics Counter "foo1"-  Foo2 :: TestMetrics Counter "foo2"-  Bar  :: TestMetrics Gauge   "bar"+  Foo1    :: TestMetrics Counter        "foo1"+  Foo2    :: TestMetrics Counter        "foo2"+  Bar     :: TestMetrics Gauge          "bar"+  TimeMS  :: TestMetrics (Timer 'Msecs) "timeMS"  deriving instance Eq (TestMetrics ty name) deriving instance Ord (TestMetrics ty name)  data OtherMetrics ty name where-  Baz  :: OtherMetrics Counter "foo1"-  Quux :: OtherMetrics Gauge   "bar"+  Baz  :: OtherMetrics Counter "other-foo1"+  Quux :: OtherMetrics Gauge   "other-bar"  deriving instance Eq (OtherMetrics ty name) deriving instance Ord (OtherMetrics ty name) +cpuThreadDelay :: Int -> IO ()+cpuThreadDelay usecs | usecs < 0 = pure ()+                     | otherwise = do+  start <- getCPUTime+  void $ readFile "/dev/null"+  end <- getCPUTime+  cpuThreadDelay $ usecs - fromIntegral ((end - start) `div` 1000000)+ main :: IO () main = do   ekgServer <- forkServer "localhost" 21000@@ -34,6 +47,7 @@     track Bar 10     track Bar 20     track Baz+    timed TimeMS $ liftIO $ cpuThreadDelay testMicroseconds     track Quux 42     liftIO $ hspec $ do       describe "Counters are stored as expected" $ do@@ -43,3 +57,15 @@       describe "Gauges are stored as expected" $ do         it "The final value of Bar is kept" $ (getMetricFromStore store Bar >>= TG.read) `shouldReturn` 20         it "Metrics from other type are also saved" $ (getMetricFromStore store Quux >>= TG.read) `shouldReturn` 42+      describe "Timers are stored and computed as expected" $ do+        it "TimeMS has only seen one value" $ do+          storedStats <- getMetricFromStore store TimeMS >>= TD.read . getTimerDistribution+          TD.count storedStats `shouldBe` 1+        it "The value of TimeMS exceeds the wait time" $ do+          storedStats <- getMetricFromStore store TimeMS >>= TD.read . getTimerDistribution+          TD.sum storedStats `shouldSatisfy` (>= (fromIntegral testMicroseconds / 1000))+        it "…but not too much" $ do+          storedStats <- getMetricFromStore store TimeMS >>= TD.read . getTimerDistribution+          TD.sum storedStats `shouldSatisfy` (< 1000 * (fromIntegral testMicroseconds / 1000))+  where+    testMicroseconds = 10000