{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

module System.Metrics.StatsD.Internal
  ( Stats (..),
    StatConfig (..),
    Key,
    Index,
    Sampling,
    Counter,
    Gauge,
    Timing,
    SetElement,
    Timings,
    SetData,
    MetricData (..),
    Store (..),
    Metrics,
    Value (..),
    Sample (..),
    Report (..),
    StatCounter (..),
    StatGauge (..),
    StatTiming (..),
    StatSet (..),
    addMetric,
    newMetric,
    validateKey,
    addReading,
    newReading,
    processSample,
    newStats,
    statsLoop,
    statsFlush,
    flushStats,
    catKey,
    statReports,
    TimingStats (..),
    makeTimingStats,
    extractPercentiles,
    timingReports,
    trimPercentile,
    percentileSuffix,
    timingStats,
    cumulativeSums,
    cumulativeSquares,
    stdev,
    mean,
    median,
    flush,
    toReport,
    format,
    submit,
    connectStatsD,
  )
where

import Control.Monad (forM_, forever, when)
import Data.ByteString.Char8 qualified as C
import Data.Char (isAlphaNum, isAscii)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.List (intercalate, sort)
import Network.Socket (Socket)
import Network.Socket qualified as Net
import Network.Socket.ByteString qualified as Net
import Text.Printf (printf)
import UnliftIO (MonadIO, liftIO, throwIO)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.STM
  ( STM,
    TVar,
    atomically,
    modifyTVar,
    newTVarIO,
    readTVar,
    stateTVar,
  )

type Key = String

data Stats = Stats
  { Stats -> TVar Metrics
metrics :: !(TVar Metrics),
    Stats -> StatConfig
cfg :: !StatConfig,
    Stats -> Socket
socket :: !Socket
  }

data StatConfig = StatConfig
  { StatConfig -> Bool
reportStats :: !Bool,
    StatConfig -> Bool
reportSamples :: !Bool,
    StatConfig -> Key
namespace :: !String,
    StatConfig -> Key
statsPrefix :: !String,
    StatConfig -> Key
prefixCounter :: !String,
    StatConfig -> Key
prefixTimer :: !String,
    StatConfig -> Key
prefixGauge :: !String,
    StatConfig -> Key
prefixSet :: !String,
    StatConfig -> Key
server :: !String,
    StatConfig -> Sampling
port :: !Int,
    StatConfig -> Sampling
flushInterval :: !Int,
    StatConfig -> [Sampling]
timingPercentiles :: ![Int],
    StatConfig -> Bool
newline :: !Bool
  }
  deriving (Sampling -> StatConfig -> Key -> Key
[StatConfig] -> Key -> Key
StatConfig -> Key
(Sampling -> StatConfig -> Key -> Key)
-> (StatConfig -> Key)
-> ([StatConfig] -> Key -> Key)
-> Show StatConfig
forall a.
(Sampling -> a -> Key -> Key)
-> (a -> Key) -> ([a] -> Key -> Key) -> Show a
$cshowsPrec :: Sampling -> StatConfig -> Key -> Key
showsPrec :: Sampling -> StatConfig -> Key -> Key
$cshow :: StatConfig -> Key
show :: StatConfig -> Key
$cshowList :: [StatConfig] -> Key -> Key
showList :: [StatConfig] -> Key -> Key
Show, ReadPrec [StatConfig]
ReadPrec StatConfig
Sampling -> ReadS StatConfig
ReadS [StatConfig]
(Sampling -> ReadS StatConfig)
-> ReadS [StatConfig]
-> ReadPrec StatConfig
-> ReadPrec [StatConfig]
-> Read StatConfig
forall a.
(Sampling -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Sampling -> ReadS StatConfig
readsPrec :: Sampling -> ReadS StatConfig
$creadList :: ReadS [StatConfig]
readList :: ReadS [StatConfig]
$creadPrec :: ReadPrec StatConfig
readPrec :: ReadPrec StatConfig
$creadListPrec :: ReadPrec [StatConfig]
readListPrec :: ReadPrec [StatConfig]
Read, StatConfig -> StatConfig -> Bool
(StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool) -> Eq StatConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatConfig -> StatConfig -> Bool
== :: StatConfig -> StatConfig -> Bool
$c/= :: StatConfig -> StatConfig -> Bool
/= :: StatConfig -> StatConfig -> Bool
Eq, Eq StatConfig
Eq StatConfig
-> (StatConfig -> StatConfig -> Ordering)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> StatConfig)
-> (StatConfig -> StatConfig -> StatConfig)
-> Ord StatConfig
StatConfig -> StatConfig -> Bool
StatConfig -> StatConfig -> Ordering
StatConfig -> StatConfig -> StatConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StatConfig -> StatConfig -> Ordering
compare :: StatConfig -> StatConfig -> Ordering
$c< :: StatConfig -> StatConfig -> Bool
< :: StatConfig -> StatConfig -> Bool
$c<= :: StatConfig -> StatConfig -> Bool
<= :: StatConfig -> StatConfig -> Bool
$c> :: StatConfig -> StatConfig -> Bool
> :: StatConfig -> StatConfig -> Bool
$c>= :: StatConfig -> StatConfig -> Bool
>= :: StatConfig -> StatConfig -> Bool
$cmax :: StatConfig -> StatConfig -> StatConfig
max :: StatConfig -> StatConfig -> StatConfig
$cmin :: StatConfig -> StatConfig -> StatConfig
min :: StatConfig -> StatConfig -> StatConfig
Ord)

type Index = Int

type Sampling = Int

type Counter = Int

type Gauge = Int

type Timing = Int

type SetElement = String

type Timings = [Int]

type SetData = HashSet String

data MetricData
  = CounterData !Counter
  | GaugeData !Gauge
  | TimingData !Timings
  | SetData !(HashSet String)

data Store = Store
  { Store -> Sampling
index :: !Index,
    Store -> Maybe MetricData
dat :: !(Maybe MetricData)
  }

type Metrics = HashMap Key Store

data Value
  = Counter !Counter
  | Gauge !Gauge !Bool
  | Timing !Timing
  | Set !SetElement
  | Metric !Int
  | Other !String !String
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord, Sampling -> Value -> Key -> Key
[Value] -> Key -> Key
Value -> Key
(Sampling -> Value -> Key -> Key)
-> (Value -> Key) -> ([Value] -> Key -> Key) -> Show Value
forall a.
(Sampling -> a -> Key -> Key)
-> (a -> Key) -> ([a] -> Key -> Key) -> Show a
$cshowsPrec :: Sampling -> Value -> Key -> Key
showsPrec :: Sampling -> Value -> Key -> Key
$cshow :: Value -> Key
show :: Value -> Key
$cshowList :: [Value] -> Key -> Key
showList :: [Value] -> Key -> Key
Show, ReadPrec [Value]
ReadPrec Value
Sampling -> ReadS Value
ReadS [Value]
(Sampling -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Sampling -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Sampling -> ReadS Value
readsPrec :: Sampling -> ReadS Value
$creadList :: ReadS [Value]
readList :: ReadS [Value]
$creadPrec :: ReadPrec Value
readPrec :: ReadPrec Value
$creadListPrec :: ReadPrec [Value]
readListPrec :: ReadPrec [Value]
Read)

data Report = Report
  { Report -> Key
key :: !Key,
    Report -> Value
value :: !Value,
    Report -> Double
rate :: !Double
  }
  deriving (Report -> Report -> Bool
(Report -> Report -> Bool)
-> (Report -> Report -> Bool) -> Eq Report
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
/= :: Report -> Report -> Bool
Eq, Eq Report
Eq Report
-> (Report -> Report -> Ordering)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Report)
-> (Report -> Report -> Report)
-> Ord Report
Report -> Report -> Bool
Report -> Report -> Ordering
Report -> Report -> Report
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Report -> Report -> Ordering
compare :: Report -> Report -> Ordering
$c< :: Report -> Report -> Bool
< :: Report -> Report -> Bool
$c<= :: Report -> Report -> Bool
<= :: Report -> Report -> Bool
$c> :: Report -> Report -> Bool
> :: Report -> Report -> Bool
$c>= :: Report -> Report -> Bool
>= :: Report -> Report -> Bool
$cmax :: Report -> Report -> Report
max :: Report -> Report -> Report
$cmin :: Report -> Report -> Report
min :: Report -> Report -> Report
Ord, Sampling -> Report -> Key -> Key
[Report] -> Key -> Key
Report -> Key
(Sampling -> Report -> Key -> Key)
-> (Report -> Key) -> ([Report] -> Key -> Key) -> Show Report
forall a.
(Sampling -> a -> Key -> Key)
-> (a -> Key) -> ([a] -> Key -> Key) -> Show a
$cshowsPrec :: Sampling -> Report -> Key -> Key
showsPrec :: Sampling -> Report -> Key -> Key
$cshow :: Report -> Key
show :: Report -> Key
$cshowList :: [Report] -> Key -> Key
showList :: [Report] -> Key -> Key
Show, ReadPrec [Report]
ReadPrec Report
Sampling -> ReadS Report
ReadS [Report]
(Sampling -> ReadS Report)
-> ReadS [Report]
-> ReadPrec Report
-> ReadPrec [Report]
-> Read Report
forall a.
(Sampling -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Sampling -> ReadS Report
readsPrec :: Sampling -> ReadS Report
$creadList :: ReadS [Report]
readList :: ReadS [Report]
$creadPrec :: ReadPrec Report
readPrec :: ReadPrec Report
$creadListPrec :: ReadPrec [Report]
readListPrec :: ReadPrec [Report]
Read)

data Sample = Sample
  { Sample -> Key
key :: !Key,
    Sample -> Value
value :: !Value,
    Sample -> Sampling
sampling :: !Sampling,
    Sample -> Sampling
index :: !Index
  }
  deriving (Sample -> Sample -> Bool
(Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool) -> Eq Sample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
/= :: Sample -> Sample -> Bool
Eq, Eq Sample
Eq Sample
-> (Sample -> Sample -> Ordering)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Sample)
-> (Sample -> Sample -> Sample)
-> Ord Sample
Sample -> Sample -> Bool
Sample -> Sample -> Ordering
Sample -> Sample -> Sample
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sample -> Sample -> Ordering
compare :: Sample -> Sample -> Ordering
$c< :: Sample -> Sample -> Bool
< :: Sample -> Sample -> Bool
$c<= :: Sample -> Sample -> Bool
<= :: Sample -> Sample -> Bool
$c> :: Sample -> Sample -> Bool
> :: Sample -> Sample -> Bool
$c>= :: Sample -> Sample -> Bool
>= :: Sample -> Sample -> Bool
$cmax :: Sample -> Sample -> Sample
max :: Sample -> Sample -> Sample
$cmin :: Sample -> Sample -> Sample
min :: Sample -> Sample -> Sample
Ord, Sampling -> Sample -> Key -> Key
[Sample] -> Key -> Key
Sample -> Key
(Sampling -> Sample -> Key -> Key)
-> (Sample -> Key) -> ([Sample] -> Key -> Key) -> Show Sample
forall a.
(Sampling -> a -> Key -> Key)
-> (a -> Key) -> ([a] -> Key -> Key) -> Show a
$cshowsPrec :: Sampling -> Sample -> Key -> Key
showsPrec :: Sampling -> Sample -> Key -> Key
$cshow :: Sample -> Key
show :: Sample -> Key
$cshowList :: [Sample] -> Key -> Key
showList :: [Sample] -> Key -> Key
Show, ReadPrec [Sample]
ReadPrec Sample
Sampling -> ReadS Sample
ReadS [Sample]
(Sampling -> ReadS Sample)
-> ReadS [Sample]
-> ReadPrec Sample
-> ReadPrec [Sample]
-> Read Sample
forall a.
(Sampling -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Sampling -> ReadS Sample
readsPrec :: Sampling -> ReadS Sample
$creadList :: ReadS [Sample]
readList :: ReadS [Sample]
$creadPrec :: ReadPrec Sample
readPrec :: ReadPrec Sample
$creadListPrec :: ReadPrec [Sample]
readListPrec :: ReadPrec [Sample]
Read)

data StatCounter = StatCounter
  { StatCounter -> Stats
stats :: !Stats,
    StatCounter -> Key
key :: !Key,
    StatCounter -> Sampling
sampling :: !Sampling
  }

data StatGauge = StatGauge
  { StatGauge -> Stats
stats :: !Stats,
    StatGauge -> Key
key :: !Key
  }

data StatTiming = StatTiming
  { StatTiming -> Stats
stats :: !Stats,
    StatTiming -> Key
key :: !Key,
    StatTiming -> Sampling
sampling :: !Sampling
  }

data StatSet = StatSet
  { StatSet -> Stats
stats :: !Stats,
    StatSet -> Key
key :: !Key
  }

addMetric :: StatConfig -> Key -> MetricData -> Metrics -> Metrics
addMetric :: StatConfig -> Key -> MetricData -> Metrics -> Metrics
addMetric StatConfig
cfg Key
key MetricData
md =
  Key -> Store -> Metrics -> Metrics
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Key
key (Store -> Metrics -> Metrics) -> Store -> Metrics -> Metrics
forall a b. (a -> b) -> a -> b
$
    Sampling -> Maybe MetricData -> Store
Store Sampling
0 (Maybe MetricData -> Store) -> Maybe MetricData -> Store
forall a b. (a -> b) -> a -> b
$
      if StatConfig
cfg.reportStats
        then MetricData -> Maybe MetricData
forall a. a -> Maybe a
Just MetricData
md
        else Maybe MetricData
forall a. Maybe a
Nothing

newMetric :: (MonadIO m) => Stats -> Key -> MetricData -> m ()
newMetric :: forall (m :: * -> *).
MonadIO m =>
Stats -> Key -> MetricData -> m ()
newMetric Stats
stats Key
key MetricData
store
  | Key -> Bool
validateKey Key
key = do
      Bool
e <- STM Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Bool -> m Bool) -> STM Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
        Bool
