{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module System.Metrics.Prometheus.Ridley.Metrics.PhysicalMemory where
import Control.Monad.IO.Class
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
import Data.Word
import qualified Data.Text as T
import Lens.Micro
import Shelly
import qualified System.Metrics.Prometheus.Metric.Gauge as P
import qualified System.Metrics.Prometheus.RegistryT as P
import System.Metrics.Prometheus.Ridley.Types
import System.Posix.Types (ProcessID)
import System.Remote.Monitoring.Prometheus (labels)
import Text.Read (readMaybe)
getFreeStats :: IO FreeReport
getFreeStats :: IO FreeReport
getFreeStats = do
[Word64]
rawOutput <- Sh [Word64] -> IO [Word64]
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh [Word64] -> IO [Word64]) -> Sh [Word64] -> IO [Word64]
forall a b. (a -> b) -> a -> b
$ Sh [Word64] -> Sh [Word64]
forall a. Sh a -> Sh a
silently (Sh [Word64] -> Sh [Word64]) -> Sh [Word64] -> Sh [Word64]
forall a b. (a -> b) -> a -> b
$ Bool -> Sh [Word64] -> Sh [Word64]
forall a. Bool -> Sh a -> Sh a
escaping Bool
False (Sh [Word64] -> Sh [Word64]) -> Sh [Word64] -> Sh [Word64]
forall a b. (a -> b) -> a -> b
$
(Text -> Maybe Word64) -> [Text] -> [Word64]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Read Word64 => String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe @Word64 (String -> Maybe Word64)
-> (Text -> String) -> Text -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Word64]) -> (Text -> [Text]) -> Text -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> [Word64]) -> Sh Text -> Sh [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Text] -> Sh Text
run String
"free" [Text
"-m" ,Text
"|" , Text
"tail", Text
"-n", Text
"-2" , Text
"|", Text
"awk", Text
"-F", Text
"\" \"", Text
"'{printf \"%s %s %s %s %s %s %s\", $2, $3, $4, $5, $6, $7, $8}'"]
case [Word64]
rawOutput of
[ Word64
free_mem_total_mb
, Word64
free_mem_used_mb
, Word64
free_mem_free_mb
, Word64
free_mem_shared_mb
, Word64
free_mem_buff_cache_mb
, Word64
free_mem_available_mb
, Word64
free_swap_total_mb
, Word64
free_swap_used_mb
, Word64
free_swap_free_mb
] -> FreeReport -> IO FreeReport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeReport -> IO FreeReport) -> FreeReport -> IO FreeReport
forall a b. (a -> b) -> a -> b
$ FreeReport :: Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> FreeReport
FreeReport{Word64
free_swap_free_mb :: Word64
free_swap_used_mb :: Word64
free_swap_total_mb :: Word64
free_mem_available_mb :: Word64
free_mem_buff_cache_mb :: Word64
free_mem_shared_mb :: Word64
free_mem_free_mb :: Word64
free_mem_used_mb :: Word64
free_mem_total_mb :: Word64
free_swap_free_mb :: Word64
free_swap_used_mb :: Word64
free_swap_total_mb :: Word64
free_mem_available_mb :: Word64
free_mem_buff_cache_mb :: Word64
free_mem_shared_mb :: Word64
free_mem_free_mb :: Word64
free_mem_used_mb :: Word64
free_mem_total_mb :: Word64
..}
[Word64]
_ -> FreeReport -> IO FreeReport
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeReport
emptyFreeReport
updateFreeStats :: FreeGauges -> Bool -> IO ()
updateFreeStats :: FreeGauges -> Bool -> IO ()
updateFreeStats FreeGauges{Gauge
free_swap_free_mb_g :: FreeGauges -> Gauge
free_swap_used_mb_g :: FreeGauges -> Gauge
free_swap_total_mb_g :: FreeGauges -> Gauge
free_mem_available_mb_g :: FreeGauges -> Gauge
free_mem_buff_cache_mb_g :: FreeGauges -> Gauge
free_mem_shared_mb_g :: FreeGauges -> Gauge
free_mem_free_mb_g :: FreeGauges -> Gauge
free_mem_used_mb_g :: FreeGauges -> Gauge
free_mem_total_mb_g :: FreeGauges -> Gauge
free_swap_free_mb_g :: Gauge
free_swap_used_mb_g :: Gauge
free_swap_total_mb_g :: Gauge
free_mem_available_mb_g :: Gauge
free_mem_buff_cache_mb_g :: Gauge
free_mem_shared_mb_g :: Gauge
free_mem_free_mb_g :: Gauge
free_mem_used_mb_g :: Gauge
free_mem_total_mb_g :: Gauge
..} Bool
_ = do
#ifdef darwin_HOST_OS
let FreeReport{..} = emptyFreeReport
#else
FreeReport{Word64
free_swap_free_mb :: Word64
free_swap_used_mb :: Word64
free_swap_total_mb :: Word64
free_mem_available_mb :: Word64
free_mem_buff_cache_mb :: Word64
free_mem_shared_mb :: Word64
free_mem_free_mb :: Word64
free_mem_used_mb :: Word64
free_mem_total_mb :: Word64
free_swap_free_mb :: FreeReport -> Word64
free_swap_used_mb :: FreeReport -> Word64
free_swap_total_mb :: FreeReport -> Word64
free_mem_available_mb :: FreeReport -> Word64
free_mem_buff_cache_mb :: FreeReport -> Word64
free_mem_shared_mb :: FreeReport -> Word64
free_mem_free_mb :: FreeReport -> Word64
free_mem_used_mb :: FreeReport -> Word64
free_mem_total_mb :: FreeReport -> Word64
..} <- IO FreeReport
getFreeStats
#endif
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_mem_total_mb ) Gauge
free_mem_total_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_mem_used_mb ) Gauge
free_mem_used_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_mem_free_mb ) Gauge
free_mem_free_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_mem_shared_mb ) Gauge
free_mem_shared_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_mem_buff_cache_mb ) Gauge
free_mem_buff_cache_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_mem_available_mb ) Gauge
free_mem_available_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_swap_total_mb ) Gauge
free_swap_total_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_swap_used_mb ) Gauge
free_swap_used_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
free_swap_free_mb ) Gauge
free_swap_free_mb_g
data FreeReport =
FreeReport {
FreeReport -> Word64
free_mem_total_mb :: !Word64
, FreeReport -> Word64
free_mem_used_mb :: !Word64
, FreeReport -> Word64
free_mem_free_mb :: !Word64
, FreeReport -> Word64
free_mem_shared_mb :: !Word64
, FreeReport -> Word64
free_mem_buff_cache_mb :: !Word64
, FreeReport -> Word64
free_mem_available_mb :: !Word64
, FreeReport -> Word64
free_swap_total_mb :: !Word64
, FreeReport -> Word64
free_swap_used_mb :: !Word64
, FreeReport -> Word64
free_swap_free_mb :: !Word64
} deriving (Int -> FreeReport -> ShowS
[FreeReport] -> ShowS
FreeReport -> String
(Int -> FreeReport -> ShowS)
-> (FreeReport -> String)
-> ([FreeReport] -> ShowS)
-> Show FreeReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FreeReport] -> ShowS
$cshowList :: [FreeReport] -> ShowS
show :: FreeReport -> String
$cshow :: FreeReport -> String
showsPrec :: Int -> FreeReport -> ShowS
$cshowsPrec :: Int -> FreeReport -> ShowS
Show, FreeReport -> FreeReport -> Bool
(FreeReport -> FreeReport -> Bool)
-> (FreeReport -> FreeReport -> Bool) -> Eq FreeReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FreeReport -> FreeReport -> Bool
$c/= :: FreeReport -> FreeReport -> Bool
== :: FreeReport -> FreeReport -> Bool
$c== :: FreeReport -> FreeReport -> Bool
Eq)
emptyFreeReport :: FreeReport
emptyFreeReport :: FreeReport
emptyFreeReport = FreeReport :: Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> FreeReport
FreeReport
{ free_mem_total_mb :: Word64
free_mem_total_mb = Word64
0
, free_mem_used_mb :: Word64
free_mem_used_mb = Word64
0
, free_mem_free_mb :: Word64
free_mem_free_mb = Word64
0
, free_mem_shared_mb :: Word64
free_mem_shared_mb = Word64
0
, free_mem_buff_cache_mb :: Word64
free_mem_buff_cache_mb = Word64
0
, free_mem_available_mb :: Word64
free_mem_available_mb = Word64
0
, free_swap_total_mb :: Word64
free_swap_total_mb = Word64
0
, free_swap_used_mb :: Word64
free_swap_used_mb = Word64
0
, free_swap_free_mb :: Word64
free_swap_free_mb = Word64
0
}
data FreeGauges =
FreeGauges {
FreeGauges -> Gauge
free_mem_total_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_mem_used_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_mem_free_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_mem_shared_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_mem_buff_cache_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_mem_available_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_swap_total_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_swap_used_mb_g :: !P.Gauge
, FreeGauges -> Gauge
free_swap_free_mb_g :: !P.Gauge
}
systemPhysicalMemory :: MonadIO m
=> RidleyOptions
-> P.RegistryT m RidleyMetricHandler
systemPhysicalMemory :: RidleyOptions -> RegistryT m RidleyMetricHandler
systemPhysicalMemory RidleyOptions
opts = do
let popts :: PrometheusOptions
popts = RidleyOptions
opts RidleyOptions
-> Getting PrometheusOptions RidleyOptions PrometheusOptions
-> PrometheusOptions
forall s a. s -> Getting a s a -> a
^. Getting PrometheusOptions RidleyOptions PrometheusOptions
Lens' RidleyOptions PrometheusOptions
prometheusOptions
FreeGauges
gauges <- Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> FreeGauges
FreeGauges (Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> FreeGauges)
-> RegistryT m Gauge
-> RegistryT
m
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> FreeGauges)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_mem_total_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT
m
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> FreeGauges)
-> RegistryT m Gauge
-> RegistryT
m
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_mem_used_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT
m
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> FreeGauges)
-> RegistryT m Gauge
-> RegistryT
m
(Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_mem_free_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT
m
(Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> FreeGauges)
-> RegistryT m Gauge
-> RegistryT
m (Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_mem_shared_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT
m (Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> FreeGauges)
-> RegistryT m Gauge
-> RegistryT m (Gauge -> Gauge -> Gauge -> Gauge -> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_mem_buff_cache_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT m (Gauge -> Gauge -> Gauge -> Gauge -> FreeGauges)
-> RegistryT m Gauge
-> RegistryT m (Gauge -> Gauge -> Gauge -> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_mem_available_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT m (Gauge -> Gauge -> Gauge -> FreeGauges)
-> RegistryT m Gauge -> RegistryT m (Gauge -> Gauge -> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_swap_total_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT m (Gauge -> Gauge -> FreeGauges)
-> RegistryT m Gauge -> RegistryT m (Gauge -> FreeGauges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_swap_used_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RegistryT m (Gauge -> FreeGauges)
-> RegistryT m Gauge -> RegistryT m FreeGauges
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT m Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"free_swap_free_mb" (PrometheusOptions
popts PrometheusOptions
-> Getting Labels PrometheusOptions Labels -> Labels
forall s a. s -> Getting a s a -> a
^. Getting Labels PrometheusOptions Labels
Lens' PrometheusOptions Labels
labels)
RidleyMetricHandler -> RegistryT m RidleyMetricHandler
forall (m :: * -> *) a. Monad m => a -> m a
return (RidleyMetricHandler -> RegistryT m RidleyMetricHandler)
-> RidleyMetricHandler -> RegistryT m RidleyMetricHandler
forall a b. (a -> b) -> a -> b
$ Text
-> FreeGauges
-> (FreeGauges -> Bool -> IO ())
-> Bool
-> RidleyMetricHandler
forall c.
HasCallStack =>
Text -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler Text
"ridley-physical-memory-statistics" FreeGauges
gauges FreeGauges -> Bool -> IO ()
updateFreeStats Bool
False