{-# LANGUAGE TemplateHaskell, DeriveGeneric, RecordWildCards #-}
{-# LANGUAGE TypeApplications, TupleSections, OverloadedStrings #-}
module NgxExport.Tools.Prometheus (
scale
,scale1000
) where
import NgxExport
import NgxExport.Tools.Read
import NgxExport.Tools.SimpleService
import NgxExport.Tools.SplitService
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import Data.IORef
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Aeson
import Data.Maybe
import Data.Function
import Data.List
import Data.Char
import Data.Word
import Data.Array.ST hiding (range)
import Control.Arrow
import Control.Monad
import Control.Monad.ST
import System.IO.Unsafe
import GHC.Generics
import Safe
type ServerName = Text
type MetricsName = Text
type MetricsHelp = Text
type MetricsLabel = Text
type MetricsAnnotation = Text
type CounterValue = Word64
type MetricsData = Map MetricsName CounterValue
type HistogramData = Map MetricsName (MetricsLabel, MetricsRole, Double)
type MetricsToLabelMap = Map MetricsName MetricsLabel
data PrometheusConf =
PrometheusConf { PrometheusConf -> Map MetricsHelp MetricsHelp
pcMetrics :: Map MetricsName MetricsHelp
, PrometheusConf -> HashSet MetricsHelp
pcGauges :: HashSet MetricsName
, PrometheusConf -> HashSet MetricsHelp
pcScale1000 :: HashSet MetricsName
} deriving ReadPrec [PrometheusConf]
ReadPrec PrometheusConf
Int -> ReadS PrometheusConf
ReadS [PrometheusConf]
(Int -> ReadS PrometheusConf)
-> ReadS [PrometheusConf]
-> ReadPrec PrometheusConf
-> ReadPrec [PrometheusConf]
-> Read PrometheusConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PrometheusConf
readsPrec :: Int -> ReadS PrometheusConf
$creadList :: ReadS [PrometheusConf]
readList :: ReadS [PrometheusConf]
$creadPrec :: ReadPrec PrometheusConf
readPrec :: ReadPrec PrometheusConf
$creadListPrec :: ReadPrec [PrometheusConf]
readListPrec :: ReadPrec [PrometheusConf]
Read
data HistogramLayout =
HistogramLayout { HistogramLayout -> Map MetricsHelp MetricsHelp
range :: MetricsToLabelMap
, HistogramLayout -> (MetricsHelp, MetricsHelp)
cnt :: (MetricsName, MetricsLabel)
, HistogramLayout -> (MetricsHelp, MetricsHelp)
err :: (MetricsName, MetricsLabel)
} deriving (forall x. HistogramLayout -> Rep HistogramLayout x)
-> (forall x. Rep HistogramLayout x -> HistogramLayout)
-> Generic HistogramLayout
forall x. Rep HistogramLayout x -> HistogramLayout
forall x. HistogramLayout -> Rep HistogramLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HistogramLayout -> Rep HistogramLayout x
from :: forall x. HistogramLayout -> Rep HistogramLayout x
$cto :: forall x. Rep HistogramLayout x -> HistogramLayout
to :: forall x. Rep HistogramLayout x -> HistogramLayout
Generic
instance FromJSON HistogramLayout
type AllCounters = Map ServerName MetricsData
type AllHistogramsLayout = Map ServerName (Map MetricsName HistogramLayout)
type AllOtherCounters = MetricsData
type AllMetrtics =
(ServerName, AllCounters, AllHistogramsLayout, AllOtherCounters)
data MetricsType = Counter Double MetricsAnnotation
| Gauge Double MetricsAnnotation
| Histogram HistogramData MetricsAnnotation
data MetricsRole = HistogramBucket
| HistogramSum
| HistogramCount deriving MetricsRole -> MetricsRole -> Bool
(MetricsRole -> MetricsRole -> Bool)
-> (MetricsRole -> MetricsRole -> Bool) -> Eq MetricsRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricsRole -> MetricsRole -> Bool
== :: MetricsRole -> MetricsRole -> Bool
$c/= :: MetricsRole -> MetricsRole -> Bool
/= :: MetricsRole -> MetricsRole -> Bool
Eq
type PrometheusMetrics = Map MetricsName (MetricsHelp, [MetricsType])
conf :: IORef (Maybe PrometheusConf)
conf :: IORef (Maybe PrometheusConf)
conf = IO (IORef (Maybe PrometheusConf)) -> IORef (Maybe PrometheusConf)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe PrometheusConf)) -> IORef (Maybe PrometheusConf))
-> IO (IORef (Maybe PrometheusConf))
-> IORef (Maybe PrometheusConf)
forall a b. (a -> b) -> a -> b
$ Maybe PrometheusConf -> IO (IORef (Maybe PrometheusConf))
forall a. a -> IO (IORef a)
newIORef Maybe PrometheusConf
forall a. Maybe a
Nothing
{-# NOINLINE conf #-}
prometheusConf :: PrometheusConf -> Bool -> IO L.ByteString
prometheusConf :: PrometheusConf -> Bool -> IO ByteString
prometheusConf = (PrometheusConf -> IO ByteString)
-> PrometheusConf -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((PrometheusConf -> IO ByteString)
-> PrometheusConf -> Bool -> IO ByteString)
-> (PrometheusConf -> IO ByteString)
-> PrometheusConf
-> Bool
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \PrometheusConf
a -> do
IORef (Maybe PrometheusConf) -> Maybe PrometheusConf -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe PrometheusConf)
conf (Maybe PrometheusConf -> IO ()) -> Maybe PrometheusConf -> IO ()
forall a b. (a -> b) -> a -> b
$ PrometheusConf -> Maybe PrometheusConf
forall a. a -> Maybe a
Just PrometheusConf
a
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
ngxExportSimpleServiceTyped 'prometheusConf ''PrometheusConf SingleShotService
toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' PrometheusConf {Map MetricsHelp MetricsHelp
HashSet MetricsHelp
pcMetrics :: PrometheusConf -> Map MetricsHelp MetricsHelp
pcGauges :: PrometheusConf -> HashSet MetricsHelp
pcScale1000 :: PrometheusConf -> HashSet MetricsHelp
pcMetrics :: Map MetricsHelp MetricsHelp
pcGauges :: HashSet MetricsHelp
pcScale1000 :: HashSet MetricsHelp
..} (MetricsHelp
srv, AllCounters
cnts, AllHistogramsLayout
hs, AllOtherCounters
ocnts) =
let toValues :: AllOtherCounters -> Map MetricsHelp Double
toValues = (MetricsHelp -> CounterValue -> Double)
-> AllOtherCounters -> Map MetricsHelp Double
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\MetricsHelp
k CounterValue
v -> (if MetricsHelp
k MetricsHelp -> HashSet MetricsHelp -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet MetricsHelp
pcScale1000
then (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000)
else Double -> Double
forall a. a -> a
id
) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ CounterValue -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CounterValue
v
)
cnts' :: Map MetricsHelp Double
cnts' = Map MetricsHelp Double
-> (AllOtherCounters -> Map MetricsHelp Double)
-> Maybe AllOtherCounters
-> Map MetricsHelp Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map MetricsHelp Double
forall k a. Map k a
M.empty AllOtherCounters -> Map MetricsHelp Double
toValues (Maybe AllOtherCounters -> Map MetricsHelp Double)
-> Maybe AllOtherCounters -> Map MetricsHelp Double
forall a b. (a -> b) -> a -> b
$ MetricsHelp -> AllCounters -> Maybe AllOtherCounters
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
srv AllCounters
cnts
hs' :: Maybe (Map MetricsHelp HistogramLayout)
hs' = MetricsHelp
-> AllHistogramsLayout -> Maybe (Map MetricsHelp HistogramLayout)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
srv AllHistogramsLayout
hs
(Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH, Map MetricsHelp Double
cntsC, Map MetricsHelp Double
cntsG) =
if Bool
-> (Map MetricsHelp HistogramLayout -> Bool)
-> Maybe (Map MetricsHelp HistogramLayout)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Map MetricsHelp HistogramLayout -> Bool
forall k a. Map k a -> Bool
M.null Maybe (Map MetricsHelp HistogramLayout)
hs'
then let (Map MetricsHelp Double
cntsG', Map MetricsHelp Double
cntsC') = (MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsHelp -> Double -> Bool
forall {b}. MetricsHelp -> b -> Bool
gCounter Map MetricsHelp Double
cnts'
in (Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
forall k a. Map k a
M.empty, Map MetricsHelp Double
cntsC', Map MetricsHelp Double
cntsG')
else let hs'' :: Map MetricsHelp HistogramLayout
hs'' = Maybe (Map MetricsHelp HistogramLayout)
-> Map MetricsHelp HistogramLayout
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Map MetricsHelp HistogramLayout)
hs'
rs :: ([MetricsHelp], Map MetricsHelp MetricsHelp)
rs = Map MetricsHelp HistogramLayout -> [MetricsHelp]
forall k a. Map k a -> [k]
M.keys (Map MetricsHelp HistogramLayout -> [MetricsHelp])
-> (Map MetricsHelp HistogramLayout -> Map MetricsHelp MetricsHelp)
-> Map MetricsHelp HistogramLayout
-> ([MetricsHelp], Map MetricsHelp MetricsHelp)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (HistogramLayout
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp)
-> Map MetricsHelp MetricsHelp
-> Map MetricsHelp HistogramLayout
-> Map MetricsHelp MetricsHelp
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr HistogramLayout
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
labeledRange Map MetricsHelp MetricsHelp
forall k a. Map k a
M.empty (Map MetricsHelp HistogramLayout
-> ([MetricsHelp], Map MetricsHelp MetricsHelp))
-> Map MetricsHelp HistogramLayout
-> ([MetricsHelp], Map MetricsHelp MetricsHelp)
forall a b. (a -> b) -> a -> b
$ Map MetricsHelp HistogramLayout
hs''
(Map MetricsHelp Double
cntsH', (Map MetricsHelp Double
cntsG', Map MetricsHelp Double
cntsC')) =
(Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double))
-> (Map MetricsHelp Double, Map MetricsHelp Double)
-> (Map MetricsHelp Double,
(Map MetricsHelp Double, Map MetricsHelp Double))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsHelp -> Double -> Bool
forall {b}. MetricsHelp -> b -> Bool
gCounter) ((Map MetricsHelp Double, Map MetricsHelp Double)
-> (Map MetricsHelp Double,
(Map MetricsHelp Double, Map MetricsHelp Double)))
-> (Map MetricsHelp Double, Map MetricsHelp Double)
-> (Map MetricsHelp Double,
(Map MetricsHelp Double, Map MetricsHelp Double))
forall a b. (a -> b) -> a -> b
$
(MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey (([MetricsHelp], Map MetricsHelp MetricsHelp)
-> MetricsHelp -> Double -> Bool
forall {t :: * -> *} {a} {b}.
Foldable t =>
(t MetricsHelp, Map MetricsHelp a) -> MetricsHelp -> b -> Bool
hCounter ([MetricsHelp], Map MetricsHelp MetricsHelp)
rs) Map MetricsHelp Double
cnts'
cntsH'' :: Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH'' = (MetricsHelp
-> HistogramLayout
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double))
-> Map MetricsHelp HistogramLayout
-> Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\MetricsHelp
k -> Map MetricsHelp Double
-> MetricsHelp
-> Map MetricsHelp MetricsHelp
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double)
forall {a} {a}.
(IsString a, Fractional a) =>
Map MetricsHelp a
-> MetricsHelp
-> Map MetricsHelp a
-> Map MetricsHelp (a, MetricsRole, a)
toHistogram Map MetricsHelp Double
cntsH' MetricsHelp
k (Map MetricsHelp MetricsHelp
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double))
-> (HistogramLayout -> Map MetricsHelp MetricsHelp)
-> HistogramLayout
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsHelp MetricsHelp
range) Map MetricsHelp HistogramLayout
hs''
in (Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH'', Map MetricsHelp Double
cntsC', Map MetricsHelp Double
cntsG')
(Map MetricsHelp Double
cntsOG, Map MetricsHelp Double
cntsOC) = (MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsHelp -> Double -> Bool
forall {b}. MetricsHelp -> b -> Bool
gCounter (Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double))
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall a b. (a -> b) -> a -> b
$ AllOtherCounters -> Map MetricsHelp Double
toValues AllOtherCounters
ocnts
cntsA :: Map MetricsHelp [MetricsType]
cntsA = (Map MetricsHelp (MetricsHelp, MetricsRole, Double)
-> MetricsHelp -> MetricsType)
-> (MetricsHelp -> MetricsHelp)
-> Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
-> Map MetricsHelp [MetricsType]
forall {a} {b} {k1}.
(a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect Map MetricsHelp (MetricsHelp, MetricsRole, Double)
-> MetricsHelp -> MetricsType
Histogram MetricsHelp -> MetricsHelp
forall a. a -> a
id Map
MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH
Map MetricsHelp [MetricsType]
-> Map MetricsHelp [MetricsType] -> Map MetricsHelp [MetricsType]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` (Double -> MetricsHelp -> MetricsType)
-> (MetricsHelp -> MetricsHelp)
-> Map MetricsHelp Double
-> Map MetricsHelp [MetricsType]
forall {a} {b} {k1}.
(a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect Double -> MetricsHelp -> MetricsType
Counter MetricsHelp -> MetricsHelp
renameErrCounter
(Map MetricsHelp Double
cntsC Map MetricsHelp Double
-> Map MetricsHelp Double -> Map MetricsHelp Double
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsHelp Double
cntsOC)
Map MetricsHelp [MetricsType]
-> Map MetricsHelp [MetricsType] -> Map MetricsHelp [MetricsType]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` (Double -> MetricsHelp -> MetricsType)
-> (MetricsHelp -> MetricsHelp)
-> Map MetricsHelp Double
-> Map MetricsHelp [MetricsType]
forall {a} {b} {k1}.
(a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect Double -> MetricsHelp -> MetricsType
Gauge MetricsHelp -> MetricsHelp
forall a. a -> a
id (Map MetricsHelp Double
cntsG Map MetricsHelp Double
-> Map MetricsHelp Double -> Map MetricsHelp Double
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsHelp Double
cntsOG)
in (MetricsHelp -> [MetricsType] -> (MetricsHelp, [MetricsType]))
-> Map MetricsHelp [MetricsType] -> PrometheusMetrics
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\MetricsHelp
k -> (MetricsHelp -> Maybe MetricsHelp -> MetricsHelp
forall a. a -> Maybe a -> a
fromMaybe MetricsHelp
"" (MetricsHelp -> Map MetricsHelp MetricsHelp -> Maybe MetricsHelp
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
k Map MetricsHelp MetricsHelp
pcMetrics),)) Map MetricsHelp [MetricsType]
cntsA
where labeledRange :: HistogramLayout
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
labeledRange = Map MetricsHelp MetricsHelp
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Map MetricsHelp MetricsHelp
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp)
-> (HistogramLayout -> Map MetricsHelp MetricsHelp)
-> HistogramLayout
-> Map MetricsHelp MetricsHelp
-> Map MetricsHelp MetricsHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp -> Bool)
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool) -> (MetricsHelp -> Bool) -> MetricsHelp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsHelp -> Bool
T.null) (Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp)
-> (HistogramLayout -> Map MetricsHelp MetricsHelp)
-> HistogramLayout
-> Map MetricsHelp MetricsHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsHelp MetricsHelp
range
hCounter :: (t MetricsHelp, Map MetricsHelp a) -> MetricsHelp -> b -> Bool
hCounter (t MetricsHelp
ks, Map MetricsHelp a
ts) MetricsHelp
k = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool) -> Bool -> b -> Bool
forall a b. (a -> b) -> a -> b
$
MetricsHelp
k MetricsHelp -> Map MetricsHelp a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MetricsHelp a
ts Bool -> Bool -> Bool
||
Bool -> [Bool] -> Bool
forall a. a -> [a] -> a
headDef Bool
False
((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Bool -> Bool
not ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$
(MetricsHelp -> [Bool] -> [Bool])
-> [Bool] -> t MetricsHelp -> [Bool]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\MetricsHelp
v ->
let v1 :: MetricsHelp
v1 = MetricsHelp
v MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_sum"
v2 :: MetricsHelp
v2 = MetricsHelp
v MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_cnt"
in ((MetricsHelp
k MetricsHelp -> MetricsHelp -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsHelp
v1 Bool -> Bool -> Bool
|| MetricsHelp
k MetricsHelp -> MetricsHelp -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsHelp
v2) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)
) [] t MetricsHelp
ks
)
gCounter :: MetricsHelp -> b -> Bool
gCounter = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool)
-> (MetricsHelp -> Bool) -> MetricsHelp -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp -> HashSet MetricsHelp -> Bool)
-> HashSet MetricsHelp -> MetricsHelp -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip MetricsHelp -> HashSet MetricsHelp -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member HashSet MetricsHelp
pcGauges
toHistogram :: Map MetricsHelp a
-> MetricsHelp
-> Map MetricsHelp a
-> Map MetricsHelp (a, MetricsRole, a)
toHistogram Map MetricsHelp a
cs MetricsHelp
hk Map MetricsHelp a
rs =
let ranges :: Map MetricsHelp (a, MetricsRole, a)
ranges = (MetricsHelp -> a -> (a, MetricsRole, a))
-> Map MetricsHelp a -> Map MetricsHelp (a, MetricsRole, a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\MetricsHelp
k ->
(, MetricsRole
HistogramBucket, a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0.0 (MetricsHelp -> Map MetricsHelp a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
k Map MetricsHelp a
cs))
) Map MetricsHelp a
rs
sums :: Map MetricsHelp (a, MetricsRole, a)
sums = let v1 :: MetricsHelp
v1 = MetricsHelp
hk MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_sum"
v2 :: MetricsHelp
v2 = MetricsHelp
hk MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_cnt"
withZeroLabel :: t -> a -> m (t, t, a)
withZeroLabel t
r = (t, t, a) -> m (t, t, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((t, t, a) -> m (t, t, a)) -> (a -> (t, t, a)) -> a -> m (t, t, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t
"", t
r,)
in [(MetricsHelp, (a, MetricsRole, a))]
-> Map MetricsHelp (a, MetricsRole, a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MetricsHelp, (a, MetricsRole, a))]
-> Map MetricsHelp (a, MetricsRole, a))
-> [(MetricsHelp, (a, MetricsRole, a))]
-> Map MetricsHelp (a, MetricsRole, a)
forall a b. (a -> b) -> a -> b
$
((MetricsHelp, Maybe (a, MetricsRole, a))
-> (MetricsHelp, (a, MetricsRole, a)))
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, (a, MetricsRole, a))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (a, MetricsRole, a) -> (a, MetricsRole, a))
-> (MetricsHelp, Maybe (a, MetricsRole, a))
-> (MetricsHelp, (a, MetricsRole, a))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Maybe (a, MetricsRole, a) -> (a, MetricsRole, a)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, (a, MetricsRole, a))])
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, (a, MetricsRole, a))]
forall a b. (a -> b) -> a -> b
$ ((MetricsHelp, Maybe (a, MetricsRole, a)) -> Bool)
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (a, MetricsRole, a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a, MetricsRole, a) -> Bool)
-> ((MetricsHelp, Maybe (a, MetricsRole, a))
-> Maybe (a, MetricsRole, a))
-> (MetricsHelp, Maybe (a, MetricsRole, a))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp, Maybe (a, MetricsRole, a))
-> Maybe (a, MetricsRole, a)
forall a b. (a, b) -> b
snd)
[(MetricsHelp
v1, MetricsHelp -> Map MetricsHelp a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
v1 Map MetricsHelp a
cs Maybe a
-> (a -> Maybe (a, MetricsRole, a)) -> Maybe (a, MetricsRole, a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
MetricsRole -> a -> Maybe (a, MetricsRole, a)
forall {m :: * -> *} {t} {t} {a}.
(Monad m, IsString t) =>
t -> a -> m (t, t, a)
withZeroLabel MetricsRole
HistogramSum
)
,(MetricsHelp
v2, MetricsHelp -> Map MetricsHelp a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
v2 Map MetricsHelp a
cs Maybe a
-> (a -> Maybe (a, MetricsRole, a)) -> Maybe (a, MetricsRole, a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
MetricsRole -> a -> Maybe (a, MetricsRole, a)
forall {m :: * -> *} {t} {t} {a}.
(Monad m, IsString t) =>
t -> a -> m (t, t, a)
withZeroLabel MetricsRole
HistogramCount
)
]
in Map MetricsHelp (a, MetricsRole, a)
ranges Map MetricsHelp (a, MetricsRole, a)
-> Map MetricsHelp (a, MetricsRole, a)
-> Map MetricsHelp (a, MetricsRole, a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsHelp (a, MetricsRole, a)
sums
collect :: (a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect a -> MetricsHelp -> b
cType k1 -> MetricsHelp
renameErrCounterF =
[(MetricsHelp, [b])] -> Map MetricsHelp [b]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
([(MetricsHelp, [b])] -> Map MetricsHelp [b])
-> (Map k1 a -> [(MetricsHelp, [b])])
-> Map k1 a
-> Map MetricsHelp [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(MetricsHelp, (a, MetricsHelp))] -> (MetricsHelp, [b]))
-> [[(MetricsHelp, (a, MetricsHelp))]] -> [(MetricsHelp, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (((MetricsHelp, (a, MetricsHelp)) -> MetricsHelp
forall a b. (a, b) -> a
fst ((MetricsHelp, (a, MetricsHelp)) -> MetricsHelp)
-> ([(MetricsHelp, (a, MetricsHelp))]
-> (MetricsHelp, (a, MetricsHelp)))
-> [(MetricsHelp, (a, MetricsHelp))]
-> MetricsHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MetricsHelp, (a, MetricsHelp))]
-> (MetricsHelp, (a, MetricsHelp))
forall a. HasCallStack => [a] -> a
head) ([(MetricsHelp, (a, MetricsHelp))] -> MetricsHelp)
-> ([(MetricsHelp, (a, MetricsHelp))] -> [b])
-> [(MetricsHelp, (a, MetricsHelp))]
-> (MetricsHelp, [b])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((MetricsHelp, (a, MetricsHelp)) -> b)
-> [(MetricsHelp, (a, MetricsHelp))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> MetricsHelp -> b) -> (a, MetricsHelp) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> MetricsHelp -> b
cType ((a, MetricsHelp) -> b)
-> ((MetricsHelp, (a, MetricsHelp)) -> (a, MetricsHelp))
-> (MetricsHelp, (a, MetricsHelp))
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp, (a, MetricsHelp)) -> (a, MetricsHelp)
forall a b. (a, b) -> b
snd))
([[(MetricsHelp, (a, MetricsHelp))]] -> [(MetricsHelp, [b])])
-> (Map k1 a -> [[(MetricsHelp, (a, MetricsHelp))]])
-> Map k1 a
-> [(MetricsHelp, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MetricsHelp, (a, MetricsHelp))
-> (MetricsHelp, (a, MetricsHelp)) -> Bool)
-> [(MetricsHelp, (a, MetricsHelp))]
-> [[(MetricsHelp, (a, MetricsHelp))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (MetricsHelp -> MetricsHelp -> Bool
forall a. Eq a => a -> a -> Bool
(==) (MetricsHelp -> MetricsHelp -> Bool)
-> ((MetricsHelp, (a, MetricsHelp)) -> MetricsHelp)
-> (MetricsHelp, (a, MetricsHelp))
-> (MetricsHelp, (a, MetricsHelp))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (MetricsHelp, (a, MetricsHelp)) -> MetricsHelp
forall a b. (a, b) -> a
fst)
([(MetricsHelp, (a, MetricsHelp))]
-> [[(MetricsHelp, (a, MetricsHelp))]])
-> (Map k1 a -> [(MetricsHelp, (a, MetricsHelp))])
-> Map k1 a
-> [[(MetricsHelp, (a, MetricsHelp))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MetricsHelp, a) -> (MetricsHelp, (a, MetricsHelp)))
-> [(MetricsHelp, a)] -> [(MetricsHelp, (a, MetricsHelp))]
forall a b. (a -> b) -> [a] -> [b]
map (\(MetricsHelp
k, a
v) ->
let (MetricsHelp
k', MetricsHelp
a) =
(MetricsHelp -> MetricsHelp)
-> (MetricsHelp, MetricsHelp) -> (MetricsHelp, MetricsHelp)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\MetricsHelp
a' ->
if MetricsHelp -> Bool
T.null MetricsHelp
a'
then MetricsHelp
""
else (Char -> Char) -> MetricsHelp -> MetricsHelp
T.map
(\Char
c ->
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'
then Char
'"'
else Char
c
) (MetricsHelp -> MetricsHelp) -> MetricsHelp -> MetricsHelp
forall a b. (a -> b) -> a -> b
$ HasCallStack => MetricsHelp -> MetricsHelp
MetricsHelp -> MetricsHelp
T.tail MetricsHelp
a'
) ((MetricsHelp, MetricsHelp) -> (MetricsHelp, MetricsHelp))
-> (MetricsHelp, MetricsHelp) -> (MetricsHelp, MetricsHelp)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
T.breakOn MetricsHelp
"@" MetricsHelp
k
in (MetricsHelp
k', (a
v, MetricsHelp
a))
)
([(MetricsHelp, a)] -> [(MetricsHelp, (a, MetricsHelp))])
-> (Map k1 a -> [(MetricsHelp, a)])
-> Map k1 a
-> [(MetricsHelp, (a, MetricsHelp))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map MetricsHelp a -> [(MetricsHelp, a)]
forall k a. Map k a -> [(k, a)]
M.toList
(Map MetricsHelp a -> [(MetricsHelp, a)])
-> (Map k1 a -> Map MetricsHelp a)
-> Map k1 a
-> [(MetricsHelp, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys k1 -> MetricsHelp
renameErrCounterF
renameErrCounter :: MetricsHelp -> MetricsHelp
renameErrCounter MetricsHelp
k =
let s :: MetricsHelp
s = MetricsHelp
"_err"
(MetricsHelp
b, (MetricsHelp
a, MetricsHelp
e)) =
(MetricsHelp -> (MetricsHelp, MetricsHelp))
-> (MetricsHelp, MetricsHelp)
-> (MetricsHelp, (MetricsHelp, MetricsHelp))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\MetricsHelp
v -> (MetricsHelp, MetricsHelp)
-> (MetricsHelp -> (MetricsHelp, MetricsHelp))
-> Maybe MetricsHelp
-> (MetricsHelp, MetricsHelp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MetricsHelp
v, MetricsHelp
"") (, MetricsHelp
s) (Maybe MetricsHelp -> (MetricsHelp, MetricsHelp))
-> Maybe MetricsHelp -> (MetricsHelp, MetricsHelp)
forall a b. (a -> b) -> a -> b
$ MetricsHelp -> MetricsHelp -> Maybe MetricsHelp
T.stripSuffix MetricsHelp
s MetricsHelp
v) ((MetricsHelp, MetricsHelp)
-> (MetricsHelp, (MetricsHelp, MetricsHelp)))
-> (MetricsHelp, MetricsHelp)
-> (MetricsHelp, (MetricsHelp, MetricsHelp))
forall a b. (a -> b) -> a -> b
$
HasCallStack =>
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
T.breakOn MetricsHelp
"@" MetricsHelp
k
in [MetricsHelp] -> MetricsHelp
T.concat [MetricsHelp
b, MetricsHelp
e, MetricsHelp
a]
showPrometheusMetrics :: PrometheusMetrics -> L.ByteString
showPrometheusMetrics :: PrometheusMetrics -> ByteString
showPrometheusMetrics = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString)
-> (PrometheusMetrics -> Text) -> PrometheusMetrics -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> MetricsHelp -> (MetricsHelp, [MetricsType]) -> Text)
-> Text -> PrometheusMetrics -> Text
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey
(\Text
a MetricsHelp
k (MetricsHelp
h, [MetricsType]
ms) ->
let k' :: Text
k' = MetricsHelp -> Text
TL.fromStrict MetricsHelp
k
in [Text] -> Text
TL.concat [Text
a, Text
"# HELP ", Text
k', Text
" ", MetricsHelp -> Text
TL.fromStrict MetricsHelp
h, Text
"\n"
, Text
"# TYPE ", Text
k', Text
" ", MetricsType -> Text
forall {a}. IsString a => MetricsType -> a
showType (MetricsType -> Text) -> MetricsType -> Text
forall a b. (a -> b) -> a -> b
$ [MetricsType] -> MetricsType
forall a. HasCallStack => [a] -> a
head [MetricsType]
ms, Text
"\n"
,(Text -> MetricsType -> Text) -> Text -> [MetricsType] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Text -> Text -> MetricsType -> Text
showCounter Text
k') Text
"" [MetricsType]
ms
]
) Text
""
where showType :: MetricsType -> a
showType (Counter Double
_ MetricsHelp
_) = a
"counter"
showType (Gauge Double
_ MetricsHelp
_) = a
"gauge"
showType (Histogram Map MetricsHelp (MetricsHelp, MetricsRole, Double)
_ MetricsHelp
_) = a
"histogram"
showCounter :: Text -> Text -> MetricsType -> Text
showCounter Text
k Text
a MetricsType
m =
[Text] -> Text
TL.concat [Text
a
,case MetricsType
m of
Counter Double
v MetricsHelp
anno -> [Text] -> Text
TL.concat
[Text
k, MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" ", [Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
v, Text
"\n"]
Gauge Double
v MetricsHelp
anno -> [Text] -> Text
TL.concat
[Text
k, MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" ", [Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
v, Text
"\n"]
Histogram Map MetricsHelp (MetricsHelp, MetricsRole, Double)
h' MetricsHelp
anno -> (Text, Double) -> Text
forall a b. (a, b) -> a
fst ((Text, Double) -> Text) -> (Text, Double) -> Text
forall a b. (a -> b) -> a -> b
$
((Text, Double)
-> MetricsHelp
-> (MetricsHelp, MetricsRole, Double)
-> (Text, Double))
-> (Text, Double)
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double)
-> (Text, Double)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Text
-> MetricsHelp
-> (Text, Double)
-> MetricsHelp
-> (MetricsHelp, MetricsRole, Double)
-> (Text, Double)
forall {a} {p}.
(Show a, RealFrac a) =>
Text
-> MetricsHelp
-> (Text, a)
-> p
-> (MetricsHelp, MetricsRole, a)
-> (Text, a)
showHistogram Text
k MetricsHelp
anno)
(Text
"", Double
0.0) Map MetricsHelp (MetricsHelp, MetricsRole, Double)
h'
]
showAnno :: MetricsHelp -> Text
showAnno MetricsHelp
x = let x' :: Text
x' = MetricsHelp -> Text
TL.fromStrict MetricsHelp
x
in if Text -> Bool
TL.null Text
x'
then Text
x'
else [Text] -> Text
TL.concat [Text
"{", Text
x', Text
"}"]
showAnnoH :: MetricsHelp -> Text
showAnnoH MetricsHelp
x = let x' :: Text
x' = MetricsHelp -> Text
TL.fromStrict MetricsHelp
x
in if Text -> Bool
TL.null Text
x'
then Text
x'
else [Text] -> Text
TL.concat [Text
",", Text
x']
showHistogram :: Text
-> MetricsHelp
-> (Text, a)
-> p
-> (MetricsHelp, MetricsRole, a)
-> (Text, a)
showHistogram Text
k MetricsHelp
anno a :: (Text, a)
a@(Text
t, a
n) p
_ (MetricsHelp
l, MetricsRole
r, a
v) =
if MetricsHelp -> Bool
T.null MetricsHelp
l
then case MetricsRole
r of
MetricsRole
HistogramSum ->
([Text] -> Text
TL.concat [Text
t, Text
k, Text
"_sum"
,MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" "
,[Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
v
,Text
"\n"
]
,a
n
)
MetricsRole
HistogramCount ->
([Text] -> Text
TL.concat [Text
t, Text
k, Text
"_count"
,MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" "
,[Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ CounterValue -> [Char]
forall a. Show a => a -> [Char]
show (a -> CounterValue
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
v :: Word64)
,Text
"\n"
]
,a
n
)
MetricsRole
_ -> (Text, a)
a
else let n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
v
in ([Text] -> Text
TL.concat [Text
t, Text
k
,Text
"_bucket{le=\"", MetricsHelp -> Text
TL.fromStrict MetricsHelp
l, Text
"\""
,MetricsHelp -> Text
showAnnoH MetricsHelp
anno, Text
"} "
,[Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ CounterValue -> [Char]
forall a. Show a => a -> [Char]
show (a -> CounterValue
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
n' :: Word64)
,Text
"\n"
]
,a
n'
)
toPrometheusMetrics :: ByteString -> IO L.ByteString
toPrometheusMetrics :: ByteString -> IO ByteString
toPrometheusMetrics ByteString
v = do
let cs :: AllMetrtics
cs = Maybe AllMetrtics -> AllMetrtics
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AllMetrtics -> AllMetrtics)
-> Maybe AllMetrtics -> AllMetrtics
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @AllMetrtics ByteString
v
Maybe PrometheusConf
pc <- IORef (Maybe PrometheusConf) -> IO (Maybe PrometheusConf)
forall a. IORef a -> IO a
readIORef IORef (Maybe PrometheusConf)
conf
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> (PrometheusConf -> ByteString)
-> Maybe PrometheusConf
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (PrometheusMetrics -> ByteString
showPrometheusMetrics (PrometheusMetrics -> ByteString)
-> (PrometheusConf -> PrometheusMetrics)
-> PrometheusConf
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrometheusConf -> AllMetrtics -> PrometheusMetrics)
-> AllMetrtics -> PrometheusConf -> PrometheusMetrics
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' AllMetrtics
cs) Maybe PrometheusConf
pc
ngxExportIOYY 'toPrometheusMetrics
textPlain :: ByteString
textPlain :: ByteString
textPlain = ByteString
"text/plain; version=0.0.4; charset=utf-8"
prometheusMetrics :: ByteString -> IO ContentHandlerResult
prometheusMetrics :: ByteString -> IO ContentHandlerResult
prometheusMetrics = (ByteString -> ContentHandlerResult)
-> IO ByteString -> IO ContentHandlerResult
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ByteString
textPlain, Int
200, []) (IO ByteString -> IO ContentHandlerResult)
-> (ByteString -> IO ByteString)
-> ByteString
-> IO ContentHandlerResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
toPrometheusMetrics
ngxExportAsyncHandler 'prometheusMetrics
scale
:: Int
-> Double
-> Int
scale :: Int -> Double -> Int
scale Int
n = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
*)
scale1000
:: ByteString
-> L.ByteString
scale1000 :: ByteString -> ByteString
scale1000 ByteString
v = let v' :: Double
v' = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ forall a. Read a => ByteString -> Maybe a
readFromByteString @Double ByteString
v
in [Char] -> ByteString
C8L.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Double -> Int
scale Int
1000 Double
v'
ngxExportYY 'scale1000
extractValues :: ByteString -> [ByteString]
= (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (ByteString -> Bool) -> ByteString -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
C8.null (ByteString -> Bool -> Bool)
-> (ByteString -> Bool) -> ByteString -> Bool
forall a b.
(ByteString -> a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Bool
isDigit (Char -> Bool) -> (ByteString -> Char) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
C8.head)
([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> [ByteString]
C8.splitWith (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit (Char -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b. (Char -> a -> b) -> (Char -> a) -> Char -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.'))
statusLayout :: ByteString -> L.ByteString
statusLayout :: ByteString -> ByteString
statusLayout = [Char] -> ByteString
C8L.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char])
-> (ByteString -> [[Char]]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> [[Char]])
-> (ByteString -> [Int]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
statuses
where statuses :: ByteString -> [Int]
statuses ByteString
s = (forall s. ST s [Int]) -> [Int]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [Int]) -> [Int])
-> (forall s. ST s [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Int
a <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int, Int)
bs Int
0 :: ST s (STUArray s Int Int)
((Int, Int) -> ST s ()) -> [(Int, Int)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> Int -> ST s ()) -> (Int, Int) -> ST s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Int -> ST s ()) -> (Int, Int) -> ST s ())
-> (Int -> Int -> ST s ()) -> (Int, Int) -> ST s ()
forall a b. (a -> b) -> a -> b
$ STUArray s Int Int -> Int -> Int -> ST s ()
forall {f :: * -> *} {a :: * -> * -> *} {a}.
MArray a a f =>
a Int a -> Int -> a -> f ()
writeStatus STUArray s Int Int
a) ([(Int, Int)] -> ST s ()) -> [(Int, Int)] -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [(Int, Int)]
toPairs ByteString
s
STUArray s Int Int -> ST s [Int]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems STUArray s Int Int
a
toPairs :: ByteString -> [(Int, Int)]
toPairs = ([ByteString] -> (Int, Int)) -> [[ByteString]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (Char -> Int
ord Char
'0') (Int -> Int) -> ([ByteString] -> Int) -> [ByteString] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Int) -> ([ByteString] -> Char) -> [ByteString] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
C8.head (ByteString -> Char)
-> ([ByteString] -> ByteString) -> [ByteString] -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head ([ByteString] -> Int)
-> ([ByteString] -> Int) -> [ByteString] -> (Int, Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
([[ByteString]] -> [(Int, Int)])
-> (ByteString -> [[ByteString]]) -> ByteString -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> Bool)
-> [ByteString] -> [[ByteString]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Char -> Char -> Bool)
-> (ByteString -> Char) -> ByteString -> ByteString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ByteString -> Char
C8.head)
([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
sort
([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
extractValues
writeStatus :: a Int a -> Int -> a -> f ()
writeStatus a Int a
a Int
i = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lb Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ub) (f () -> f ()) -> (a -> f ()) -> a -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a Int a -> Int -> a -> f ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray a Int a
a Int
i
bs :: (Int, Int)
bs@(Int
lb, Int
ub) = (Int
2, Int
5)
ngxExportYY 'statusLayout
cumulativeValue' :: (Num a, Read a) => ByteString -> a
cumulativeValue' :: forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' = (ByteString -> a -> a) -> a -> [ByteString] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
forall a. Num a => a -> a -> a
(+) (a -> a -> a) -> (ByteString -> a) -> ByteString -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> (ByteString -> [Char]) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C8.unpack)) a
0 ([ByteString] -> a)
-> (ByteString -> [ByteString]) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
extractValues
cumulativeValue :: ByteString -> L.ByteString
cumulativeValue :: ByteString -> ByteString
cumulativeValue = [Char] -> ByteString
C8L.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (ByteString -> Int) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' @Int
ngxExportYY 'cumulativeValue
cumulativeFPValue :: ByteString -> L.ByteString
cumulativeFPValue :: ByteString -> ByteString
cumulativeFPValue = [Char] -> ByteString
C8L.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char])
-> (ByteString -> Double) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' @Double
ngxExportYY 'cumulativeFPValue