module System.Metrics.DistributedProcess
    ( registerLocalNodeMetrics
    ) where

import Control.Concurrent.MVar
import Control.Distributed.Process      (NodeStats (..), Process, ProcessId,
                                         getLocalNodeStats, liftIO)
import Control.Distributed.Process.Node (LocalNode, forkProcess)
import System.Metrics                   (Store, Value (..), registerGroup)

import qualified Data.HashMap.Strict as HM
import qualified Data.Text           as T

registerLocalNodeMetrics :: LocalNode -> Store -> IO ProcessId
registerLocalNodeMetrics node store = do
  s <- newEmptyMVar
  registerGroup stats (sample s) store
  forkProcess node (collect s)
  where
    -- Throw away stale stats first so collect can refresh them.
    sample :: MVar NodeStats -> IO NodeStats
    sample s =
      tryTakeMVar s >> takeMVar s

    collect :: MVar NodeStats -> Process ()
    collect s =
      getLocalNodeStats >>= liftIO . putMVar s >> collect s

    stats :: HM.HashMap T.Text (NodeStats -> Value)
    stats = HM.fromList
      [ ( T.pack "dp.node.reg_names"
        , Gauge . fromIntegral . nodeStatsRegisteredNames
        )
      , ( T.pack "dp.node.monitors"
        , Gauge . fromIntegral . nodeStatsMonitors
        )
      , ( T.pack "dp.node.links"
        , Gauge . fromIntegral . nodeStatsLinks
        )
      , ( T.pack "dp.node.processes"
        , Gauge . fromIntegral . nodeStatsProcesses
        )
      ]