Statistics page #7

Merged
MasseR merged 5 commits from statistics-page into main 2026-10-12 16:06:16 +03:00
2 changed files with 6 additions and 1 deletions
Showing only changes of commit 3a6fe26d0c - Show all commits

No files matched your search

+1
View File
@@ -13,6 +13,7 @@ module HomeAssistant.Runtime.Graphing
, readProcessBytes , readProcessBytes
, Graph(..) , Graph(..)
, renderGraph , renderGraph
, rangeSuffix
) where ) where
import Control.Exception (evaluate) import Control.Exception (evaluate)
+5 -1
View File
@@ -22,7 +22,7 @@ import Control.Exception.Annotated (checkpoint, Annotation (Annotation))
import Servant.Server.Generic (genericServeT) import Servant.Server.Generic (genericServeT)
import Network.Wai (Application) import Network.Wai (Application)
import Network.HTTP.Media ((//)) 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 Katip (KatipContextT, Katip, runKatipContextT, LogEnv, KatipContext, ls, Severity (..), logFM, katipAddContext, sl)
import Data.Aeson (ToJSON (toJSON), FromJSON, object, (.=)) import Data.Aeson (ToJSON (toJSON), FromJSON, object, (.=))
import Lucid (ToHtml, toHtml, renderBS, toHtmlRaw, HtmlT, Attributes) import Lucid (ToHtml, toHtml, renderBS, toHtmlRaw, HtmlT, Attributes)
@@ -163,6 +163,9 @@ server rrdPath rrdtool flags = API
getStatsHandler :: Maybe Range -> LoggingHandler StatsPage getStatsHandler :: Maybe Range -> LoggingHandler StatsPage
getStatsHandler r = pure $ StatsPage $ do 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.h2_ "Traffic"
H5.img_ [H5.src_ (src Traffic)] H5.img_ [H5.src_ (src Traffic)]
H5.h2_ "Memory" H5.h2_ "Memory"
@@ -171,6 +174,7 @@ getStatsHandler r = pure $ StatsPage $ do
H5.img_ [H5.src_ (src RateLimit)] H5.img_ [H5.src_ (src RateLimit)]
where where
src m = "/" <> toUrlPiece (fieldLink getMetrics m r) src m = "/" <> toUrlPiece (fieldLink getMetrics m r)
flagWithRange range = "/" <> toUrlPiece (fieldLink getStats (Just range))
servantApp :: LogEnv -> FilePath -> FilePath -> Flags -> Application servantApp :: LogEnv -> FilePath -> FilePath -> Flags -> Application
servantApp le rrdPath rrdtool flags = genericServeT (toHandler le) (server rrdPath rrdtool flags) servantApp le rrdPath rrdtool flags = genericServeT (toHandler le) (server rrdPath rrdtool flags)