exists <- Key -> Metrics -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Key
key (Metrics -> Bool) -> STM Metrics -> STM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar Metrics -> STM Metrics
forall a. TVar a -> STM a
readTVar Stats
stats.metrics
        if Bool
exists
          then Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          else do
            TVar Metrics -> (Metrics -> Metrics) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Stats
stats.metrics (StatConfig -> Key -> MetricData -> Metrics -> Metrics
addMetric Stats
stats.cfg Key
key MetricData
store)
            Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        IOError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$
          Key -> IOError
userError (Key -> IOError) -> Key -> IOError
forall a b. (a -> b) -> a -> b
$
            Key
"A metric already exists with key: " Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key
  | Bool
otherwise =
      IOError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ Key -> IOError
userError (Key -> IOError) -> Key -> IOError
forall a b. (a -> b) -> a -> b
$ Key
"Metric key is invalid: " Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
key

validateKey :: String -> Bool
validateKey :: Key -> Bool
validateKey Key
t = Bool -> Bool
not (Key -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Key
t) Bool -> Bool -> Bool
&& (Char -> Bool) -> Key -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
valid Key
t
  where
    valid :: Char -> Bool
valid Char
c = Char -> Key -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c (Key
"._-" :: [Char]) Bool -> Bool -> Bool
|| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c

