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

import Freckle.App.Prelude

import Control.Immortal qualified as Immortal
import Data.HashMap.Strict qualified as HashMap
import Freckle.App.Stats (HasStatsClient)
import Freckle.App.Stats qualified as Stats
import System.Metrics qualified as Ekg
import System.Metrics.Distribution.Internal qualified 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 <- IO Store -> m Store
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Store
Ekg.newStore
  liftIO $ Ekg.registerGcMetrics store

  void $ Immortal.create $ \Thread
_ -> do
    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
    traverse_ (uncurry flushEkgSample) $ HashMap.toList sample

    let seconds a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000
    threadDelay $ seconds 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 ()