{-# LANGUAGE TupleSections #-}
module System.Metrics.Prometheus.Metric.Histogram (
Histogram,
HistogramSample (..),
Buckets,
UpperBound,
new,
observe,
sample,
observeAndSample,
) where
import Control.Applicative ((<$>))
import Control.Monad (void)
import Data.Bool (bool)
import Data.IORef (
IORef,
atomicModifyIORef',
newIORef,
readIORef,
)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
newtype Histogram = Histogram {Histogram -> IORef HistogramSample
unHistogram :: IORef HistogramSample}
type UpperBound = Double
type Buckets = Map UpperBound Double
data HistogramSample = HistogramSample
{ HistogramSample -> Buckets
histBuckets :: !Buckets
, HistogramSample -> Double
histSum :: !Double
, HistogramSample -> Int
histCount :: !Int
}
new :: [UpperBound] -> IO Histogram
new :: [Double] -> IO Histogram
new [Double]
buckets = IORef HistogramSample -> Histogram
Histogram forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef HistogramSample
empty
where
empty :: HistogramSample
empty = Buckets -> Double -> Int -> HistogramSample
HistogramSample (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (,Double
0) (forall a. Read a => String -> a
read String
"Infinity" forall a. a -> [a] -> [a]
: [Double]
buckets)) Double
zeroSum Int
zeroCount
zeroSum :: Double
zeroSum = Double
0.0
zeroCount :: Int
zeroCount = Int
0
observeAndSample :: Double -> Histogram -> IO HistogramSample
observeAndSample :: Double -> Histogram -> IO HistogramSample
observeAndSample Double
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' HistogramSample -> (HistogramSample, HistogramSample)
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. Histogram -> IORef HistogramSample
unHistogram
where
update :: HistogramSample -> (HistogramSample, HistogramSample)
update HistogramSample
histData = (HistogramSample -> HistogramSample
hist' HistogramSample
histData, HistogramSample
histData)
hist' :: HistogramSample -> HistogramSample
hist' HistogramSample
histData =
HistogramSample
histData
{ histBuckets :: Buckets
histBuckets = Double -> Buckets -> Buckets
updateBuckets Double
x forall a b. (a -> b) -> a -> b
$ HistogramSample -> Buckets
histBuckets HistogramSample
histData
, histSum :: Double
histSum = HistogramSample -> Double
histSum HistogramSample
histData forall a. Num a => a -> a -> a
+ Double
x
, histCount :: Int
histCount = HistogramSample -> Int
histCount HistogramSample
histData forall a. Num a => a -> a -> a
+ Int
1
}
observe :: Double -> Histogram -> IO ()
observe :: Double -> Histogram -> IO ()
observe Double
x = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Histogram -> IO HistogramSample
observeAndSample Double
x
updateBuckets :: Double -> Buckets -> Buckets
updateBuckets :: Double -> Buckets -> Buckets
updateBuckets Double
x = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey forall {a}. Num a => Double -> a -> a
updateBucket
where
updateBucket :: Double -> a -> a
updateBucket Double
key a
val = forall a. a -> a -> Bool -> a
bool a
val (a
val forall a. Num a => a -> a -> a
+ a
1) (Double
x forall a. Ord a => a -> a -> Bool
<= Double
key)
sample :: Histogram -> IO HistogramSample
sample :: Histogram -> IO HistogramSample
sample = forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Histogram -> IORef HistogramSample
unHistogram