addReading :: Value -> Key -> Metrics -> Metrics
addReading :: Value -> Key -> Metrics -> Metrics
addReading Value
reading = (Store -> Store) -> Key -> Metrics -> Metrics
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust Store -> Store
adjust
  where
    adjust :: Store -> Store
adjust Store
m = Store
m {$sel:index:Store :: Sampling
index = Store
m.index Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
+ Sampling
1, $sel:dat:Store :: Maybe MetricData
dat = MetricData -> MetricData
change (MetricData -> MetricData) -> Maybe MetricData -> Maybe MetricData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Store
m.dat}
    change :: MetricData -> MetricData
change MetricData
store = case (Value
reading, MetricData
store) of
      (Counter Sampling
c, CounterData Sampling
s) -> Sampling -> MetricData
CounterData (Sampling
s Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
+ Sampling
c)
      (Gauge Sampling
i Bool
False, GaugeData Sampling
_) -> Sampling -> MetricData
GaugeData Sampling
i
      (Gauge Sampling
i Bool
True, GaugeData Sampling
g) -> Sampling -> MetricData
GaugeData (Sampling -> Sampling -> Sampling
forall a. Ord a => a -> a -> a
max Sampling
0 (Sampling
g Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
+ Sampling
i))
      (Timing Sampling
t, TimingData [Sampling]
s) -> [Sampling] -> MetricData
TimingData (Sampling
t Sampling -> [Sampling] -> [Sampling]
forall a. a -> [a] -> [a]
: [Sampling]
s)
      (Set Key
e, SetData HashSet Key
s) -> HashSet Key -> MetricData
SetData (Key -> HashSet Key -> HashSet Key
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Key
e HashSet Key
s)
      (Value, MetricData)
