{-# LANGUAGE OverloadedStrings #-}
module System.Metrics.Prometheus.Ridley.Metrics.Memory (
    processMemory
  ) where

import qualified System.Metrics.Prometheus.Metric.Gauge as P
import           System.Metrics.Prometheus.Ridley.Types
import           System.Posix.Process
import           System.Process
import           Text.Read

--------------------------------------------------------------------------------
-- | Return the amount of occupied memory for this
-- process. We use unix's `ps` command that,
-- although has the reputation of not being 100%
-- accurate, at least works on Darwin and Linux
-- without using any CPP processor.
-- Returns the memory in Kb.
getProcessMemory :: IO (Maybe Integer)
getProcessMemory :: IO (Maybe Integer)
getProcessMemory = do
  ProcessID
myPid <- IO ProcessID
getProcessID
  String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer) -> IO String -> IO (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"ps" [String
"-o", String
"rss=", String
"-p", ProcessID -> String
forall a. Show a => a -> String
show ProcessID
myPid] []

--------------------------------------------------------------------------------
-- | As this is a gauge, it makes no sense flushing it.
updateProcessMemory :: P.Gauge -> Bool -> IO ()
updateProcessMemory :: Gauge -> Bool -> IO ()
updateProcessMemory Gauge
g Bool
_ = do
  Maybe Integer
mbMem <- IO (Maybe Integer)
getProcessMemory
  case Maybe Integer
mbMem of
    Maybe Integer
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Integer
m  -> Double -> Gauge -> IO ()
P.set (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) Gauge
g

--------------------------------------------------------------------------------
processMemory :: P.Gauge -> RidleyMetricHandler
processMemory :: Gauge -> RidleyMetricHandler
processMemory Gauge
g = Text
-> Gauge -> (Gauge -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
forall c.
HasCallStack =>
Text -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler Text
"ridley-process-memory" Gauge
g Gauge -> Bool -> IO ()
updateProcessMemory Bool
False