-- | Send RTS statistics via "Freckle.App.Stats"
module Freckle.App.Stats.Rts
  ( forkRtsStatPolling
  ) where

import Freckle.App.Prelude

import qualified Control.Immortal as Immortal
import qualified Data.HashMap.Strict as HashMap
import Freckle.App.Stats (HasStatsClient)
import qualified Freckle.App.Stats as Stats
import qualified System.Metrics as Ekg
import qualified System.Metrics.Distribution.Internal as Ekg
import UnliftIO.Concurrent (threadDelay)

-- | Initialize a thread to poll RTS stats
--
-- Stats are collected via `ekg-core` and 'System.Metrics.registerGcMetrics'
forkRtsStatPolling
  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => m ()
forkRtsStatPolling :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
m ()
forkRtsStatPolling = do
  Store
store <- IO Store -> m Store
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Store
Ekg.newStore
  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
$ Store -> IO ()
Ekg.registerGcMetrics Store
store

  m Thread -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Thread -> m ()) -> m Thread -> m ()
forall a b. (a -> b) -> a -> b
$ (Thread -> m ()) -> m Thread
forall (m :: * -> *).
MonadUnliftIO m =>
(Thread -> m ()) -> m Thread
Immortal.create ((Thread -> m ()) -> m Thread) -> (Thread -> m ()) -> m Thread
forall a b. (a -> b) -> a -> b
$ \Thread
_ -> do
    Sample
sample <- IO Sample -> m Sample
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sample -> m Sample) -> IO Sample -> m Sample
forall a b. (a -> b) -> a -> b
$ Store -> IO Sample
Ekg.sampleAll Store
store
    ((Text, Value) -> m ()) -> [(Text, Value)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Text -> Value -> m ()) -> (Text, Value) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Value -> m ()
flushEkgSample) ([(Text, Value)] -> m ()) -> [(Text, Value)] -> m ()
forall a b. (a -> b) -> a -> b
$ Sample -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Sample
sample

    let seconds :: a -> a
seconds a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000
    Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall {a}. Num a => a -> a
seconds Int
1

flushEkgSample
  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)
  => Text
  -> Ekg.Value
  -> m ()
flushEkgSample :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Value -> m ()
flushEkgSample Text
name = \case
  Ekg.Counter Int64
n -> Text -> Int -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Int -> m ()
Stats.counter Text
name (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
  Ekg.Gauge Int64
n -> Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
Stats.gauge Text
name (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
  Ekg.Distribution Stats
d -> do
    Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
Stats.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"mean") (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.mean Stats
d
    Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
Stats.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"variance") (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.variance Stats
d
    Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
Stats.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"sum") (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.sum Stats
d
    Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
Stats.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"min") (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.min Stats
d
    Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
Stats.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"max") (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.max Stats
d
    Text -> Int -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Int -> m ()
Stats.counter (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"count") (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Stats -> Int64
Ekg.count Stats
d
  Ekg.Label Text
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()