_ -> Key -> MetricData
forall a. HasCallStack => Key -> a
error Key
"Stats reading mismatch"

newReading :: Stats -> Key -> Value -> STM Int
newReading :: Stats -> Key -> Value -> STM Sampling
newReading Stats
stats Key
key Value
reading = do
  TVar Metrics -> (Metrics -> Metrics) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Stats
stats.metrics (Value -> Key -> Metrics -> Metrics
addReading Value
reading Key
key)
  Sampling -> (Store -> Sampling) -> Maybe Store -> Sampling
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sampling
0 (.index) (Maybe Store -> Sampling)
-> (Metrics -> Maybe Store) -> Metrics -> Sampling
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Metrics -> Maybe Store
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (Metrics -> Sampling) -> STM Metrics -> STM Sampling
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar Metrics -> STM Metrics
forall a. TVar a -> STM a
readTVar Stats
stats.metrics

processSample ::
  (MonadIO m) => Stats -> Sampling -> Key -> Value -> m ()
processSample :: forall (m :: * -> *).
MonadIO m =>
Stats -> Sampling -> Key -> Value -> m ()
processSample Stats
stats Sampling
sampling Key
key Value
val = do
  Sampling
idx <- STM Sampling -> m Sampling
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Sampling -> m Sampling) -> STM Sampling -> m Sampling
forall a b. (a -> b) -> a -> b
$ Stats -> Key -> Value -> STM Sampling
newReading Stats
stats Key
key Value
val
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Stats
stats.cfg.reportSamples (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Stats -> Sample -> m ()
forall (m :: * -> *). MonadIO m => Stats -> Sample -> m ()
submit Stats
stats (Sample -> m ()) -> Sample -> m ()
forall a b. (a -> b) -> a -> b
$
      Key -> Value -> Sampling -> Sampling -> Sample
Sample Key
key Value
val Sampling
sampling Sampling
idx

newStats :: (MonadIO m) => StatConfig -> m Stats
newStats :: forall (m :: * -> *). MonadIO m => StatConfig -> m Stats
newStats StatConfig
cfg = do
  TVar Metrics
m <- Metrics -> m (TVar Metrics)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Metrics
forall k v. HashMap k v
HashMap.empty
  Socket
h <- Key -> Sampling -> m Socket
forall (m :: * -> *). MonadIO m => Key -> Sampling -> m Socket
connectStatsD StatConfig
cfg.server StatConfig
cfg.port
  Stats -> m Stats
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stats -> m Stats) -> Stats -> m Stats
forall a b. (a -> b) -> a -> b
$ TVar Metrics -> StatConfig -> Socket -> Stats
Stats TVar Metrics
m StatConfig
cfg Socket
h

statsLoop :: (MonadIO m) => Stats -> m ()
statsLoop :: forall (m :: * -> *). MonadIO m => Stats -> m ()
statsLoop Stats
stats = m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Sampling -> m ()
forall (m :: * -> *). MonadIO m => Sampling -> m ()
threadDelay (Sampling -> m ()) -> Sampling -> m ()
forall a b. (a -> b) -> a -> b
$ Stats
stats.cfg.flushInterval Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
* Sampling
1000
  Stats -> m ()
forall (m :: * -> *). MonadIO m => Stats -> m ()
statsFlush Stats
stats

statsFlush :: (MonadIO m) => Stats -> m ()
statsFlush :: forall (m :: * -> *). MonadIO m => Stats -> m ()
statsFlush Stats
stats = do
  [Report]
reports <-
    STM [Report] -> m [Report]
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM [Report] -> m [Report]) -> STM [Report] -> m [Report]
forall a b. (a -> b) -> a -> b
$
      TVar Metrics -> (Metrics -> ([Report], Metrics)) -> STM [Report]
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar Stats
stats.metrics (StatConfig -> Metrics -> ([Report], Metrics)
flushStats Stats
stats.cfg)
  (Report -> m ()) -> [Report] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Stats -> Report -> m ()
forall (m :: * -> *). MonadIO m => Stats -> Report -> m ()
send Stats
stats) [Report]
reports

flushStats :: StatConfig -> Metrics -> ([Report], Metrics)
flushStats :: StatConfig -> Metrics -> ([Report], Metrics)
flushStats StatConfig
cfg Metrics
metrics =
  let f :: [Report] -> Key -> r -> [Report]
f [Report]
xs Key
key r
m = [Report]
-> (MetricData -> [Report]) -> Maybe MetricData -> [Report]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Report]
xs (([Report] -> [Report] -> [Report]
forall a. Semigroup a => a -> a -> a
<> [Report]
xs) ([Report] -> [Report])
-> (MetricData -> [Report]) -> MetricData -> [Report]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatConfig -> Key -> MetricData -> [Report]
statReports StatConfig
cfg Key
key) r
m.dat
      rs :: [Report]
rs = ([Report] -> Key -> Store -> [Report])
-> [Report] -> Metrics -> [Report]
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HashMap.foldlWithKey' [Report] -> Key -> Store -> [Report]
forall {r}.
HasField "dat" r (Maybe MetricData) =>
[Report] -> Key -> r -> [Report]
f [] Metrics
metrics
      g :: Store -> Store
g Store
m = Store
m {$sel:dat:Store :: Maybe MetricData
dat = MetricData -> MetricData
flush (MetricData -> MetricData) -> Maybe MetricData -> Maybe MetricData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Store
m.dat}
      ms :: Metrics
