From 3a6fe26d0c394f33e3980dfeba68d3da6e022c40 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Mon, 12 Oct 2026 15:17:07 +0300 Subject: [PATCH] List of ranges --- src/HomeAssistant/Runtime/Graphing.hs | 1 + src/HttpServer.hs | 6 +++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/HomeAssistant/Runtime/Graphing.hs b/src/HomeAssistant/Runtime/Graphing.hs index b34a95a..97e8281 100644 --- a/src/HomeAssistant/Runtime/Graphing.hs +++ b/src/HomeAssistant/Runtime/Graphing.hs @@ -13,6 +13,7 @@ module HomeAssistant.Runtime.Graphing , readProcessBytes , Graph(..) , renderGraph + , rangeSuffix ) where import Control.Exception (evaluate) diff --git a/src/HttpServer.hs b/src/HttpServer.hs index e01d656..36928a7 100644 --- a/src/HttpServer.hs +++ b/src/HttpServer.hs @@ -22,7 +22,7 @@ import Control.Exception.Annotated (checkpoint, Annotation (Annotation)) import Servant.Server.Generic (genericServeT) import Network.Wai (Application) import Network.HTTP.Media ((//)) -import HomeAssistant.Runtime.Graphing (Graph (..), Range (..), lookupGraph, graphs, renderGraph) +import HomeAssistant.Runtime.Graphing (Graph (..), Range (..), lookupGraph, graphs, renderGraph, rangeSuffix) import Katip (KatipContextT, Katip, runKatipContextT, LogEnv, KatipContext, ls, Severity (..), logFM, katipAddContext, sl) import Data.Aeson (ToJSON (toJSON), FromJSON, object, (.=)) import Lucid (ToHtml, toHtml, renderBS, toHtmlRaw, HtmlT, Attributes) @@ -163,6 +163,9 @@ server rrdPath rrdtool flags = API getStatsHandler :: Maybe Range -> LoggingHandler StatsPage getStatsHandler r = pure $ StatsPage $ do + H5.ul_ $ do + for_ [minBound..maxBound] $ \range -> + H5.li_ $ H5.a_ [H5.href_ $ flagWithRange range] $ toHtml $ rangeSuffix range H5.h2_ "Traffic" H5.img_ [H5.src_ (src Traffic)] H5.h2_ "Memory" @@ -171,6 +174,7 @@ getStatsHandler r = pure $ StatsPage $ do H5.img_ [H5.src_ (src RateLimit)] where src m = "/" <> toUrlPiece (fieldLink getMetrics m r) + flagWithRange range = "/" <> toUrlPiece (fieldLink getStats (Just range)) servantApp :: LogEnv -> FilePath -> FilePath -> Flags -> Application servantApp le rrdPath rrdtool flags = genericServeT (toHandler le) (server rrdPath rrdtool flags)