diff --git a/Data/Atomic.hs b/Data/Atomic.hs index fc80d6e..98a5501 100644 --- a/Data/Atomic.hs +++ b/Data/Atomic.hs @@ -12,32 +12,33 @@ module Data.Atomic , subtract ) where -import Data.Int +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 Int) +newtype Atomic = C (ForeignPtr Int64) -- | Create a new, zero initialized, atomic. -new :: Int -> IO Atomic +new :: Int64 -> IO Atomic new n = do fp <- mallocForeignPtr withForeignPtr fp $ \ p -> poke p n return $ C fp -read :: Atomic -> IO Int +read :: Atomic -> IO Int64 read (C fp) = withForeignPtr fp cRead -foreign import ccall unsafe "hs_atomic_read" cRead :: Ptr Int -> IO Int +foreign import ccall unsafe "hs_atomic_read" cRead :: Ptr Int64 -> IO Int64 -- | Set the atomic to the given value. -write :: Atomic -> Int -> IO () +write :: Atomic -> Int64 -> IO () write (C fp) n = withForeignPtr fp $ \ p -> cWrite p n -foreign import ccall unsafe "hs_atomic_write" cWrite :: Ptr Int -> Int -> IO () +foreign import ccall unsafe "hs_atomic_write" cWrite + :: Ptr Int64 -> Int64 -> IO () -- | Increase the atomic by one. inc :: Atomic -> IO () @@ -48,16 +49,16 @@ dec :: Atomic -> IO () dec atomic = subtract atomic 1 -- | Increase the atomic by the given amount. -add :: Atomic -> Int -> IO () +add :: Atomic -> Int64 -> IO () add (C fp) n = withForeignPtr fp $ \ p -> cAdd p n -- | Decrease the atomic by the given amount. -subtract :: Atomic -> Int -> IO () +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 Int -> Int -> IO () +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 Int -> Int -> IO () + :: Ptr Int64 -> Int64 -> IO () diff --git a/System/Metrics.hs b/System/Metrics.hs index 33d01ab..04a559a 100644 --- a/System/Metrics.hs +++ b/System/Metrics.hs @@ -125,8 +125,8 @@ data GroupSampler = forall a. GroupSampler } -- TODO: Rename this to Metric and Metric to SampledMetric. -data MetricSampler = CounterS !(IO Int) - | GaugeS !(IO Int) +data MetricSampler = CounterS !(IO Int64) + | GaugeS !(IO Int64) | LabelS !(IO T.Text) -- | Create a new, empty metric store. @@ -146,18 +146,18 @@ newStore = do -- | Register a non-negative, monotonically increasing, integer-valued -- metric. The provided action to read the value must be thread-safe. -registerCounter :: T.Text -- ^ Metric name - -> IO Int -- ^ Action to read the current metric value - -> Store -- ^ Metric store +registerCounter :: T.Text -- ^ Metric 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. -registerGauge :: T.Text -- ^ Metric name - -> IO Int -- ^ Action to read the current metric value - -> Store -- ^ Metric store +registerGauge :: T.Text -- ^ Metric name + -> IO Int64 -- ^ Action to read the current metric value + -> Store -- ^ Metric store -> IO () registerGauge name sample store = register name (GaugeS sample) store @@ -231,8 +231,8 @@ alreadyInUseError name = -- > main = do -- > store <- newStore -- > let metrics = --- > [ ("num_gcs", Counter . fromIntegral . numGcs) --- > , ("max_bytes_used", Gauge . fromIntegral . maxBytesUsed) +-- > [ ("num_gcs", Counter . numGcs) +-- > , ("max_bytes_used", Gauge . maxBytesUsed) -- > ] -- > registerGroup (M.fromList metrics) getGCStats store registerGroup @@ -301,7 +301,7 @@ createLabel name store = do -- function. -- | Convert seconds to milliseconds. -toMs :: Double -> Int +toMs :: Double -> Int64 toMs s = round (s * 1000.0) -- | Register a number of metrics related to garbage collector @@ -380,30 +380,28 @@ registerGcMetrics :: Store -> IO () registerGcMetrics store = registerGroup (M.fromList - [ ("rts.gc.bytes_allocated" , Counter . int . Stats.bytesAllocated) - , ("rts.gc.num_gcs" , Counter . int . Stats.numGcs) - , ("rts.gc.num_bytes_usage_samples" , Counter . int . Stats.numByteUsageSamples) - , ("rts.gc.cumulative_bytes_used" , Counter . int . Stats.cumulativeBytesUsed) - , ("rts.gc.bytes_copied" , Counter . int . Stats.bytesCopied) + [ ("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 . toMs . Stats.mutatorCpuSeconds) , ("rts.gc.mutator_wall_ms" , Counter . toMs . Stats.mutatorWallSeconds) , ("rts.gc.gc_cpu_ms" , Counter . toMs . Stats.gcCpuSeconds) , ("rts.gc.gc_wall_ms" , Counter . toMs . Stats.gcWallSeconds) , ("rts.gc.cpu_ms" , Counter . toMs . Stats.cpuSeconds) , ("rts.gc.wall_ms" , Counter . toMs . Stats.wallSeconds) - , ("rts.gc.max_bytes_used" , Gauge . int . Stats.maxBytesUsed) - , ("rts.gc.current_bytes_used" , Gauge . int . Stats.currentBytesUsed) - , ("rts.gc.current_bytes_slop" , Gauge . int . Stats.currentBytesSlop) - , ("rts.gc.max_bytes_slop" , Gauge . int . Stats.maxBytesSlop) - , ("rts.gc.peak_megabytes_allocated" , Gauge . int . Stats.peakMegabytesAllocated) - , ("rts.gc.par_tot_bytes_copied" , Gauge . int . gcParTotBytesCopied) - , ("rts.gc.par_avg_bytes_copied" , Gauge . int . gcParTotBytesCopied) - , ("rts.gc.par_max_bytes_copied" , Gauge . int . Stats.parMaxBytesCopied) + , ("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 store - where - int = fromIntegral -- | Get GC statistics. getGcStats :: IO Stats.GCStats @@ -484,8 +482,8 @@ sampleGroups cbSamplers = concat `fmap` sequence (map runOne cbSamplers) return $! map (\ (n, f) -> (n, f a)) (M.toList groupSamplerMetrics) -- | The value of a sampled metric. -data Value = Counter {-# UNPACK #-} !Int - | Gauge {-# UNPACK #-} !Int +data Value = Counter {-# UNPACK #-} !Int64 + | Gauge {-# UNPACK #-} !Int64 | Label {-# UNPACK #-} !T.Text deriving (Eq, Show) diff --git a/System/Metrics/Counter.hs b/System/Metrics/Counter.hs index 55adc8f..847dc3f 100644 --- a/System/Metrics/Counter.hs +++ b/System/Metrics/Counter.hs @@ -12,6 +12,7 @@ module System.Metrics.Counter ) where import qualified Data.Atomic as Atomic +import Data.Int (Int64) import Prelude hiding (read) -- | A mutable, integer-valued counter. @@ -22,7 +23,7 @@ new :: IO Counter new = C `fmap` Atomic.new 0 -- | Get the current value of the counter. -read :: Counter -> IO Int +read :: Counter -> IO Int64 read = Atomic.read . unC -- | Increase the counter by one. @@ -30,5 +31,5 @@ inc :: Counter -> IO () inc counter = add counter 1 -- | Add the argument to the counter. -add :: Counter -> Int -> IO () +add :: Counter -> Int64 -> IO () add counter = Atomic.add (unC counter) diff --git a/System/Metrics/Gauge.hs b/System/Metrics/Gauge.hs index b91fe4c..0702ea9 100644 --- a/System/Metrics/Gauge.hs +++ b/System/Metrics/Gauge.hs @@ -15,6 +15,7 @@ module System.Metrics.Gauge ) where import qualified Data.Atomic as Atomic +import Data.Int (Int64) import Prelude hiding (subtract, read) -- | A mutable, integer-valued gauge. @@ -25,7 +26,7 @@ new :: IO Gauge new = C `fmap` Atomic.new 0 -- | Get the current value of the gauge. -read :: Gauge -> IO Int +read :: Gauge -> IO Int64 read = Atomic.read . unC -- | Increase the gauge by one. @@ -37,13 +38,13 @@ dec :: Gauge -> IO () dec gauge = subtract gauge 1 -- | Increase the gauge by the given amount. -add :: Gauge -> Int -> IO () +add :: Gauge -> Int64 -> IO () add gauge = Atomic.add (unC gauge) -- | Decrease the gauge by the given amount. -subtract :: Gauge -> Int -> IO () +subtract :: Gauge -> Int64 -> IO () subtract gauge = Atomic.subtract (unC gauge) -- | Set the gauge to the given value. -set :: Gauge -> Int -> IO () +set :: Gauge -> Int64 -> IO () set gauge = Atomic.write (unC gauge) diff --git a/cbits/atomic.c b/cbits/atomic.c index c7d1101..e9f01da 100644 --- a/cbits/atomic.c +++ b/cbits/atomic.c @@ -1,17 +1,17 @@ #include "HsFFI.h" -void hs_atomic_add(volatile StgInt* atomic, StgInt n) { +void hs_atomic_add(volatile StgInt64* atomic, StgInt64 n) { __sync_fetch_and_add(atomic, n); } -void hs_atomic_subtract(volatile StgInt* atomic, StgInt n) { +void hs_atomic_subtract(volatile StgInt64* atomic, StgInt64 n) { __sync_fetch_and_sub(atomic, n); } -StgInt hs_atomic_read(volatile const StgInt* atomic) { +StgInt64 hs_atomic_read(volatile const StgInt64* atomic) { return *atomic; } -void hs_atomic_write(volatile StgInt* atomic, StgInt n) { +void hs_atomic_write(volatile StgInt64* atomic, StgInt64 n) { *atomic = n; } diff --git a/examples/Group.hs b/examples/Group.hs index 7b56275..4a25d55 100644 --- a/examples/Group.hs +++ b/examples/Group.hs @@ -6,7 +6,7 @@ import System.Metrics main = do store <- newStore let metrics = - [ ("num_gcs", Counter . fromIntegral . numGcs) - , ("max_bytes_used", Gauge . fromIntegral . maxBytesUsed) + [ ("num_gcs", Counter . numGcs) + , ("max_bytes_used", Gauge . maxBytesUsed) ] registerGroup (M.fromList metrics) getGCStats store