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
|
, readProcessBytes
|
||||||
, Graph(..)
|
, Graph(..)
|
||||||
, renderGraph
|
, renderGraph
|
||||||
|
, rangeSuffix
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception (evaluate)
|
import Control.Exception (evaluate)
|
||||||
|
|||||||
+5
-1
@@ -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)
|
||||||
|
|||||||
Reference in new issue
Block a user