List of ranges
This commit is contained in:
1 parent
45277e02da
commit
3a6fe26d0c
2 files changed
+6
-1
No files matched your search
@@ -13,6 +13,7 @@ module HomeAssistant.Runtime.Graphing
|
||||
, readProcessBytes
|
||||
, Graph(..)
|
||||
, renderGraph
|
||||
, rangeSuffix
|
||||
) where
|
||||
|
||||
import Control.Exception (evaluate)
|
||||
|
||||
+5
-1
@@ -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)
|
||||
|
||||
Reference in new issue
Block a user