{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module System.Metrics.Prometheus.Ridley.Metrics.VirtualMemory where
import Control.Monad.Reader (ask, lift)
import Data.Maybe (mapMaybe)
import Data.Word
import Lens.Micro
import Shelly
import System.Metrics.Prometheus.Ridley.Types
import System.Remote.Monitoring.Prometheus (labels)
import Text.Read (readMaybe)
import qualified Data.Text as T
import qualified System.Metrics.Prometheus.Metric.Gauge as P
import qualified System.Metrics.Prometheus.RegistryT as P
getVmStats :: IO VmStatReport
getVmStats :: IO VmStatReport
getVmStats = 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 (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
"vmstat" [Text
"-S", Text
"M", Text
"-s" ,Text
"|" , Text
"head", Text
"-n", Text
"10" , Text
"|" , Text
"awk", Text
"-F", Text
"\" \"" , Text
"'{print $1}'" ]
case [Word64]
rawOutput of
[ Word64
vmstat_total_memory_mb
, Word64
vmstat_used_memory_mb
, Word64
vmstat_active_memory_mb
, Word64
vmstat_inactive_memory_mb
, Word64
vmstat_free_memory_mb
, Word64
vmstat_buffer_memory_mb
, Word64
vmstat_swap_cache_mb
, Word64
vmstat_total_swap_mb
, Word64
vmstat_used_swap_mb
, Word64
vmstat_free_swap_mb
] -> VmStatReport -> IO VmStatReport
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VmStatReport -> IO VmStatReport)
-> VmStatReport -> IO VmStatReport
forall a b. (a -> b) -> a -> b
$ VmStatReport{Word64
vmstat_total_memory_mb :: Word64
vmstat_used_memory_mb :: Word64
vmstat_active_memory_mb :: Word64
vmstat_inactive_memory_mb :: Word64
vmstat_free_memory_mb :: Word64
vmstat_buffer_memory_mb :: Word64
vmstat_swap_cache_mb :: Word64
vmstat_total_swap_mb :: Word64
vmstat_used_swap_mb :: Word64
vmstat_free_swap_mb :: Word64
vmstat_total_memory_mb :: Word64
vmstat_used_memory_mb :: Word64
vmstat_active_memory_mb :: Word64
vmstat_inactive_memory_mb :: Word64
vmstat_free_memory_mb :: Word64
vmstat_buffer_memory_mb :: Word64
vmstat_swap_cache_mb :: Word64
vmstat_total_swap_mb :: Word64
vmstat_used_swap_mb :: Word64
vmstat_free_swap_mb :: Word64
..}
[Word64]
_ -> VmStatReport -> IO VmStatReport
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VmStatReport
emptyVmStatReport
updateVmStat :: VmStatGauges -> Bool -> IO ()
updateVmStat :: VmStatGauges -> Bool -> IO ()
updateVmStat VmStatGauges{Gauge
vmstat_total_memory_mb_g :: Gauge
vmstat_used_memory_mb_g :: Gauge
vmstat_active_memory_mb_g :: Gauge
vmstat_inactive_memory_mb_g :: Gauge
vmstat_free_memory_mb_g :: Gauge
vmstat_buffer_memory_mb_g :: Gauge
vmstat_swap_cache_mb_g :: Gauge
vmstat_total_swap_mb_g :: Gauge
vmstat_used_swap_mb_g :: Gauge
vmstat_free_swap_mb_g :: Gauge
vmstat_total_memory_mb_g :: VmStatGauges -> Gauge
vmstat_used_memory_mb_g :: VmStatGauges -> Gauge
vmstat_active_memory_mb_g :: VmStatGauges -> Gauge
vmstat_inactive_memory_mb_g :: VmStatGauges -> Gauge
vmstat_free_memory_mb_g :: VmStatGauges -> Gauge
vmstat_buffer_memory_mb_g :: VmStatGauges -> Gauge
vmstat_swap_cache_mb_g :: VmStatGauges -> Gauge
vmstat_total_swap_mb_g :: VmStatGauges -> Gauge
vmstat_used_swap_mb_g :: VmStatGauges -> Gauge
vmstat_free_swap_mb_g :: VmStatGauges -> Gauge
..} Bool
_ = do
#ifdef darwin_HOST_OS
let VmStatReport{..} = emptyVmStatReport
#else
VmStatReport{Word64
vmstat_total_memory_mb :: VmStatReport -> Word64
vmstat_used_memory_mb :: VmStatReport -> Word64
vmstat_active_memory_mb :: VmStatReport -> Word64
vmstat_inactive_memory_mb :: VmStatReport -> Word64
vmstat_free_memory_mb :: VmStatReport -> Word64
vmstat_buffer_memory_mb :: VmStatReport -> Word64
vmstat_swap_cache_mb :: VmStatReport -> Word64
vmstat_total_swap_mb :: VmStatReport -> Word64
vmstat_used_swap_mb :: VmStatReport -> Word64
vmstat_free_swap_mb :: VmStatReport -> Word64
vmstat_total_memory_mb :: Word64
vmstat_used_memory_mb :: Word64
vmstat_active_memory_mb :: Word64
vmstat_inactive_memory_mb :: Word64
vmstat_free_memory_mb :: Word64
vmstat_buffer_memory_mb :: Word64
vmstat_swap_cache_mb :: Word64
vmstat_total_swap_mb :: Word64
vmstat_used_swap_mb :: Word64
vmstat_free_swap_mb :: Word64
..} <- IO VmStatReport
getVmStats
#endif
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_total_memory_mb ) Gauge
vmstat_total_memory_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_used_memory_mb ) Gauge
vmstat_used_memory_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_active_memory_mb ) Gauge
vmstat_active_memory_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_inactive_memory_mb ) Gauge
vmstat_inactive_memory_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_free_memory_mb ) Gauge
vmstat_free_memory_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_buffer_memory_mb ) Gauge
vmstat_buffer_memory_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_swap_cache_mb ) Gauge
vmstat_swap_cache_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_total_swap_mb ) Gauge
vmstat_total_swap_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_used_swap_mb ) Gauge
vmstat_used_swap_mb_g
Double -> Gauge -> IO ()
P.set (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
vmstat_free_swap_mb ) Gauge
vmstat_free_swap_mb_g
data VmStatReport =
VmStatReport {
VmStatReport -> Word64
vmstat_total_memory_mb :: !Word64
, VmStatReport -> Word64
vmstat_used_memory_mb :: !Word64
, VmStatReport -> Word64
vmstat_active_memory_mb :: !Word64
, VmStatReport -> Word64
vmstat_inactive_memory_mb :: !Word64
, VmStatReport -> Word64
vmstat_free_memory_mb :: !Word64
, VmStatReport -> Word64
vmstat_buffer_memory_mb :: !Word64
, VmStatReport -> Word64
vmstat_swap_cache_mb :: !Word64
, VmStatReport -> Word64
vmstat_total_swap_mb :: !Word64
, VmStatReport -> Word64
vmstat_used_swap_mb :: !Word64
, VmStatReport -> Word64
vmstat_free_swap_mb :: !Word64
} deriving (Int -> VmStatReport -> ShowS
[VmStatReport] -> ShowS
VmStatReport -> String
(Int -> VmStatReport -> ShowS)
-> (VmStatReport -> String)
-> ([VmStatReport] -> ShowS)
-> Show VmStatReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VmStatReport -> ShowS
showsPrec :: Int -> VmStatReport -> ShowS
$cshow :: VmStatReport -> String
show :: VmStatReport -> String
$cshowList :: [VmStatReport] -> ShowS
showList :: [VmStatReport] -> ShowS
Show, VmStatReport -> VmStatReport -> Bool
(VmStatReport -> VmStatReport -> Bool)
-> (VmStatReport -> VmStatReport -> Bool) -> Eq VmStatReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VmStatReport -> VmStatReport -> Bool
== :: VmStatReport -> VmStatReport -> Bool
$c/= :: VmStatReport -> VmStatReport -> Bool
/= :: VmStatReport -> VmStatReport -> Bool
Eq)
emptyVmStatReport :: VmStatReport
emptyVmStatReport :: VmStatReport
emptyVmStatReport = VmStatReport
{ vmstat_total_memory_mb :: Word64
vmstat_total_memory_mb = Word64
0
, vmstat_used_memory_mb :: Word64
vmstat_used_memory_mb = Word64
0
, vmstat_active_memory_mb :: Word64
vmstat_active_memory_mb = Word64
0
, vmstat_inactive_memory_mb :: Word64
vmstat_inactive_memory_mb = Word64
0
, vmstat_free_memory_mb :: Word64
vmstat_free_memory_mb = Word64
0
, vmstat_buffer_memory_mb :: Word64
vmstat_buffer_memory_mb = Word64
0
, vmstat_swap_cache_mb :: Word64
vmstat_swap_cache_mb = Word64
0
, vmstat_total_swap_mb :: Word64
vmstat_total_swap_mb = Word64
0
, vmstat_used_swap_mb :: Word64
vmstat_used_swap_mb = Word64
0
, vmstat_free_swap_mb :: Word64
vmstat_free_swap_mb = Word64
0
}
data VmStatGauges =
VmStatGauges {
VmStatGauges -> Gauge
vmstat_total_memory_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_used_memory_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_active_memory_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_inactive_memory_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_free_memory_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_buffer_memory_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_swap_cache_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_total_swap_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_used_swap_mb_g :: !P.Gauge
, VmStatGauges -> Gauge
vmstat_free_swap_mb_g :: !P.Gauge
}
systemVirtualMemory :: Ridley RidleyMetricHandler
systemVirtualMemory :: Ridley RidleyMetricHandler
systemVirtualMemory = do
RidleyOptions
opts <- RidleyT (RegistryT (KatipContextT IO)) RidleyOptions
forall r (m :: * -> *). MonadReader r m => m r
ask
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
VmStatGauges
gauges <- RegistryT (KatipContextT IO) VmStatGauges
-> RidleyT (RegistryT (KatipContextT IO)) VmStatGauges
forall (m :: * -> *) a. Monad m => m a -> RidleyT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RegistryT (KatipContextT IO) VmStatGauges
-> RidleyT (RegistryT (KatipContextT IO)) VmStatGauges)
-> RegistryT (KatipContextT IO) VmStatGauges
-> RidleyT (RegistryT (KatipContextT IO)) VmStatGauges
forall a b. (a -> b) -> a -> b
$ Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges
VmStatGauges (Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO)
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_total_memory_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
(KatipContextT IO)
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO)
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_used_memory_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
(KatipContextT IO)
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO)
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_active_memory_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
(KatipContextT IO)
(Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> Gauge
-> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO)
(Gauge
-> Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_inactive_memory_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
(KatipContextT IO)
(Gauge
-> Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO)
(Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_free_memory_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
(KatipContextT IO)
(Gauge -> Gauge -> Gauge -> Gauge -> Gauge -> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO)
(Gauge -> Gauge -> Gauge -> Gauge -> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_buffer_memory_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
(KatipContextT IO)
(Gauge -> Gauge -> Gauge -> Gauge -> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT
(KatipContextT IO) (Gauge -> Gauge -> Gauge -> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_swap_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
(KatipContextT IO) (Gauge -> Gauge -> Gauge -> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT (KatipContextT IO) (Gauge -> Gauge -> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_total_swap_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 (KatipContextT IO) (Gauge -> Gauge -> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT (KatipContextT IO) (Gauge -> VmStatGauges)
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_used_swap_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 (KatipContextT IO) (Gauge -> VmStatGauges)
-> RegistryT (KatipContextT IO) Gauge
-> RegistryT (KatipContextT IO) VmStatGauges
forall a b.
RegistryT (KatipContextT IO) (a -> b)
-> RegistryT (KatipContextT IO) a -> RegistryT (KatipContextT IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Labels -> RegistryT (KatipContextT IO) Gauge
forall (m :: * -> *).
MonadIO m =>
Name -> Labels -> RegistryT m Gauge
P.registerGauge Name
"vmstat_free_swap_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 -> Ridley RidleyMetricHandler
forall a. a -> RidleyT (RegistryT (KatipContextT IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RidleyMetricHandler -> Ridley RidleyMetricHandler)
-> RidleyMetricHandler -> Ridley RidleyMetricHandler
forall a b. (a -> b) -> a -> b
$ Text
-> VmStatGauges
-> (VmStatGauges -> Bool -> IO ())
-> Bool
-> RidleyMetricHandler
forall c.
HasCallStack =>
Text -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler Text
"ridley-virtual-memory-statistics" VmStatGauges
gauges VmStatGauges -> Bool -> IO ()
updateVmStat Bool
False