ekg-core-0.1.1.7/0000755000000000000000000000000007346545000011543 5ustar0000000000000000ekg-core-0.1.1.7/CHANGES.md0000755000000000000000000000227207346545000013143 0ustar0000000000000000## 0.1.1.7 (2019-03-15) * Fix two bugs in `cbits` relating to distribution values ([#35](https://github.com/tibbe/ekg-core/pull/35)). * GHC 8.8 support ([#34](https://github.com/tibbe/ekg-core/pull/34)). ## 0.1.1.6 (2018-11-19) * Reverted [#25](https://github.com/tibbe/ekg-core/pull/25), which introduced a regression. ## 0.1.1.5 (2018-11-19) * GHC 8.6 support ([#28](https://github.com/tibbe/ekg-core/pull/28)). * Bugfix: avoid division by zero ([#25](https://github.com/tibbe/ekg-core/pull/25)). ## 0.1.1.4 (2018-02-27) * GHC 8.4 support ([#23](https://github.com/tibbe/ekg-core/pull/23)). ## 0.1.1.3 (2017-10-10) * Fix a space leak in `System.Metric.Label.set` ([#21](https://github.com/tibbe/ekg-core/pull/21)). ## 0.1.1.2 (2017-07-31) * GHC 8.2 support. ## 0.1.1.1 (2016-05-28) * GHC 8.0 support. ## 0.1.1.0 (2015-07-31) * Expose internals for use in ekg-json. ## 0.1.0.4 (2015-04-12) * GHC 7.10 support. ## 0.1.0.3 (2015-02-11) * Allow base 4.9. * Pass -march=i686 to C compilers to enable atomics ## 0.1.0.2 (2014-09-30) * Bump upper bound on text to 1.3 ## 0.1.0.1 (2013-06-06) * Fix a deadlock in Distribution ## 0.1.0.0 (2013-05-01) * Initial release. ekg-core-0.1.1.7/Data/0000755000000000000000000000000007346545000012414 5ustar0000000000000000ekg-core-0.1.1.7/Data/Array.hs0000644000000000000000000000473507346545000014037 0ustar0000000000000000{-# LANGUAGE BangPatterns, MagicHash, Rank2Types, UnboxedTuples #-} -- | Zero based arrays. -- -- Note that no bounds checking are performed. module Data.Array ( Array , length , index , fromList , toList ) where import Control.Monad.ST import GHC.Exts (Array#, Int(..), MutableArray#, indexArray#, newArray#, sizeofArray#, sizeofMutableArray#, unsafeFreezeArray#, writeArray#) import GHC.ST (ST(..)) import Prelude hiding (foldr, length) data Array a = Array { unArray :: !(Array# a) } length :: Array a -> Int length ary = I# (sizeofArray# (unArray ary)) {-# INLINE length #-} -- | Smart constructor array :: Array# a -> Int -> Array a array ary _n = Array ary {-# INLINE array #-} data MArray s a = MArray { unMArray :: !(MutableArray# s a) } lengthM :: MArray s a -> Int lengthM mary = I# (sizeofMutableArray# (unMArray mary)) {-# INLINE lengthM #-} -- | Smart constructor marray :: MutableArray# s a -> Int -> MArray s a marray mary _n = MArray mary {-# INLINE marray #-} new :: Int -> a -> ST s (MArray s a) new n@(I# n#) b = ST $ \s -> case newArray# n# b s of (# s', ary #) -> (# s', marray ary n #) {-# INLINE new #-} new_ :: Int -> ST s (MArray s a) new_ n = new n undefinedElem write :: MArray s a -> Int -> a -> ST s () write ary _i@(I# i#) b = ST $ \ s -> case writeArray# (unMArray ary) i# b s of s' -> (# s' , () #) {-# INLINE write #-} index :: Array a -> Int -> a index ary _i@(I# i#) = case indexArray# (unArray ary) i# of (# b #) -> b {-# INLINE index #-} unsafeFreeze :: MArray s a -> ST s (Array a) unsafeFreeze mary = ST $ \s -> case unsafeFreezeArray# (unMArray mary) s of (# s', ary #) -> (# s', array ary (lengthM mary) #) {-# INLINE unsafeFreeze #-} run :: (forall s . ST s (MArray s e)) -> Array e run act = runST $ act >>= unsafeFreeze {-# INLINE run #-} undefinedElem :: a undefinedElem = error "Data.HashMap.Array: Undefined element" {-# NOINLINE undefinedElem #-} fromList :: Int -> [a] -> Array a fromList n xs0 = run $ do mary <- new_ n go xs0 mary 0 where go [] !mary !_ = return mary go (x:xs) mary i = do write mary i x go xs mary (i+1) toList :: Array a -> [a] toList = foldr (:) [] foldr :: (a -> b -> b) -> b -> Array a -> b foldr f = \ z0 ary0 -> go ary0 (length ary0) 0 z0 where go ary n i z | i >= n = z | otherwise = f (index ary i) (go ary n (i+1) z) {-# INLINE foldr #-} ekg-core-0.1.1.7/Data/Atomic.hs0000644000000000000000000000333207346545000014165 0ustar0000000000000000{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-} -- | An atomic integer value. All operations are thread safe. module Data.Atomic ( Atomic , new , read , write , inc , dec , add , subtract ) where import Data.Int (Int64) import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr) import Foreign.Storable (poke) import Prelude hiding (read, subtract) -- | A mutable, atomic integer. newtype Atomic = C (ForeignPtr Int64) -- | Create a new, zero initialized, atomic. new :: Int64 -> IO Atomic new n = do fp <- mallocForeignPtr withForeignPtr fp $ \ p -> poke p n return $ C fp read :: Atomic -> IO Int64 read (C fp) = withForeignPtr fp cRead foreign import ccall unsafe "hs_atomic_read" cRead :: Ptr Int64 -> IO Int64 -- | Set the atomic to the given value. write :: Atomic -> Int64 -> IO () write (C fp) n = withForeignPtr fp $ \ p -> cWrite p n foreign import ccall unsafe "hs_atomic_write" cWrite :: Ptr Int64 -> Int64 -> IO () -- | Increase the atomic by one. inc :: Atomic -> IO () inc atomic = add atomic 1 -- | Decrease the atomic by one. dec :: Atomic -> IO () dec atomic = subtract atomic 1 -- | Increase the atomic by the given amount. add :: Atomic -> Int64 -> IO () add (C fp) n = withForeignPtr fp $ \ p -> cAdd p n -- | Decrease the atomic by the given amount. subtract :: Atomic -> Int64 -> IO () subtract (C fp) n = withForeignPtr fp $ \ p -> cSubtract p n -- | Increase the atomic by the given amount. foreign import ccall unsafe "hs_atomic_add" cAdd :: Ptr Int64 -> Int64 -> IO () -- | Increase the atomic by the given amount. foreign import ccall unsafe "hs_atomic_subtract" cSubtract :: Ptr Int64 -> Int64 -> IO () ekg-core-0.1.1.7/LICENSE0000644000000000000000000000276207346545000012557 0ustar0000000000000000Copyright (c) 2014, Johan Tibell All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Johan Tibell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ekg-core-0.1.1.7/Setup.hs0000644000000000000000000000005607346545000013200 0ustar0000000000000000import Distribution.Simple main = defaultMain ekg-core-0.1.1.7/System/0000755000000000000000000000000007346545000013027 5ustar0000000000000000ekg-core-0.1.1.7/System/Metrics.hs0000644000000000000000000005661707346545000015010 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | A module for defining metrics that can be monitored. -- -- Metrics are used to monitor program behavior and performance. All -- metrics have -- -- * a name, and -- -- * a way to get the metric's current value. -- -- This module provides a way to register metrics in a global \"metric -- store\". The store can then be used to get a snapshot of all -- metrics. The store also serves as a central place to keep track of -- all the program's metrics, both user and library defined. -- -- Here's an example of creating a single counter, used to count the -- number of request served by a web server: -- -- > import System.Metrics -- > import qualified System.Metrics.Counter as Counter -- > -- > main = do -- > store <- newStore -- > requests <- createCounter "myapp.request_count" store -- > -- Every time we receive a request: -- > Counter.inc requests -- -- This module also provides a way to register a number of predefined -- metrics that are useful in most applications. See e.g. -- 'registerGcMetrics'. module System.Metrics ( -- * Naming metrics -- $naming -- * The metric store -- $metric-store Store , newStore -- * Registering metrics -- $registering , registerCounter , registerGauge , registerLabel , registerDistribution , registerGroup -- ** Convenience functions -- $convenience , createCounter , createGauge , createLabel , createDistribution -- ** Predefined metrics -- $predefined , registerGcMetrics -- * Sampling metrics -- $sampling , Sample , sampleAll , Value(..) ) where import Control.Applicative ((<$>)) import Control.Monad (forM) import Data.Int (Int64) import qualified Data.IntMap.Strict as IM import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) import qualified Data.HashMap.Strict as M import qualified Data.Text as T import qualified GHC.Stats as Stats import Prelude hiding (read) import System.Metrics.Counter (Counter) import qualified System.Metrics.Counter as Counter import System.Metrics.Distribution (Distribution) import qualified System.Metrics.Distribution as Distribution import System.Metrics.Gauge (Gauge) import qualified System.Metrics.Gauge as Gauge import System.Metrics.Label (Label) import qualified System.Metrics.Label as Label -- $naming -- Compound metric names should be separated using underscores. -- Example: @request_count@. Periods in the name imply namespacing. -- Example: @\"myapp.users\"@. Some consumers of metrics will use -- these namespaces to group metrics in e.g. UIs. -- -- Libraries and frameworks that want to register their own metrics -- should prefix them with a namespace, to avoid collision with -- user-defined metrics and metrics defined by other libraries. For -- example, the Snap web framework could prefix all its metrics with -- @\"snap.\"@. -- -- It's customary to suffix the metric name with a short string -- explaining the metric's type e.g. using @\"_ms\"@ to denote -- milliseconds. ------------------------------------------------------------------------ -- * The metric store -- $metric-store -- The metric store is a shared store of metrics. It allows several -- disjoint components (e.g. libraries) to contribute to the set of -- metrics exposed by an application. Libraries that want to provide a -- set of metrics should defined a register method, in the style of -- 'registerGcMetrics', that registers the metrics in the 'Store'. The -- register function should document which metrics are registered and -- their types (i.e. counter, gauge, label, or distribution). -- | A mutable metric store. newtype Store = Store { storeState :: IORef State } type GroupId = Int -- | The 'Store' state. data State = State { stateMetrics :: !(M.HashMap T.Text (Either MetricSampler GroupId)) , stateGroups :: !(IM.IntMap GroupSampler) , stateNextId :: {-# UNPACK #-} !Int } data GroupSampler = forall a. GroupSampler { groupSampleAction :: !(IO a) , groupSamplerMetrics :: !(M.HashMap T.Text (a -> Value)) } -- TODO: Rename this to Metric and Metric to SampledMetric. data MetricSampler = CounterS !(IO Int64) | GaugeS !(IO Int64) | LabelS !(IO T.Text) | DistributionS !(IO Distribution.Stats) -- | Create a new, empty metric store. newStore :: IO Store newStore = do state <- newIORef $ State M.empty IM.empty 0 return $ Store state ------------------------------------------------------------------------ -- * Registering metrics -- $registering -- Before metrics can be sampled they need to be registered with the -- metric store. The same metric name can only be used once. Passing a -- metric name that has already been used to one of the register -- function is an 'error'. -- | Register a non-negative, monotonically increasing, integer-valued -- metric. The provided action to read the value must be thread-safe. -- Also see 'createCounter'. registerCounter :: T.Text -- ^ Counter name -> IO Int64 -- ^ Action to read the current metric value -> Store -- ^ Metric store -> IO () registerCounter name sample store = register name (CounterS sample) store -- | Register an integer-valued metric. The provided action to read -- the value must be thread-safe. Also see 'createGauge'. registerGauge :: T.Text -- ^ Gauge name -> IO Int64 -- ^ Action to read the current metric value -> Store -- ^ Metric store -> IO () registerGauge name sample store = register name (GaugeS sample) store -- | Register a text metric. The provided action to read the value -- must be thread-safe. Also see 'createLabel'. registerLabel :: T.Text -- ^ Label name -> IO T.Text -- ^ Action to read the current metric value -> Store -- ^ Metric store -> IO () registerLabel name sample store = register name (LabelS sample) store -- | Register a distribution metric. The provided action to read the -- value must be thread-safe. Also see 'createDistribution'. registerDistribution :: T.Text -- ^ Distribution name -> IO Distribution.Stats -- ^ Action to read the current metric -- value -> Store -- ^ Metric store -> IO () registerDistribution name sample store = register name (DistributionS sample) store register :: T.Text -> MetricSampler -> Store -> IO () register name sample store = do atomicModifyIORef (storeState store) $ \ state@State{..} -> case M.member name stateMetrics of False -> let !state' = state { stateMetrics = M.insert name (Left sample) stateMetrics } in (state', ()) True -> alreadyInUseError name -- | Raise an exception indicating that the metric name is already in -- use. alreadyInUseError :: T.Text -> a alreadyInUseError name = error $ "The name \"" ++ show name ++ "\" is already taken " ++ "by a metric." -- | Register an action that will be executed any time one of the -- metrics computed from the value it returns needs to be sampled. -- -- When one or more of the metrics listed in the first argument needs -- to be sampled, the action is executed and the provided getter -- functions will be used to extract the metric(s) from the action's -- return value. -- -- The registered action might be called from a different thread and -- therefore needs to be thread-safe. -- -- This function allows you to sample groups of metrics together. This -- is useful if -- -- * you need a consistent view of several metric or -- -- * sampling the metrics together is more efficient. -- -- For example, sampling GC statistics needs to be done atomically or -- a GC might strike in the middle of sampling, rendering the values -- incoherent. Sampling GC statistics is also more efficient if done -- in \"bulk\", as the run-time system provides a function to sample all -- GC statistics at once. -- -- Note that sampling of the metrics is only atomic if the provided -- action computes @a@ atomically (e.g. if @a@ is a record, the action -- needs to compute its fields atomically if the sampling is to be -- atomic.) -- -- Example usage: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import qualified Data.HashMap.Strict as M -- > import GHC.Stats -- > import System.Metrics -- > -- > main = do -- > store <- newStore -- > let metrics = -- > [ ("num_gcs", Counter . numGcs) -- > , ("max_bytes_used", Gauge . maxBytesUsed) -- > ] -- > registerGroup (M.fromList metrics) getGCStats store registerGroup :: M.HashMap T.Text (a -> Value) -- ^ Metric names and getter functions. -> IO a -- ^ Action to sample the metric group -> Store -- ^ Metric store -> IO () registerGroup getters cb store = do atomicModifyIORef (storeState store) $ \ State{..} -> let !state' = State { stateMetrics = M.foldlWithKey' (register_ stateNextId) stateMetrics getters , stateGroups = IM.insert stateNextId (GroupSampler cb getters) stateGroups , stateNextId = stateNextId + 1 } in (state', ()) where register_ groupId metrics name _ = case M.lookup name metrics of Nothing -> M.insert name (Right groupId) metrics Just _ -> alreadyInUseError name ------------------------------------------------------------------------ -- ** Convenience functions -- $convenience -- These functions combined the creation of a mutable reference (e.g. -- a 'Counter') with registering that reference in the store in one -- convenient function. -- | Create and register a zero-initialized counter. createCounter :: T.Text -- ^ Counter name -> Store -- ^ Metric store -> IO Counter createCounter name store = do counter <- Counter.new registerCounter name (Counter.read counter) store return counter -- | Create and register a zero-initialized gauge. createGauge :: T.Text -- ^ Gauge name -> Store -- ^ Metric store -> IO Gauge createGauge name store = do gauge <- Gauge.new registerGauge name (Gauge.read gauge) store return gauge -- | Create and register an empty label. createLabel :: T.Text -- ^ Label name -> Store -- ^ Metric store -> IO Label createLabel name store = do label <- Label.new registerLabel name (Label.read label) store return label -- | Create and register an event tracker. createDistribution :: T.Text -- ^ Distribution name -> Store -- ^ Metric store -> IO Distribution createDistribution name store = do event <- Distribution.new registerDistribution name (Distribution.read event) store return event ------------------------------------------------------------------------ -- * Predefined metrics -- $predefined -- This library provides a number of pre-defined metrics that can -- easily be added to a metrics store by calling their register -- function. #if MIN_VERSION_base(4,10,0) -- | Convert nanoseconds to milliseconds. nsToMs :: Int64 -> Int64 nsToMs s = round (realToFrac s / (1000000.0 :: Double)) #else -- | Convert seconds to milliseconds. sToMs :: Double -> Int64 sToMs s = round (s * 1000.0) #endif -- | Register a number of metrics related to garbage collector -- behavior. -- -- To enable GC statistics collection, either run your program with -- -- > +RTS -T -- -- or compile it with -- -- > -with-rtsopts=-T -- -- The runtime overhead of @-T@ is very small so it's safe to always -- leave it enabled. -- -- Registered counters: -- -- [@rts.gc.bytes_allocated@] Total number of bytes allocated -- -- [@rts.gc.num_gcs@] Number of garbage collections performed -- -- [@rts.gc.num_bytes_usage_samples@] Number of byte usage samples taken -- -- [@rts.gc.cumulative_bytes_used@] Sum of all byte usage samples, can be -- used with @numByteUsageSamples@ to calculate averages with -- arbitrary weighting (if you are sampling this record multiple -- times). -- -- [@rts.gc.bytes_copied@] Number of bytes copied during GC -- -- [@rts.gc.init_cpu_ms@] CPU time used by the init phase, in -- milliseconds. GHC 8.6+ only. -- -- [@rts.gc.init_wall_ms@] Wall clock time spent running the init -- phase, in milliseconds. GHC 8.6+ only. -- -- [@rts.gc.mutator_cpu_ms@] CPU time spent running mutator threads, -- in milliseconds. This does not include any profiling overhead or -- initialization. -- -- [@rts.gc.mutator_wall_ms@] Wall clock time spent running mutator -- threads, in milliseconds. This does not include initialization. -- -- [@rts.gc.gc_cpu_ms@] CPU time spent running GC, in milliseconds. -- -- [@rts.gc.gc_wall_ms@] Wall clock time spent running GC, in -- milliseconds. -- -- [@rts.gc.cpu_ms@] Total CPU time elapsed since program start, in -- milliseconds. -- -- [@rts.gc.wall_ms@] Total wall clock time elapsed since start, in -- milliseconds. -- -- Registered gauges: -- -- [@rts.gc.max_bytes_used@] Maximum number of live bytes seen so far -- -- [@rts.gc.current_bytes_used@] Current number of live bytes -- -- [@rts.gc.current_bytes_slop@] Current number of bytes lost to slop -- -- [@rts.gc.max_bytes_slop@] Maximum number of bytes lost to slop at any one time so far -- -- [@rts.gc.peak_megabytes_allocated@] Maximum number of megabytes allocated -- -- [@rts.gc.par_tot_bytes_copied@] Number of bytes copied during GC, minus -- space held by mutable lists held by the capabilities. Can be used -- with 'parMaxBytesCopied' to determine how well parallel GC utilized -- all cores. -- -- [@rts.gc.par_avg_bytes_copied@] Deprecated alias for -- @par_tot_bytes_copied@. -- -- [@rts.gc.par_max_bytes_copied@] Sum of number of bytes copied each GC by -- the most active GC thread each GC. The ratio of -- @par_tot_bytes_copied@ divided by @par_max_bytes_copied@ approaches -- 1 for a maximally sequential run and approaches the number of -- threads (set by the RTS flag @-N@) for a maximally parallel run. registerGcMetrics :: Store -> IO () registerGcMetrics store = registerGroup #if MIN_VERSION_base(4,10,0) (M.fromList [ ("rts.gc.bytes_allocated" , Counter . fromIntegral . Stats.allocated_bytes) , ("rts.gc.num_gcs" , Counter . fromIntegral . Stats.gcs) , ("rts.gc.num_bytes_usage_samples" , Counter . fromIntegral . Stats.major_gcs) , ("rts.gc.cumulative_bytes_used" , Counter . fromIntegral . Stats.cumulative_live_bytes) , ("rts.gc.bytes_copied" , Counter . fromIntegral . Stats.copied_bytes) #if MIN_VERSION_base(4,12,0) , ("rts.gc.init_cpu_ms" , Counter . nsToMs . Stats.init_cpu_ns) , ("rts.gc.init_wall_ms" , Counter . nsToMs . Stats.init_elapsed_ns) #endif , ("rts.gc.mutator_cpu_ms" , Counter . nsToMs . Stats.mutator_cpu_ns) , ("rts.gc.mutator_wall_ms" , Counter . nsToMs . Stats.mutator_elapsed_ns) , ("rts.gc.gc_cpu_ms" , Counter . nsToMs . Stats.gc_cpu_ns) , ("rts.gc.gc_wall_ms" , Counter . nsToMs . Stats.gc_elapsed_ns) , ("rts.gc.cpu_ms" , Counter . nsToMs . Stats.cpu_ns) , ("rts.gc.wall_ms" , Counter . nsToMs . Stats.elapsed_ns) , ("rts.gc.max_bytes_used" , Gauge . fromIntegral . Stats.max_live_bytes) , ("rts.gc.current_bytes_used" , Gauge . fromIntegral . Stats.gcdetails_live_bytes . Stats.gc) , ("rts.gc.current_bytes_slop" , Gauge . fromIntegral . Stats.gcdetails_slop_bytes . Stats.gc) , ("rts.gc.max_bytes_slop" , Gauge . fromIntegral . Stats.max_slop_bytes) , ("rts.gc.peak_megabytes_allocated" , Gauge . fromIntegral . (`quot` (1024*1024)) . Stats.max_mem_in_use_bytes) , ("rts.gc.par_tot_bytes_copied" , Gauge . fromIntegral . Stats.par_copied_bytes) , ("rts.gc.par_avg_bytes_copied" , Gauge . fromIntegral . Stats.par_copied_bytes) , ("rts.gc.par_max_bytes_copied" , Gauge . fromIntegral . Stats.cumulative_par_max_copied_bytes) ]) getRTSStats #else (M.fromList [ ("rts.gc.bytes_allocated" , Counter . Stats.bytesAllocated) , ("rts.gc.num_gcs" , Counter . Stats.numGcs) , ("rts.gc.num_bytes_usage_samples" , Counter . Stats.numByteUsageSamples) , ("rts.gc.cumulative_bytes_used" , Counter . Stats.cumulativeBytesUsed) , ("rts.gc.bytes_copied" , Counter . Stats.bytesCopied) , ("rts.gc.mutator_cpu_ms" , Counter . sToMs . Stats.mutatorCpuSeconds) , ("rts.gc.mutator_wall_ms" , Counter . sToMs . Stats.mutatorWallSeconds) , ("rts.gc.gc_cpu_ms" , Counter . sToMs . Stats.gcCpuSeconds) , ("rts.gc.gc_wall_ms" , Counter . sToMs . Stats.gcWallSeconds) , ("rts.gc.cpu_ms" , Counter . sToMs . Stats.cpuSeconds) , ("rts.gc.wall_ms" , Counter . sToMs . Stats.wallSeconds) , ("rts.gc.max_bytes_used" , Gauge . Stats.maxBytesUsed) , ("rts.gc.current_bytes_used" , Gauge . Stats.currentBytesUsed) , ("rts.gc.current_bytes_slop" , Gauge . Stats.currentBytesSlop) , ("rts.gc.max_bytes_slop" , Gauge . Stats.maxBytesSlop) , ("rts.gc.peak_megabytes_allocated" , Gauge . Stats.peakMegabytesAllocated) , ("rts.gc.par_tot_bytes_copied" , Gauge . gcParTotBytesCopied) , ("rts.gc.par_avg_bytes_copied" , Gauge . gcParTotBytesCopied) , ("rts.gc.par_max_bytes_copied" , Gauge . Stats.parMaxBytesCopied) ]) getGcStats #endif store #if MIN_VERSION_base(4,10,0) -- | Get RTS statistics. getRTSStats :: IO Stats.RTSStats getRTSStats = do enabled <- Stats.getRTSStatsEnabled if enabled then Stats.getRTSStats else return emptyRTSStats -- | Empty RTS statistics, as if the application hasn't started yet. emptyRTSStats :: Stats.RTSStats emptyRTSStats = Stats.RTSStats { gcs = 0 , major_gcs = 0 , allocated_bytes = 0 , max_live_bytes = 0 , max_large_objects_bytes = 0 , max_compact_bytes = 0 , max_slop_bytes = 0 , max_mem_in_use_bytes = 0 , cumulative_live_bytes = 0 , copied_bytes = 0 , par_copied_bytes = 0 , cumulative_par_max_copied_bytes = 0 # if MIN_VERSION_base(4,11,0) , cumulative_par_balanced_copied_bytes = 0 # if MIN_VERSION_base(4,12,0) , init_cpu_ns = 0 , init_elapsed_ns = 0 # endif # endif , mutator_cpu_ns = 0 , mutator_elapsed_ns = 0 , gc_cpu_ns = 0 , gc_elapsed_ns = 0 , cpu_ns = 0 , elapsed_ns = 0 , gc = emptyGCDetails } emptyGCDetails :: Stats.GCDetails emptyGCDetails = Stats.GCDetails { gcdetails_gen = 0 , gcdetails_threads = 0 , gcdetails_allocated_bytes = 0 , gcdetails_live_bytes = 0 , gcdetails_large_objects_bytes = 0 , gcdetails_compact_bytes = 0 , gcdetails_slop_bytes = 0 , gcdetails_mem_in_use_bytes = 0 , gcdetails_copied_bytes = 0 , gcdetails_par_max_copied_bytes = 0 # if MIN_VERSION_base(4,11,0) , gcdetails_par_balanced_copied_bytes = 0 # endif , gcdetails_sync_elapsed_ns = 0 , gcdetails_cpu_ns = 0 , gcdetails_elapsed_ns = 0 } #else -- | Get GC statistics. getGcStats :: IO Stats.GCStats # if MIN_VERSION_base(4,6,0) getGcStats = do enabled <- Stats.getGCStatsEnabled if enabled then Stats.getGCStats else return emptyGCStats -- | Empty GC statistics, as if the application hasn't started yet. emptyGCStats :: Stats.GCStats emptyGCStats = Stats.GCStats { bytesAllocated = 0 , numGcs = 0 , maxBytesUsed = 0 , numByteUsageSamples = 0 , cumulativeBytesUsed = 0 , bytesCopied = 0 , currentBytesUsed = 0 , currentBytesSlop = 0 , maxBytesSlop = 0 , peakMegabytesAllocated = 0 , mutatorCpuSeconds = 0 , mutatorWallSeconds = 0 , gcCpuSeconds = 0 , gcWallSeconds = 0 , cpuSeconds = 0 , wallSeconds = 0 , parTotBytesCopied = 0 , parMaxBytesCopied = 0 } # else getGcStats = Stats.getGCStats # endif -- | Helper to work around rename in GHC.Stats in base-4.6. gcParTotBytesCopied :: Stats.GCStats -> Int64 # if MIN_VERSION_base(4,6,0) gcParTotBytesCopied = Stats.parTotBytesCopied # else gcParTotBytesCopied = Stats.parAvgBytesCopied # endif #endif ------------------------------------------------------------------------ -- * Sampling metrics -- $sampling -- The metrics register in the store can be sampled together. Sampling -- is /not/ atomic. While each metric will be retrieved atomically, -- the sample is not an atomic snapshot of the system as a whole. See -- 'registerGroup' for an explanation of how to sample a subset of all -- metrics atomically. -- | A sample of some metrics. type Sample = M.HashMap T.Text Value -- | Sample all metrics. Sampling is /not/ atomic in the sense that -- some metrics might have been mutated before they're sampled but -- after some other metrics have already been sampled. sampleAll :: Store -> IO Sample sampleAll store = do state <- readIORef (storeState store) let metrics = stateMetrics state groups = stateGroups state cbSample <- sampleGroups $ IM.elems groups sample <- readAllRefs metrics let allSamples = sample ++ cbSample return $! M.fromList allSamples -- | Sample all metric groups. sampleGroups :: [GroupSampler] -> IO [(T.Text, Value)] sampleGroups cbSamplers = concat `fmap` sequence (map runOne cbSamplers) where runOne :: GroupSampler -> IO [(T.Text, Value)] runOne GroupSampler{..} = do a <- groupSampleAction return $! map (\ (n, f) -> (n, f a)) (M.toList groupSamplerMetrics) -- | The value of a sampled metric. data Value = Counter {-# UNPACK #-} !Int64 | Gauge {-# UNPACK #-} !Int64 | Label {-# UNPACK #-} !T.Text | Distribution !Distribution.Stats deriving (Eq, Show) sampleOne :: MetricSampler -> IO Value sampleOne (CounterS m) = Counter <$> m sampleOne (GaugeS m) = Gauge <$> m sampleOne (LabelS m) = Label <$> m sampleOne (DistributionS m) = Distribution <$> m -- | Get a snapshot of all values. Note that we're not guaranteed to -- see a consistent snapshot of the whole map. readAllRefs :: M.HashMap T.Text (Either MetricSampler GroupId) -> IO [(T.Text, Value)] readAllRefs m = do forM ([(name, ref) | (name, Left ref) <- M.toList m]) $ \ (name, ref) -> do val <- sampleOne ref return (name, val) ekg-core-0.1.1.7/System/Metrics/0000755000000000000000000000000007346545000014435 5ustar0000000000000000ekg-core-0.1.1.7/System/Metrics/Counter.hs0000644000000000000000000000164607346545000016417 0ustar0000000000000000-- | This module defines a type for mutable, integer-valued counters. -- Counters are non-negative, monotonically increasing values and can -- be used to track e.g. the number of requests served since program -- start. All operations on counters are thread-safe. module System.Metrics.Counter ( Counter , new , read , inc , add ) where import qualified Data.Atomic as Atomic import Data.Int (Int64) import Prelude hiding (read) -- | A mutable, integer-valued counter. newtype Counter = C { unC :: Atomic.Atomic } -- | Create a new, zero initialized, counter. new :: IO Counter new = C `fmap` Atomic.new 0 -- | Get the current value of the counter. read :: Counter -> IO Int64 read = Atomic.read . unC -- | Increase the counter by one. inc :: Counter -> IO () inc counter = add counter 1 -- | Add the argument to the counter. add :: Counter -> Int64 -> IO () add counter = Atomic.add (unC counter) ekg-core-0.1.1.7/System/Metrics/Distribution.hsc0000644000000000000000000001145307346545000017617 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -funbox-strict-fields #-} #include "distrib.h" -- | This module defines a type for tracking statistics about a series -- of events. An event could be handling of a request and the value -- associated with the event -- the value you'd pass to 'add' -- could -- be the amount of time spent serving that request (e.g. in -- milliseconds). All operations are thread safe. module System.Metrics.Distribution ( Distribution , new , add , addN , read -- * Gathered statistics , Stats , mean , variance , count , sum , min , max ) where import Control.Monad (forM_, replicateM) import Data.Int (Int64) import Foreign.C.Types (CInt) import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(alignment, peek, poke, sizeOf), peekByteOff, pokeByteOff) import Prelude hiding (max, min, read, sum) import Data.Array import System.Metrics.Distribution.Internal (Stats(..)) import System.Metrics.ThreadId -- | An metric for tracking events. newtype Distribution = Distribution { unD :: Array Stripe } data Stripe = Stripe { stripeFp :: !(ForeignPtr CDistrib) } data CDistrib = CDistrib { cCount :: !Int64 , cMean :: !Double , cSumSqDelta :: !Double , cSum :: !Double , cMin :: !Double , cMax :: !Double , cLock :: !Int64 -- ^ 0 - unlocked, 1 - locked } instance Storable CDistrib where sizeOf _ = (#size struct distrib) alignment _ = alignment (undefined :: CInt) peek p = do cCount <- (#peek struct distrib, count) p cMean <- (#peek struct distrib, mean) p cSumSqDelta <- (#peek struct distrib, sum_sq_delta) p cSum <- (#peek struct distrib, sum) p cMin <- (#peek struct distrib, min) p cMax <- (#peek struct distrib, max) p cLock <- (#peek struct distrib, lock) p return $! CDistrib { cCount = cCount , cMean = cMean , cSumSqDelta = cSumSqDelta , cSum = cSum , cMin = cMin , cMax = cMax , cLock = cLock } poke p CDistrib{..} = do (#poke struct distrib, count) p cCount (#poke struct distrib, mean) p cMean (#poke struct distrib, sum_sq_delta) p cSumSqDelta (#poke struct distrib, sum) p cSum (#poke struct distrib, min) p cMin (#poke struct distrib, max) p cMax (#poke struct distrib, lock) p cLock newCDistrib :: IO (ForeignPtr CDistrib) newCDistrib = do fp <- mallocForeignPtr withForeignPtr fp $ \ p -> poke p $ CDistrib { cCount = 0 , cMean = 0.0 , cSumSqDelta = 0.0 , cSum = 0.0 , cMin = 0.0 , cMax = 0.0 , cLock = 0 } return fp newStripe :: IO Stripe newStripe = do fp <- newCDistrib return $! Stripe { stripeFp = fp } -- | Number of lock stripes. Should be greater or equal to the number -- of HECs. numStripes :: Int numStripes = 8 -- | Get the stripe to use for this thread. myStripe :: Distribution -> IO Stripe myStripe distrib = do tid <- myCapability return $! unD distrib `index` (tid `mod` numStripes) ------------------------------------------------------------------------ -- Exposed API -- | Create a new distribution. new :: IO Distribution new = (Distribution . fromList numStripes) `fmap` replicateM numStripes newStripe -- | Add a value to the distribution. add :: Distribution -> Double -> IO () add distrib val = addN distrib val 1 foreign import ccall unsafe "hs_distrib_add_n" cDistribAddN :: Ptr CDistrib -> Double -> Int64 -> IO () -- | Add the same value to the distribution N times. addN :: Distribution -> Double -> Int64 -> IO () addN distrib val n = do stripe <- myStripe distrib withForeignPtr (stripeFp stripe) $ \ p -> cDistribAddN p val n foreign import ccall unsafe "hs_distrib_combine" combine :: Ptr CDistrib -> Ptr CDistrib -> IO () -- | Get the current statistical summary for the event being tracked. read :: Distribution -> IO Stats read distrib = do result <- newCDistrib CDistrib{..} <- withForeignPtr result $ \ resultp -> do forM_ (toList $ unD distrib) $ \ stripe -> withForeignPtr (stripeFp stripe) $ \ p -> combine p resultp peek resultp return $! Stats { mean = cMean , variance = if cCount == 0 then 0.0 else cSumSqDelta / fromIntegral cCount , count = cCount , sum = cSum , min = cMin , max = cMax } ekg-core-0.1.1.7/System/Metrics/Distribution/0000755000000000000000000000000007346545000017114 5ustar0000000000000000ekg-core-0.1.1.7/System/Metrics/Distribution/Internal.hs0000644000000000000000000000116107346545000021223 0ustar0000000000000000{-# OPTIONS_GHC -funbox-strict-fields #-} -- | Internal module used to share implementation details between the -- family of ekg packages. DO NOT DEPEND ON THIS MODULE. module System.Metrics.Distribution.Internal ( Stats(..) ) where import Data.Int (Int64) -- | Distribution statistics data Stats = Stats { mean :: !Double -- ^ Sample mean , variance :: !Double -- ^ Biased sample variance , count :: !Int64 -- ^ Event count , sum :: !Double -- ^ Sum of values , min :: !Double -- ^ Min value seen , max :: !Double -- ^ Max value seen } deriving (Eq, Show) ekg-core-0.1.1.7/System/Metrics/Gauge.hs0000644000000000000000000000232107346545000016017 0ustar0000000000000000-- | This module defines a type for mutable, integer-valued gauges. -- Gauges are variable values and can be used to track e.g. the -- current number of concurrent connections. All operations on gauges -- are thread-safe. module System.Metrics.Gauge ( Gauge , new , read , inc , dec , add , subtract , set ) where import qualified Data.Atomic as Atomic import Data.Int (Int64) import Prelude hiding (subtract, read) -- | A mutable, integer-valued gauge. newtype Gauge = C { unC :: Atomic.Atomic } -- | Create a new, zero initialized, gauge. new :: IO Gauge new = C `fmap` Atomic.new 0 -- | Get the current value of the gauge. read :: Gauge -> IO Int64 read = Atomic.read . unC -- | Increase the gauge by one. inc :: Gauge -> IO () inc gauge = add gauge 1 -- | Decrease the gauge by one. dec :: Gauge -> IO () dec gauge = subtract gauge 1 -- | Increase the gauge by the given amount. add :: Gauge -> Int64 -> IO () add gauge = Atomic.add (unC gauge) -- | Decrease the gauge by the given amount. subtract :: Gauge -> Int64 -> IO () subtract gauge = Atomic.subtract (unC gauge) -- | Set the gauge to the given value. set :: Gauge -> Int64 -> IO () set gauge = Atomic.write (unC gauge) ekg-core-0.1.1.7/System/Metrics/Label.hs0000644000000000000000000000204307346545000016007 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | This module defines a type for mutable, string-valued labels. -- Labels are variable values and can be used to track e.g. the -- command line arguments or other free-form values. All operations on -- labels are thread-safe. module System.Metrics.Label ( Label , new , read , set , modify ) where import Data.IORef (IORef, atomicModifyIORef', atomicWriteIORef, newIORef, readIORef) import qualified Data.Text as T import Prelude hiding (read) -- | A mutable, text-valued label. newtype Label = C { unC :: IORef T.Text } -- | Create a new empty label. new :: IO Label new = C `fmap` newIORef T.empty -- | Get the current value of the label. read :: Label -> IO T.Text read = readIORef . unC -- | Set the label to the given value. set :: Label -> T.Text -> IO () set (C ref) !i = atomicWriteIORef ref i -- | Set the label to the result of applying the given function to the -- value. modify :: (T.Text -> T.Text) -> Label -> IO () modify f (C ref) = atomicModifyIORef' ref $ \i -> (f i, ()) ekg-core-0.1.1.7/System/Metrics/ThreadId.hs0000644000000000000000000000053007346545000016453 0ustar0000000000000000{-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash #-} module System.Metrics.ThreadId ( myCapability ) where import qualified Control.Concurrent as Concurrent myCapability :: IO Int myCapability = (return . fst) =<< Concurrent.threadCapability =<< Concurrent.myThreadId ekg-core-0.1.1.7/benchmarks/0000755000000000000000000000000007346545000013660 5ustar0000000000000000ekg-core-0.1.1.7/benchmarks/Counter.hs0000644000000000000000000000106507346545000015635 0ustar0000000000000000{-# LANGUAGE BangPatterns, OverloadedStrings #-} -- | Perform 100,000 atomic increments using 100 concurrent writers. module Main where import Control.Concurrent import Control.Monad import System.Metrics.Counter main :: IO () main = do counter <- new locks <- replicateM n newEmptyMVar mapM_ (forkIO . work counter iters) locks mapM_ takeMVar locks where n = 100 iters = 100000 work :: Counter -> Int -> MVar () -> IO () work !_ 0 !lock = putMVar lock () work counter i lock = inc counter >> work counter (i - 1) lock ekg-core-0.1.1.7/benchmarks/Distribution.hs0000644000000000000000000000111407346545000016670 0ustar0000000000000000{-# LANGUAGE BangPatterns, OverloadedStrings #-} -- | Perform 100,000 atomic sample additions using 100 concurrent -- writers. module Main where import Control.Concurrent import Control.Monad import System.Metrics.Distribution main :: IO () main = do distrib <- new locks <- replicateM n newEmptyMVar mapM_ (forkIO . work distrib iters) locks mapM_ takeMVar locks where n = 100 iters = 100000 work :: Distribution -> Int -> MVar () -> IO () work !_ 0 !lock = putMVar lock () work distrib i lock = add distrib 1.0 >> work distrib (i - 1) lock ekg-core-0.1.1.7/cbits/0000755000000000000000000000000007346545000012647 5ustar0000000000000000ekg-core-0.1.1.7/cbits/atomic.c0000644000000000000000000000057407346545000014275 0ustar0000000000000000#include "HsFFI.h" void hs_atomic_add(volatile StgInt64* atomic, StgInt64 n) { __sync_fetch_and_add(atomic, n); } void hs_atomic_subtract(volatile StgInt64* atomic, StgInt64 n) { __sync_fetch_and_sub(atomic, n); } StgInt64 hs_atomic_read(volatile const StgInt64* atomic) { return *atomic; } void hs_atomic_write(volatile StgInt64* atomic, StgInt64 n) { *atomic = n; } ekg-core-0.1.1.7/cbits/distrib.c0000644000000000000000000000327507346545000014462 0ustar0000000000000000#include "HsFFI.h" #include "distrib.h" static void hs_lock(volatile StgInt64* lock) { while(!__sync_bool_compare_and_swap(lock, 0, 1)); } static void hs_unlock(volatile StgInt64* lock) { *lock = 0; } // Mean and variance are computed according to // http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Online_algorithm void hs_distrib_add_n(struct distrib* distrib, StgDouble val, StgInt64 n) { hs_lock(&distrib->lock); const StgInt64 count = distrib->count + n; const StgDouble delta = val - distrib->mean; const StgDouble mean = distrib->mean + n * delta / count; const StgDouble sum_sq_delta = distrib->sum_sq_delta + delta * (val - mean) * n; distrib->count = count; distrib->mean = mean; distrib->sum_sq_delta = sum_sq_delta; distrib->sum += val; distrib->min = val < distrib->min ? val : distrib->min; distrib->max = val > distrib->max ? val : distrib->max; hs_unlock(&distrib->lock); } // http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Parallel_algorithm void hs_distrib_combine(struct distrib* b, struct distrib* a) { hs_lock(&b->lock); const StgInt64 count = a->count + b->count; const StgDouble delta = b->mean - a->mean; const StgDouble mean = (a->count * a->mean + b->count * b->mean) / count; const StgDouble sum_sq_delta = (a->sum_sq_delta + b->sum_sq_delta + delta * delta * (a->count * b->count) / count); a->count = count; a->mean = (count == 0) ? 0.0 : mean; // divide-by-zero gives NaN a->sum_sq_delta = sum_sq_delta; a->sum = a->sum + b->sum; a->min = b->min; // This is slightly hacky, but ok: see a->max = b->max; // 813aa426be78e8abcf1c7cdd43433bcffa07828e hs_unlock(&b->lock); } ekg-core-0.1.1.7/cbits/distrib.h0000644000000000000000000000076507346545000014470 0ustar0000000000000000#include "HsFFI.h" struct distrib { StgInt64 count; StgDouble mean; StgDouble sum_sq_delta; StgDouble sum; StgDouble min; StgDouble max; volatile StgInt64 lock; }; void hs_distrib_add_n(struct distrib* distrib, StgDouble val, StgInt64 n); /* * Combine 'b' with 'a', writing the result in 'a'. Takes the lock of * 'b' while combining, but doesn't otherwise modify 'b'. 'a' is * assumed to not be used concurrently. */ void hs_distrib_combine(struct distrib* b, struct distrib* a); ekg-core-0.1.1.7/ekg-core.cabal0000644000000000000000000000363607346545000014233 0ustar0000000000000000cabal-version: 1.18 name: ekg-core version: 0.1.1.7 synopsis: Tracking of system metrics description: This library lets you defined and track system metrics. homepage: https://github.com/tibbe/ekg-core bug-reports: https://github.com/tibbe/ekg-core/issues license: BSD3 license-file: LICENSE author: Johan Tibell maintainer: Johan Tibell , Mikhail Glushenkov category: System build-type: Simple extra-source-files: CHANGES.md tested-with: GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3, GHC == 7.8.4, GHC == 7.6.3 library exposed-modules: System.Metrics System.Metrics.Counter System.Metrics.Distribution System.Metrics.Distribution.Internal System.Metrics.Gauge System.Metrics.Label other-modules: Data.Array Data.Atomic System.Metrics.ThreadId build-depends: ghc-prim < 0.6, base >= 4.6 && < 4.14, containers >= 0.5 && < 0.7, text < 1.3, unordered-containers < 0.3 default-language: Haskell2010 ghc-options: -Wall if arch(i386) cc-options: -march=i686 includes: distrib.h install-includes: distrib.h include-dirs: cbits c-sources: cbits/atomic.c cbits/distrib.c benchmark counter main-is: Counter.hs type: exitcode-stdio-1.0 build-depends: base, ekg-core default-language: Haskell2010 hs-source-dirs: benchmarks ghc-options: -O2 -threaded -Wall benchmark distribution main-is: Distribution.hs type: exitcode-stdio-1.0 build-depends: base, ekg-core default-language: Haskell2010 hs-source-dirs: benchmarks ghc-options: -O2 -threaded -Wall source-repository head type: git location: https://github.com/tibbe/ekg-core.git