module System.Metrics.Prometheus.Metric.Histogram where
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Map (Map)
import qualified Data.Map as Map
newtype Histogram = Histogram { unHistogram :: IORef HistogramSample }
type UpperBound = Double
type Count = Int
type Buckets = Map UpperBound Count
data HistogramSample =
HistogramSample
{ histBuckets :: Buckets
, histSum :: Double
, histCount :: Count
}
new :: [UpperBound] -> IO Histogram
new buckets = Histogram <$> newIORef empty
where empty = HistogramSample (Map.fromList $ map (, 0) (read "Infinity" : buckets)) 0.0 0
put :: Double -> Histogram -> IO ()
put x ioref = atomicModifyIORef' (unHistogram ioref) update
where update histData = (hist' histData, ())
hist' histData =
histData { histBuckets = updateBuckets x $ histBuckets histData
, histSum = histSum histData + x
, histCount = histCount histData + 1
}
updateBuckets :: Double -> Buckets -> Buckets
updateBuckets x = Map.mapWithKey updateBucket
where updateBucket key val
| x <= key = val + 1
| otherwise = val
sample :: Histogram -> IO HistogramSample
sample = readIORef . unHistogram