graphing: add pure graph table, ranges, and argv builders

src/HomeAssistant/Runtime/Graphing.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module HomeAssistant.Runtime.Graphing
+  ( Range (..)
+  , parseRange
+  , rangeStart
+  , Series (..)
+  , GraphSpec (..)
+  , graphs
+  , lookupGraph
+  , parseNameParam
+  , buildGraphArgs
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+data Range = TenMinutes | OneHour | OneDay | OneWeek | OneMonth
+  deriving (Eq, Show, Bounded, Enum)
+
+rangeSuffix :: Range -> String
+rangeSuffix TenMinutes = "10m"
+rangeSuffix OneHour     = "1h"
+rangeSuffix OneDay      = "24h"
+rangeSuffix OneWeek     = "7d"
+rangeSuffix OneMonth    = "30d"
+
+parseRange :: Text -> Maybe Range
+parseRange t = lookup t [(T.pack (rangeSuffix r), r) | r <- [minBound .. maxBound]]
+
+rangeStart :: Range -> String
+rangeStart r = "end-" ++ rangeSuffix r
+
+data Series = Series
+  { serDs    :: String
+  , serAlias :: String
+  , serColor :: String
+  , serLabel :: String
+  }
+  deriving (Eq, Show)
+
+data GraphSpec = GraphSpec
+  { gsName   :: Text
+  , gsTitle  :: String
+  , gsSeries :: [Series]
+  }
+  deriving (Eq, Show)
+
+graphs :: [GraphSpec]
+graphs =
+  [ GraphSpec
+      "traffic"
+      "Hass triggers in / services out"
+      [ Series "hass_trigger_in" "trig" "#0066cc" "triggers in/min"
+      , Series "hass_service_out" "svc" "#cc0000" "services out/min"
+      ]
+  ]
+
+lookupGraph :: [GraphSpec] -> Text -> Maybe GraphSpec
+lookupGraph specs name = case [g | g <- specs, gsName g == name] of
+  (g : _) -> Just g
+  []      -> Nothing
+
+parseNameParam :: [GraphSpec] -> Text -> Maybe GraphSpec
+parseNameParam specs t = T.stripSuffix ".png" t >>= lookupGraph specs
+
+buildGraphArgs :: FilePath -> GraphSpec -> Range -> [String]
+buildGraphArgs rrdPath spec range =
+  [ "graph"
+  , "-"
+  , "--start", rangeStart range
+  , "--title", gsTitle spec
+  , "--width", "800"
+  , "--height", "250"
+  , "--imgformat", "PNG"
+  ]
+    ++ concatMap defArgs (gsSeries spec)
+    ++ map line (gsSeries spec)
+  where
+    defArgs (Series ds alias _ _) =
+      [ "DEF:" ++ alias ++ "=" ++ rrdPath ++ ":" ++ ds ++ ":AVERAGE"
+      , "CDEF:" ++ alias ++ "_min=" ++ alias ++ ",60,*"
+      ]
+    line (Series _ alias color label) =
+      "LINE2:" ++ alias ++ "_min" ++ color ++ ":" ++ label