{-# language BangPatterns #-}
{-# language OverloadedStrings #-}
module Prometheus.Metric.Summary (
    Summary
,   Quantile
,   summary
,   defaultQuantiles
,   observe
,   observeDuration
,   getSummary
) where

import Prometheus.Info
import Prometheus.Metric
import Prometheus.Metric.Observer
import Prometheus.MonadMonitor

import Control.Concurrent.MVar
import Control.DeepSeq
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import qualified Data.ByteString.UTF8 as BS
import qualified Data.Text as T
import DataSketches.Quantiles.RelativeErrorQuantile
import qualified DataSketches.Quantiles.RelativeErrorQuantile as ReqSketch
import Data.Maybe (mapMaybe)
import Prelude hiding (maximum)
import qualified Prelude
import Data.Word

data Summary = MkSummary
  { Summary -> MVar (ReqSketch (PrimState IO))
reqSketch :: MVar (ReqSketch (PrimState IO))
  , Summary -> [Quantile]
quantiles :: [Quantile]
  }

instance NFData Summary where
  rnf :: Summary -> ()
rnf (MkSummary MVar (ReqSketch (PrimState IO))
a [Quantile]
b) = MVar (ReqSketch (PrimState IO))
a seq :: forall a b. a -> b -> b
`seq` [Quantile]
b forall a b. NFData a => a -> b -> b
`deepseq` ()


type Quantile = (Rational, Rational)

-- | K is a parameter divisible by two, in the range 4-1024 used in the RelativeErrorQuantile algorithm to 
-- determine how many items must be retained per compaction section. As the value increases, the accuracy
-- of the sketch increases as well. This function iterates on the k value starting from 6 
-- (conservative on space, but reasonably accurate) until it finds a K value that satisfies the specified 
-- error bounds for the given quantile. Note: this algorithm maintains highest accuracy for the upper tail 
-- of the quantile when passed the 'HighRanksAreAccurate', sampling out more items at lower ranks during 
-- the compaction process. Thus, extremely tight error bounds on low quantile values may cause this 
-- function to return 'Nothing'.
--
-- If another smart constructor was exposed for summary creation, specific k values & LowRanksAreAccurate
-- could be used to refine accuracy settings to bias towards lower quantiles when retaining accurate samples.
determineK :: Quantile -> Maybe Word32
determineK :: Quantile -> Maybe Word32
determineK (Rational
rank_, Rational
acceptableError) = forall {t}. Integral t => t -> Maybe t
go Word32
6
    where
        go :: t -> Maybe t
go t
k =
            let rse :: Double
rse = Int -> Double -> RankAccuracy -> Word64 -> Double
relativeStandardError (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
k) (forall a. Fractional a => Rational -> a
fromRational Rational
rank_) RankAccuracy
HighRanksAreAccurate Word64
50000
            in if forall a. Num a => a -> a
abs (Double
rse forall a. Num a => a -> a -> a
- forall a. Fractional a => Rational -> a
fromRational Rational
rank_) forall a. Ord a => a -> a -> Bool
<= forall a. Fractional a => Rational -> a
fromRational Rational
acceptableError
                then forall a. a -> Maybe a
Just t
k
                else if t
k forall a. Ord a => a -> a -> Bool
< t
1024
                    then t -> Maybe t
go (t
k forall a. Num a => a -> a -> a
+ t
2)
                    else forall a. Maybe a
Nothing


-- | Creates a new summary metric with a given name, help string, and a list of
-- quantiles. A reasonable set set of quantiles is provided by
-- 'defaultQuantiles'.
summary :: Info -> [Quantile] -> Metric Summary
summary :: Info -> [Quantile] -> Metric Summary
summary Info
info [Quantile]
quantiles_ = forall s. IO (s, IO [SampleGroup]) -> Metric s
Metric forall a b. (a -> b) -> a -> b
$ do
    ReqSketch RealWorld
rs <- forall (m :: * -> *).
PrimMonad m =>
Word32 -> RankAccuracy -> m (ReqSketch (PrimState m))
mkReqSketch Word32
kInt RankAccuracy
HighRanksAreAccurate
    MVar (ReqSketch RealWorld)
mv <- forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$ ReqSketch RealWorld
rs {criterion :: Criterion
criterion = Criterion
(:<=)}
    let summary_ :: Summary
summary_ = MVar (ReqSketch (PrimState IO)) -> [Quantile] -> Summary
MkSummary MVar (ReqSketch RealWorld)
mv [Quantile]
quantiles_
    forall (m :: * -> *) a. Monad m => a -> m a
return (Summary
summary_, Info -> Summary -> IO [SampleGroup]
collectSummary Info
info Summary
summary_)
    where
        kInt :: Word32
kInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Quantile -> Maybe Word32
determineK [Quantile]
quantiles_ of
          [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"Unable to create a Summary meeting the provided quantile precision requirements"
          [Word32]
xs -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Prelude.maximum [Word32]
xs

instance Observer Summary where
    -- | Adds a new observation to a summary metric.
    observe :: forall (m :: * -> *). MonadMonitor m => Summary -> Double -> m ()
observe Summary
s Double
v = forall (m :: * -> *). MonadMonitor m => IO () -> m ()
doIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Summary -> MVar (ReqSketch (PrimState IO))
reqSketch Summary
s) (forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m ()
`ReqSketch.insert` Double
v)

-- | Retrieves a list of tuples containing a quantile and its associated value.
getSummary :: MonadIO m => Summary -> m [(Rational, Double)]
getSummary :: forall (m :: * -> *).
MonadIO m =>
Summary -> m [(Rational, Double)]
getSummary (MkSummary MVar (ReqSketch (PrimState IO))
sketchVar [Quantile]
quantiles_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (ReqSketch (PrimState IO))
sketchVar forall a b. (a -> b) -> a -> b
$ \ReqSketch RealWorld
sketch -> do
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Quantile]
quantiles_ forall a b. (a -> b) -> a -> b
$ \Quantile
qv ->
    (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a, b) -> a
fst Quantile
qv) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m Double
ReqSketch.quantile ReqSketch RealWorld
sketch (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst Quantile
qv)

collectSummary :: Info -> Summary -> IO [SampleGroup]
collectSummary :: Info -> Summary -> IO [SampleGroup]
collectSummary Info
info (MkSummary MVar (ReqSketch (PrimState IO))
sketchVar [Quantile]
quantiles_) = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (ReqSketch (PrimState IO))
sketchVar forall a b. (a -> b) -> a -> b
$ \ReqSketch RealWorld
sketch -> do
    Double
itemSum <- forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Double
ReqSketch.sum ReqSketch RealWorld
sketch
    Word64
count_ <- forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> m Word64
ReqSketch.count ReqSketch RealWorld
sketch
    [(Rational, Double)]
estimatedQuantileValues <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Quantile]
quantiles_ forall a b. (a -> b) -> a -> b
$ \Quantile
qv ->
      (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a, b) -> a