ms = (Store -> Store) -> Metrics -> Metrics
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map Store -> Store
g Metrics
metrics
   in ([Report]
rs, Metrics
ms)

catKey :: [Key] -> Key
catKey :: [Key] -> Key
catKey = Key -> [Key] -> Key
forall a. [a] -> [[a]] -> [a]
intercalate Key
"." ([Key] -> Key) -> ([Key] -> [Key]) -> [Key] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)

statReports :: StatConfig -> Key -> MetricData -> [Report]
statReports :: StatConfig -> Key -> MetricData -> [Report]
statReports StatConfig
cfg Key
key MetricData
dat = case MetricData
dat of
  CounterData Sampling
c ->
    [ Report
        { $sel:key:Report :: Key
key = [Key] -> Key
catKey [StatConfig
cfg.statsPrefix, StatConfig
cfg.prefixCounter, Key
key, Key
"count"],
          $sel:value:Report :: Value
value = Sampling -> Value
Counter Sampling
c,
          $sel:rate:Report :: Double
rate = Double
1.0
        },
      Report
        { $sel:key:Report :: Key
key = [Key] -> Key
catKey [StatConfig
cfg.statsPrefix, StatConfig
cfg.prefixCounter, Key
key, Key
"rate"],
          $sel:value:Report :: Value
value = Sampling -> Value
Counter (StatConfig -> Sampling -> Sampling
computeRate StatConfig
cfg Sampling
c),
          $sel:rate:Report :: Double
rate = Double
1.0
        }
    ]
  GaugeData Sampling
s ->
    [ Report
        { $sel:key:Report :: Key
key = [Key] -> Key
catKey [StatConfig
cfg.statsPrefix, StatConfig
cfg.prefixGauge, Key
key],
          $sel:value:Report :: Value
value = Sampling -> Bool -> Value
Gauge Sampling
s Bool
False,
          $sel:rate:Report :: Double
rate = Double
1.0
        }
    ]
  SetData HashSet Key
s ->
    [ Report
        { $sel:key:Report :: Key
key = [Key] -> Key
catKey [StatConfig
cfg.statsPrefix, StatConfig
cfg.prefixSet, Key
key, Key
"count"],
          $sel:value:Report :: Value
value = Sampling -> Value
Counter (HashSet Key -> Sampling
forall a. HashSet a -> Sampling
HashSet.size HashSet Key
s),
          $sel:rate:Report :: Double
rate = Double
1.0
        }
    ]
  TimingData [Sampling]
s -> StatConfig -> Key -> [Sampling] -> [Report]
timingReports StatConfig
cfg Key
key [Sampling]
s

data TimingStats = TimingStats
  { TimingStats -> [Sampling]
timings :: ![Int],
    TimingStats -> [Sampling]
cumsums :: ![Int],
    TimingStats -> [Sampling]
cumsquares :: ![Int]
  }
  deriving (TimingStats -> TimingStats -> Bool
(TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool) -> Eq TimingStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimingStats -> TimingStats -> Bool
== :: TimingStats -> TimingStats -> Bool
$c/= :: TimingStats -> TimingStats -> Bool
/= :: TimingStats -> TimingStats -> Bool
Eq, Eq TimingStats
Eq TimingStats
-> (TimingStats -> TimingStats -> Ordering)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> TimingStats)
-> (TimingStats -> TimingStats -> TimingStats)
-> Ord TimingStats
TimingStats -> TimingStats -> Bool
TimingStats -> TimingStats -> Ordering
TimingStats -> TimingStats -> TimingStats
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimingStats -> TimingStats -> Ordering
compare :: TimingStats -> TimingStats -> Ordering
$c< :: TimingStats -> TimingStats -> Bool
< :: TimingStats -> TimingStats -> Bool
$c<= :: TimingStats -> TimingStats -> Bool
<= :: TimingStats -> TimingStats -> Bool
$c> :: TimingStats -> TimingStats -> Bool
> :: TimingStats -> TimingStats -> Bool
$c>= :: TimingStats -> TimingStats -> Bool
>= :: TimingStats -> TimingStats -> Bool
$cmax :: TimingStats -> TimingStats -> TimingStats
max :: TimingStats -> TimingStats -> TimingStats
$cmin :: TimingStats -> TimingStats -> TimingStats
min :: TimingStats -> TimingStats -> TimingStats
Ord, Sampling -> TimingStats -> Key -> Key
[TimingStats] -> Key -> Key
TimingStats -> Key
(Sampling -> TimingStats -> Key -> Key)
-> (TimingStats -> Key)
-> ([TimingStats] -> Key -> Key)
-> Show TimingStats
forall a.
(Sampling -> a -> Key -> Key)
-> (a -> Key) -> ([a] -> Key -> Key) -> Show a
$cshowsPrec :: Sampling -> TimingStats -> Key -> Key
showsPrec :: Sampling -> TimingStats -> Key -> Key
$cshow :: TimingStats -> Key
show :: TimingStats -> Key
$cshowList :: [TimingStats] -> Key -> Key
showList :: [TimingStats] -> Key -> Key
Show, ReadPrec [TimingStats]
ReadPrec TimingStats
Sampling -> ReadS TimingStats
ReadS [TimingStats]
(Sampling -> ReadS TimingStats)
-> ReadS [TimingStats]
-> ReadPrec TimingStats
-> ReadPrec [TimingStats]
-> Read TimingStats
forall a.
(Sampling -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Sampling -> ReadS TimingStats
readsPrec :: Sampling -> ReadS TimingStats
$creadList :: ReadS [TimingStats]
readList :: ReadS [TimingStats]
$creadPrec :: ReadPrec TimingStats
readPrec :: ReadPrec TimingStats
$creadListPrec :: ReadPrec [TimingStats]
readListPrec :: ReadPrec [TimingStats]
Read)

