Add Metrics module: pure rrdtool argv builders for ekg samples

src/HomeAssistant/Runtime/Metrics.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module HomeAssistant.Runtime.Metrics
+  ( DsType (..)
+  , DsSpec (..)
+  , dsTypeOf
+  , sanitizeName
+  , buildSchema
+  , buildCreateArgs
+  , buildUpdateArgs
+  ) where
+
+import Data.Int (Int64)
+import Data.List (intercalate, sortBy)
+import Data.Ord (comparing)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as HM
+import qualified System.Metrics as M (Value (..), Sample)
+
+data DsType = Derive | Gauge
+  deriving (Eq, Show)
+
+data DsSpec = DsSpec
+  { dsEkgName :: Text
+  , dsName    :: String
+  , dsType    :: DsType
+  }
+  deriving (Eq, Show)
+
+dsTypeOf :: M.Value -> Maybe DsType
+dsTypeOf (M.Counter _) = Just Derive
+dsTypeOf (M.Gauge _)   = Just Gauge
+dsTypeOf _             = Nothing
+
+sanitizeName :: Text -> String
+sanitizeName = T.unpack . T.replace "." "_"
+
+buildSchema :: M.Sample -> [DsSpec]
+buildSchema sample =
+  sortBy (comparing dsName)
+    [ DsSpec ekgName (sanitizeName ekgName) dt
+    | (ekgName, val) <- HM.toList sample
+    , Just dt <- [dsTypeOf val]
+    ]
+
+buildCreateArgs :: FilePath -> Int -> [(String, DsType)] -> [String]
+buildCreateArgs path step specs =
+  ["create", path, "--step", show step]
+  ++ concatMap dsArg specs
+  ++ rras
+  where
+    dsArg (name, Derive) = ["DS:" ++ name ++ ":DERIVE:20:0:U"]
+    dsArg (name, Gauge)  = ["DS:" ++ name ++ ":GAUGE:20:0:U"]
+    rras =
+      [ "RRA:AVERAGE:0.5:1:6000"
+      , "RRA:MAX:0.5:1:6000"
+      , "RRA:AVERAGE:0.5:360:1680"
+      , "RRA:MAX:0.5:360:1680"
+      ]
+
+buildUpdateArgs :: FilePath -> [String] -> [Maybe Int64] -> [String]
+buildUpdateArgs path names values =
+  [ "update"
+  , path
+  , "--template"
+  , intercalate ":" names
+  , "N:" ++ intercalate ":" (map renderValue values)
+  ]
+  where
+    renderValue Nothing  = "U"
+    renderValue (Just n) = show n