{-# LANGUAGE OverloadedStrings #-}
module System.Metrics.Prometheus.Ridley.Metrics.Memory (
processMemory
) where
import Katip
import System.Exit
import System.Metrics.Prometheus.Ridley.Types
import System.Metrics.Prometheus.Ridley.Types.Internal
import System.Posix.Process
import System.Process
import Text.Read
import qualified Data.Text as T
import qualified System.Metrics.Prometheus.Metric.Gauge as P
getProcessMemory :: Logger -> IO (Maybe Integer)
getProcessMemory :: Logger -> IO (Maybe Integer)
getProcessMemory Logger
logger = do
ProcessID
myPid <- IO ProcessID
getProcessID
(ExitCode
exitCode, String
rawOutput, String
errors) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"ps" [String
"-o", String
"rss=", String
"-p", forall a. Show a => a -> String
show ProcessID
myPid] []
case ExitCode
exitCode of
ExitCode
ExitSuccess -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> Maybe a
readMaybe String
rawOutput
ExitFailure Int
ec -> do
Logger
logger Severity
ErrorS forall a b. (a -> b) -> a -> b
$ Text
"getProcessMemory exited with error code " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
ec) forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
errors
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
updateProcessMemory :: Logger -> P.Gauge -> Bool -> IO ()
updateProcessMemory :: Logger -> Gauge -> Bool -> IO ()
updateProcessMemory Logger
logger Gauge
g Bool
_ = do
Maybe Integer
mbMem <- Logger -> IO (Maybe Integer)
getProcessMemory Logger
logger
case Maybe Integer
mbMem of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Integer
m -> Double -> Gauge -> IO ()
P.set (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) Gauge
g
processMemory :: Logger -> P.Gauge -> RidleyMetricHandler
processMemory :: Logger -> Gauge -> RidleyMetricHandler
processMemory Logger
logger Gauge
g = do
forall c.
HasCallStack =>
Text -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler Text
"ridley-process-memory" Gauge
g (Logger -> Gauge -> Bool -> IO ()
updateProcessMemory Logger
logger) Bool
False