Add metricsAction: supervised loop sampling ekg store to rrd via rrdtool

src/HomeAssistant/Runtime/Metrics.hs

@@ -8,15 +8,23 @@ module HomeAssistant.Runtime.Metrics
   , buildSchema
   , buildCreateArgs
   , buildUpdateArgs
+  , ensureRrd
+  , sampleAndUpdate
+  , metricsAction
   ) where
 
+import Control.Concurrent (threadDelay)
+import Control.Monad (forever, unless)
 import Data.Int (Int64)
 import Data.List (intercalate, sortBy)
 import Data.Ord (comparing)
 import Data.Text (Text)
+import Data.Void (Void)
 import qualified Data.Text as T
 import qualified Data.HashMap.Strict as HM
-import qualified System.Metrics as M (Value (..), Sample)
+import qualified System.Metrics as M (Value (..), Sample, Store, sampleAll)
+import System.Directory (doesFileExist)
+import System.Process (callProcess)
 
 data DsType = Derive | Gauge
   deriving (Eq, Show)
@@ -70,3 +78,32 @@ buildUpdateArgs path names values =
   where
     renderValue Nothing  = "U"
     renderValue (Just n) = show n
+
+lookupValue :: M.Sample -> Text -> Maybe Int64
+lookupValue sample name = case HM.lookup name sample of
+  Just (M.Counter n) -> Just n
+  Just (M.Gauge n)   -> Just n
+  _                  -> Nothing
+
+ensureRrd :: FilePath -> FilePath -> [DsSpec] -> IO ()
+ensureRrd rrdtool rrdPath schema = do
+  exists <- doesFileExist rrdPath
+  unless exists $
+    callProcess rrdtool (buildCreateArgs rrdPath 10 (map toPair schema))
+  where
+    toPair s = (dsName s, dsType s)
+
+sampleAndUpdate :: M.Store -> FilePath -> FilePath -> [DsSpec] -> IO ()
+sampleAndUpdate store rrdtool rrdPath schema = do
+  sample <- M.sampleAll store
+  let names = map dsName schema
+      values = map (lookupValue sample . dsEkgName) schema
+  callProcess rrdtool (buildUpdateArgs rrdPath names values)
+
+metricsAction :: M.Store -> FilePath -> FilePath -> IO Void
+metricsAction store rrdPath rrdtool = do
+  schema <- buildSchema <$> M.sampleAll store
+  ensureRrd rrdtool rrdPath schema
+  forever $ do
+    sampleAndUpdate store rrdtool rrdPath schema
+    threadDelay 10000000