makeTimingStats :: Timings -> TimingStats
makeTimingStats :: [Sampling] -> TimingStats
makeTimingStats [Sampling]
timings =
  TimingStats
    { $sel:timings:TimingStats :: [Sampling]
timings = [Sampling]
sorted,
      $sel:cumsums:TimingStats :: [Sampling]
cumsums = [Sampling] -> [Sampling]
forall a. Num a => [a] -> [a]
cumulativeSums [Sampling]
sorted,
      $sel:cumsquares:TimingStats :: [Sampling]
cumsquares = [Sampling] -> [Sampling]
forall a. Num a => [a] -> [a]
cumulativeSquares [Sampling]
sorted
    }
  where
    sorted :: [Sampling]
sorted = [Sampling] -> [Sampling]
forall a. Ord a => [a] -> [a]
sort [Sampling]
timings

extractPercentiles :: StatConfig -> [Int]
extractPercentiles :: StatConfig -> [Sampling]
extractPercentiles =
  HashSet Sampling -> [Sampling]
forall a. HashSet a -> [a]
HashSet.toList
    (HashSet Sampling -> [Sampling])
-> (StatConfig -> HashSet Sampling) -> StatConfig -> [Sampling]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sampling] -> HashSet Sampling
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
    ([Sampling] -> HashSet Sampling)
-> (StatConfig -> [Sampling]) -> StatConfig -> HashSet Sampling
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sampling -> Bool) -> [Sampling] -> [Sampling]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Sampling
x -> Sampling
x Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
> Sampling
0 Bool -> Bool -> Bool
&& Sampling
x Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
< Sampling
100)
    ([Sampling] -> [Sampling])
-> (StatConfig -> [Sampling]) -> StatConfig -> [Sampling]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.timingPercentiles)

timingReports :: StatConfig -> Key -> Timings -> [Report]
timingReports :: StatConfig -> Key -> [Sampling] -> [Report]
timingReports StatConfig
cfg Key
key [Sampling]
timings =
  (Sampling -> [Report]) -> [Sampling] -> [Report]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (StatConfig -> Key -> TimingStats -> Sampling -> [Report]
timingStats StatConfig
cfg Key
key TimingStats
tstats) [Sampling]
percentiles
  where
    tstats :: TimingStats
tstats = [Sampling] -> TimingStats
makeTimingStats [Sampling]
timings
    percentiles :: [Sampling]
percentiles = Sampling
100 Sampling -> [Sampling] -> [Sampling]
forall a. a -> [a] -> [a]
: StatConfig -> [Sampling]
extractPercentiles StatConfig
cfg

trimPercentile :: Int -> TimingStats -> TimingStats
trimPercentile :: Sampling -> TimingStats -> TimingStats
trimPercentile Sampling
pc TimingStats
ts =
  TimingStats
ts
    { $sel:timings:TimingStats :: [Sampling]
timings = [Sampling] -> [Sampling]
forall {a}. [a] -> [a]
f TimingStats
ts.timings,
      $sel:cumsums:TimingStats :: [Sampling]
cumsums = [Sampling] -> [Sampling]
forall {a}. [a] -> [a]
f TimingStats
ts.cumsums,
      $sel:cumsquares:TimingStats :: [Sampling]
cumsquares = [Sampling] -> [Sampling]
forall {a}. [a] -> [a]
f TimingStats
ts.cumsquares
    }
  where
    f :: [a] -> [a]
f [a]
ls = Sampling -> [a] -> [a]
forall a. Sampling -> [a] -> [a]
take ([a] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length [a]
ls Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
* Sampling
pc Sampling -> Sampling -> Sampling
forall a. Integral a => a -> a -> a
`div` Sampling
100) [a]
ls

percentileSuffix :: Int -> String
percentileSuffix :: Sampling -> Key
percentileSuffix Sampling
pc
  | Sampling
100 Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
<= Sampling
pc = Key
""
  | Sampling
0 Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
> Sampling
pc = Key
"0"
  | Bool
otherwise = Key
"_" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Sampling -> Key
forall a. Show a => a -> Key
show Sampling
pc

computeRate :: StatConfig -> Int -> Int
computeRate :: StatConfig -> Sampling -> Sampling
computeRate StatConfig
cfg Sampling
i =
  Double -> Sampling
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Sampling -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Sampling
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Sampling -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral StatConfig
cfg.flushInterval :: Double)

mean :: TimingStats -> Int
mean :: TimingStats -> Sampling
mean TimingStats
ts = [Sampling] -> Sampling
forall a. HasCallStack => [a] -> a
last TimingStats
ts.cumsums Sampling -> Sampling -> Sampling
forall a. Integral a => a -> a -> a
`div` [Sampling] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length TimingStats
ts.timings

timingStats :: StatConfig -> Key -> TimingStats -> Int -> [Report]
timingStats :: StatConfig -> Key -> TimingStats -> Sampling -> [Report]
timingStats StatConfig
cfg Key
key TimingStats
tstats Sampling
pc =
  Key -> Value -> Report
mkr Key
"count" (Sampling -> Value
Counter ([Sampling] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length TimingStats
ts.timings))
    Report -> [Report] -> [Report]
forall a. a -> [a] -> [a]
: [Key -> Value -> Report
mkr Key
"count_ps" (Sampling -> Value
Counter Sampling
rate) | Sampling
100 Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
<= Sampling
pc]
      [Report] -> [Report] -> [Report]
forall a. Semigroup a => a -> a -> a
<> if [Sampling] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TimingStats
ts.timings
        then []
        else [Report]
