Add Metrics module: pure rrdtool argv builders for ekg samples

2026-09-07 21:30:42 +03:00
parent 055c02d0f2
commit 88af6a3139
5 changed files with 192 additions and 7 deletions
@@ -0,0 +1,98 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module MetricsSpec (spec) where
+
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HM
+import Data.Int (Int64)
+import Data.Text (Text)
+import HomeAssistant.Runtime.Metrics
+  ( DsType (..)
+  , DsSpec (..)
+  , dsTypeOf
+  , sanitizeName
+  , buildSchema
+  , buildCreateArgs
+  , buildUpdateArgs
+  )
+import qualified System.Metrics as M (Value (..))
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "dsTypeOf" $ do
+    it "maps Counter to Derive" $
+      dsTypeOf (M.Counter 1000) `shouldBe` Just Derive
+
+    it "maps Gauge to Gauge" $
+      dsTypeOf (M.Gauge 500) `shouldBe` Just Gauge
+
+    it "maps Label to Nothing" $
+      dsTypeOf (M.Label "hello") `shouldBe` Nothing
+
+  describe "sanitizeName" $ do
+    it "replaces dots with underscores" $
+      sanitizeName ("rts.gc.bytes_allocated" :: Text) `shouldBe` "rts_gc_bytes_allocated"
+
+  describe "buildSchema" $ do
+    it "builds sorted DsSpecs from counters and gauges, skipping labels" $
+      let sample :: HashMap Text M.Value
+          sample = HM.fromList
+            [ ("rts.gc.bytes_allocated", M.Counter 1000)
+            , ("rts.gc.max_bytes_used", M.Gauge 500)
+            , ("rts.gc.label_thing", M.Label "irrelevant")
+            ]
+      in buildSchema sample `shouldBe`
+           [ DsSpec "rts.gc.bytes_allocated" "rts_gc_bytes_allocated" Derive
+           , DsSpec "rts.gc.max_bytes_used" "rts_gc_max_bytes_used" Gauge
+           ]
+
+  describe "buildCreateArgs" $ do
+    it "builds create argv with mixed DERIVE and GAUGE DSes and RRAs" $
+      buildCreateArgs "test.rrd" 10
+        [ ("ds1", Derive)
+        , ("ds2", Gauge)
+        ]
+        `shouldBe`
+          [ "create"
+          , "test.rrd"
+          , "--step"
+          , "10"
+          , "DS:ds1:DERIVE:20:0:U"
+          , "DS:ds2:GAUGE:20:0:U"
+          , "RRA:AVERAGE:0.5:1:6000"
+          , "RRA:MAX:0.5:1:6000"
+          , "RRA:AVERAGE:0.5:360:1680"
+          , "RRA:MAX:0.5:360:1680"
+          ]
+
+  describe "buildUpdateArgs" $ do
+    it "builds update argv with numeric values" $
+      buildUpdateArgs "test.rrd" ["ds1", "ds2"] [Just 100, Just 200]
+        `shouldBe`
+          [ "update"
+          , "test.rrd"
+          , "--template"
+          , "ds1:ds2"
+          , "N:100:200"
+          ]
+
+    it "renders Nothing as U (unknown)" $
+      buildUpdateArgs "test.rrd" ["ds1", "ds2"] [Just 100, Nothing]
+        `shouldBe`
+          [ "update"
+          , "test.rrd"
+          , "--template"
+          , "ds1:ds2"
+          , "N:100:U"
+          ]
+
+    it "renders all-Nothing as all-U" $
+      buildUpdateArgs "test.rrd" ["ds1"] [Nothing]
+        `shouldBe`
+          [ "update"
+          , "test.rrd"
+          , "--template"
+          , "ds1"
+          , "N:U"
+          ]