{-# 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 -- Inclusive upper bounds
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