stats
  where
    k :: Key -> Key
k Key
s =
      [Key] -> Key
catKey
        [ StatConfig
cfg.statsPrefix,
          StatConfig
cfg.prefixTimer,
          Key
key,
          Key
s Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Sampling -> Key
percentileSuffix Sampling
pc
        ]
    ts :: TimingStats
ts = Sampling -> TimingStats -> TimingStats
trimPercentile Sampling
pc TimingStats
tstats
    rate :: Sampling
rate = StatConfig -> Sampling -> Sampling
computeRate StatConfig
cfg ([Sampling] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length TimingStats
ts.timings)
    mkr :: Key -> Value -> Report
mkr Key
s Value
v = Report {$sel:key:Report :: Key
key = Key -> Key
k Key
s, $sel:value:Report :: Value
value = Value
v, $sel:rate:Report :: Double
rate = Double
1.0}
    stats :: [Report]
stats =
      [ Key -> Value -> Report
mkr Key
"mean" (Sampling -> Value
Timing (TimingStats -> Sampling
mean TimingStats
ts)),
        Key -> Value -> Report
mkr Key
"upper" (Sampling -> Value
Timing ([Sampling] -> Sampling
forall a. HasCallStack => [a] -> a
last TimingStats
ts.timings)),
        Key -> Value -> Report
mkr Key
"lower" (Sampling -> Value
Timing ([Sampling] -> Sampling
forall a. HasCallStack => [a] -> a
head TimingStats
ts.timings)),
        Key -> Value -> Report
mkr Key
"sum" (Sampling -> Value
Timing ([Sampling] -> Sampling
forall a. HasCallStack => [a] -> a
last TimingStats
ts.cumsums)),
        Key -> Value -> Report
mkr Key
"sum_squares" (Sampling -> Value
Timing ([Sampling] -> Sampling
forall a. HasCallStack => [a] -> a
last TimingStats
ts.cumsquares)),
        Key -> Value -> Report
mkr Key
"median" (Sampling -> Value
Timing (TimingStats -> Sampling
median TimingStats
ts))
      ]
        [Report] -> [Report] -> [Report]
forall a. Semigroup a => a -> a -> a
<> [ Key -> Value -> Report
mkr Key
"std" (Sampling -> Value
Timing (TimingStats -> Sampling
stdev TimingStats
ts))
             | Sampling
100 Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
<= Sampling
pc
           ]

cumulativeSums :: (Num a) => [a] -> [a]
cumulativeSums :: forall a. Num a => [a] -> [a]
cumulativeSums = (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 a -> a -> a
forall a. Num a => a -> a -> a
(+)

cumulativeSquares :: (Num a) => [a] -> [a]
cumulativeSquares :: forall a. Num a => [a] -> [a]
cumulativeSquares = (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 a -> a -> a
forall a. Num a => a -> a -> a
(+) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x)

stdev :: TimingStats -> Int
stdev :: TimingStats -> Sampling
stdev TimingStats
ts =
  Double -> Sampling
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Sampling) -> Double -> Sampling
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
sqrt Double
var
  where
    len :: Sampling
len = [Sampling] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length TimingStats
ts.timings
    var :: Double
var = Sampling -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Sampling
diffsum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Sampling -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Sampling
len :: Double
    diffsum :: Sampling
diffsum = [Sampling] -> Sampling
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Sampling] -> Sampling) -> [Sampling] -> Sampling
forall a b. (a -> b) -> a -> b
$ (Sampling -> Sampling) -> [Sampling] -> [Sampling]
forall a b. (a -> b) -> [a] -> [b]
map ((Sampling -> Sampling -> Sampling
forall a b. (Num a, Integral b) => a -> b -> a
^ (Sampling
2 :: Int)) (Sampling -> Sampling)
-> (Sampling -> Sampling) -> Sampling -> Sampling
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
subtract (TimingStats -> Sampling
mean TimingStats
ts)) TimingStats
ts.timings

median :: TimingStats -> Int
median :: TimingStats -> Sampling
median TimingStats
ts
  | [Sampling] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TimingStats
ts.timings = Sampling
0
  | Sampling -> Bool
forall a. Integral a => a -> Bool
even ([Sampling] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length TimingStats
ts.timings) =
      let lower :: Sampling
lower = TimingStats
ts.timings [Sampling] -> Sampling -> Sampling
forall a. HasCallStack => [a] -> Sampling -> a
!! Sampling
middle
          upper :: Sampling
upper = TimingStats
ts.timings [Sampling] -> Sampling -> Sampling
forall a. HasCallStack => [a] -> Sampling -> a
!! Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
subtract Sampling
1 Sampling
middle
       in (Sampling
lower Sampling -> Sampling -> Sampling
forall a. Num a => a -> a -> a
+ Sampling
upper) Sampling -> Sampling -> Sampling
forall a. Integral a => a -> a -> a
`div` Sampling
2
  | Bool
otherwise =
      TimingStats
ts.timings [Sampling] -> Sampling -> Sampling
forall a. HasCallStack => [a] -> Sampling -> a
!! Sampling
middle
  where
    middle :: Sampling
middle = [Sampling] -> Sampling
forall a. [a] -> Sampling
forall (t :: * -> *) a. Foldable t => t a -> Sampling
length TimingStats
ts.timings Sampling -> Sampling -> Sampling
forall a. Integral a => a -> a -> a
`div` Sampling
2

flush :: MetricData -> MetricData
flush :: MetricData -> MetricData
flush (CounterData Sampling
_) = Sampling -> MetricData
CounterData Sampling
0
flush (GaugeData Sampling
g) = Sampling -> MetricData
GaugeData Sampling
g
flush (TimingData [Sampling]
_) = [Sampling] -> MetricData
TimingData []
flush (SetData HashSet Key
_) = HashSet Key -> MetricData
SetData HashSet Key
forall a. HashSet a
HashSet.empty