fst Quantile
qv) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
PrimMonad m =>
ReqSketch (PrimState m) -> Double -> m Double
ReqSketch.quantile ReqSketch RealWorld
sketch (Rational -> Double
toDouble forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst Quantile
qv)
    let sumSample :: Sample
sumSample = Text -> LabelPairs -> ByteString -> Sample
Sample (Info -> Text
metricName Info
info forall a. Semigroup a => a -> a -> a
<> Text
"_sum") [] (forall s. Show s => s -> ByteString
bsShow Double
itemSum)
    let countSample :: Sample
countSample = Text -> LabelPairs -> ByteString -> Sample
Sample (Info -> Text
metricName Info
info forall a. Semigroup a => a -> a -> a
<> Text
"_count") [] (forall s. Show s => s -> ByteString
bsShow Word64
count_)
    forall (m :: * -> *) a. Monad m => a -> m a
return [Info -> SampleType -> [Sample] -> SampleGroup
SampleGroup Info
info SampleType
SummaryType forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Rational, Double) -> Sample
toSample [(Rational, Double)]
estimatedQuantileValues forall a. [a] -> [a] -> [a]
++ [Sample
sumSample, Sample
countSample]]
    where
        bsShow :: Show s => s -> BS.ByteString
        bsShow :: forall s. Show s => s -> ByteString
bsShow = [Char] -> ByteString
BS.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

        toSample :: (Rational, Double) -> Sample
        toSample :: (Rational, Double) -> Sample
toSample (Rational
q, Double
estimatedValue) =
            Text -> LabelPairs -> ByteString -> Sample
Sample (Info -> Text
metricName Info
info) [(Text
"quantile", [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Rational -> Double
toDouble Rational
q)] forall a b. (a -> b) -> a -> b
$
                forall s. Show s => s -> ByteString
bsShow Double
estimatedValue

        toDouble :: Rational -> Double
        toDouble :: Rational -> Double
toDouble = forall a. Fractional a => Rational -> a
fromRational

defaultQuantiles :: [Quantile]
defaultQuantiles :: [Quantile]
defaultQuantiles = [(Rational
0.5, Rational
0.05), (Rational
0.9, Rational
0.01), (Rational
0.99, Rational
0.001)]