toReport :: Sample -> Maybe Report
toReport :: Sample -> Maybe Report
toReport Sample
sample
  | Sample
sample.sampling Sampling -> Sampling -> Bool
forall a. Ord a => a -> a -> Bool
> Sampling
0 Bool -> Bool -> Bool
&& Sample
sample.index Sampling -> Sampling -> Sampling
forall a. Integral a => a -> a -> a
`mod` Sample
sample.sampling Sampling -> Sampling -> Bool
forall a. Eq a => a -> a -> Bool
== Sampling
0 =
      Report -> Maybe Report
forall a. a -> Maybe a
Just
        Report
          { $sel:key:Report :: Key
key = Sample
sample.key,
            $sel:value:Report :: Value
value = Sample
sample.value,
            $sel:rate:Report :: Double
rate = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Sampling -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Sample
sample.sampling
          }
  | Bool
otherwise = Maybe Report
forall a. Maybe a
Nothing

format :: StatConfig -> Report -> String
format :: StatConfig -> Report -> Key
format StatConfig
cfg Report
report
  | StatConfig
cfg.newline = Key -> Key -> Key -> Key
forall r. PrintfType r => Key -> r
printf Key
"%s:%s\n" Key
key Key
val
  | Bool
otherwise = Key -> Key -> Key -> Key
forall r. PrintfType r => Key -> r
printf Key
"%s:%s" Key
key Key
val
  where
    key :: Key
key = [Key] -> Key
catKey [StatConfig
cfg.namespace, Report
report.key]
    rate :: Key
rate
      | Report
report.rate Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1.0 = Key -> Double -> Key
forall r. PrintfType r => Key -> r
printf Key
"|@%f" Report
report.rate
      | Bool
otherwise = Key
"" :: String
    val :: Key
val =
      case Report
report.value of
        Counter Sampling
i ->
          Key -> Sampling -> Key -> Key
forall r. PrintfType r => Key -> r
printf Key
"%d|c%s" Sampling
i Key
rate
        Gauge Sampling
g Bool
False ->
          Key -> Sampling -> Key
forall r. PrintfType r => Key -> r
printf Key
"%d|g" Sampling
g
        Gauge Sampling
g Bool
True ->
          Key -> Sampling -> Key
forall r. PrintfType r => Key -> r
printf Key
"%+d|g" Sampling
g
        Timing Sampling
t ->
          Key -> Sampling -> Key -> Key
forall r. PrintfType r => Key -> r
printf Key
"%d|ms%s" Sampling
t Key
rate
        Set Key
e ->
          Key -> Key -> Key
forall r. PrintfType r => Key -> r
printf Key
"%s|s" Key
e
        Metric Sampling
m ->
          Key -> Sampling -> Key
forall r. PrintfType r => Key -> r
printf Key
"%s|m" Sampling
m
        Other Key
d Key
t ->
          Key -> Key -> Key -> Key
forall r. PrintfType r => Key -> r
printf Key
"%s|%s" Key
t Key
d :: String

submit :: (MonadIO m) => Stats -> Sample -> m ()
submit :: forall (m :: * -> *). MonadIO m => Stats -> Sample -> m ()
submit Stats
stats Sample
sample =
  Maybe Report -> (Report -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Sample -> Maybe Report
toReport Sample
sample) (Stats -> Report -> m ()
forall (m :: * -> *). MonadIO m => Stats -> Report -> m ()
send Stats
stats)

send :: (MonadIO m) => Stats -> Report -> m ()
send :: forall (m :: * -> *). MonadIO m => Stats -> Report -> m ()
send Stats
stats Report
report =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    Socket -> ByteString -> IO ()
Net.sendAll Stats
stats.socket (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
      Key -> ByteString
C.pack (Key -> ByteString) -> Key -> ByteString
forall a b. (a -> b) -> a -> b
$
        StatConfig -> Report -> Key
format Stats
stats.cfg Report
report

connectStatsD :: (MonadIO m) => String -> Int -> m Socket
connectStatsD :: forall (m :: * -> *). MonadIO m => Key -> Sampling -> m Socket
connectStatsD Key
host Sampling
port = IO Socket -> m Socket
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ do
  [AddrInfo]
as <-
    Maybe AddrInfo -> Maybe Key -> Maybe Key -> IO [AddrInfo]
Net.getAddrInfo
      Maybe AddrInfo
forall a. Maybe a
Nothing
      (Key -> Maybe Key
forall a. a -> Maybe a
Just Key
host)
      (Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> Key -> Maybe Key
forall a b. (a -> b) -> a -> b
$ Sampling -> Key
forall a. Show a => a -> Key
show Sampling
port)
  AddrInfo
a <- case [AddrInfo]
as of
    AddrInfo
a : [AddrInfo]
_ -> AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AddrInfo
a
    [] -> Key -> IO AddrInfo
forall a. HasCallStack => Key -> a
error (Key -> IO AddrInfo) -> Key -> IO AddrInfo
forall a b. (a -> b) -> a -> b
$ Key
"Cannot resolve: " Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
host Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
":" Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Sampling -> Key
forall a. Show a => a -> Key
show Sampling
port
  Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
Net.socket (AddrInfo -> Family
Net.addrFamily AddrInfo
a) SocketType
Net.Datagram ProtocolNumber
Net.defaultProtocol
  Socket -> SockAddr -> IO ()
Net.connect Socket
sock (AddrInfo -> SockAddr
Net.addrAddress AddrInfo
a)
  Socket -> IO Socket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock