module Web.View.Hubs.OperationalReviewBoard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.HubHealth (healthScoreBadge)
import Application.Helper.FrictionScore (scoreBand)
import Web.View.Hubs.BottleneckDashboard (severityBadge)
data OperationalReviewBoardView = OperationalReviewBoardView
{ hubs :: ![Hub]
, allSnapshots :: ![HubHealthSnapshot]
, topFrictionScores :: ![FrictionScore]
, topWidgets :: ![Widget]
, bottlenecks :: ![BottleneckRecord]
, openPropagations :: ![CrossHubPropagation]
}
instance View OperationalReviewBoardView where
html OperationalReviewBoardView { .. } = [hsx|
Operational Review Board
Hub Health Matrix
{renderHubHealthTable hubs}
Top Friction Widgets
{renderFrictionTable topFrictionScores topWidgets}
Active Bottlenecks by Stage
{renderBottlenecksPanel bottlenecks}
Open Cross-Hub Propagations
{renderPropagationsPanel openPropagations}
|]
where
stages = ["candidate", "requirement", "decision", "observation"] :: [Text]
stageLabel s = case s of
"candidate" -> "Candidate"
"requirement" -> "Requirement"
"decision" -> "Decision"
"observation" -> "Observation"
_ -> s
latestSnapshotFor hub =
find (\s -> s.hubId == hub.id) allSnapshots
renderHubRow :: Hub -> Html
renderHubRow h =
let mSnap = latestSnapshotFor h
in [hsx|
|
{h.name}
|
{renderHealthScore mSnap}
|
{maybe "never" (\s -> show s.computedAt) mSnap}
|
History
|
|]
renderFrictionRow :: (FrictionScore, Widget) -> Html
renderFrictionRow (fs, w) = [hsx|
|
{w.name}
|
scoreBand fs.score}>
{show fs.score}
|
{w.widgetType} |
|]
renderBottleneckStage :: Text -> Html
renderBottleneckStage stage =
let stageBNs = filter (\b -> b.stage == stage) bottlenecks
cnt = length stageBNs
hasCrit = any (\b -> b.severity == "critical") stageBNs
colourCls = (if cnt == 0 then "bg-gray-50 text-gray-400"
else if hasCrit then "bg-red-50 text-red-700"
else "bg-orange-50 text-orange-700") :: Text
in [hsx|
colourCls}>
{show cnt}
{stageLabel stage}
|]
renderPropagationRow :: CrossHubPropagation -> Html
renderPropagationRow p = [hsx|
{p.patternType}
{p.summary}
{show p.detectedAt}
|]
renderHubHealthTable :: [Hub] -> Html
renderHubHealthTable [] = [hsx|No hubs registered.
|]
renderHubHealthTable hs = [hsx|
| Hub |
Health |
Snapshot |
|
{forEach hs renderHubRow}
|]
renderFrictionTable :: [FrictionScore] -> [Widget] -> Html
renderFrictionTable [] _ = [hsx|No friction scores computed yet.
|]
renderFrictionTable scores ws = [hsx|
| Widget |
Score |
Type |
{forEach (zip scores ws) renderFrictionRow}
|]
renderBottlenecksPanel :: [BottleneckRecord] -> Html
renderBottlenecksPanel [] = [hsx|No active bottlenecks.
|]
renderBottlenecksPanel _ = [hsx|
{forEach stages renderBottleneckStage}
|]
renderPropagationsPanel :: [CrossHubPropagation] -> Html
renderPropagationsPanel [] = [hsx|No open propagation events.
|]
renderPropagationsPanel ps = [hsx|
{forEach ps renderPropagationRow}
|]
renderHealthScore :: Maybe HubHealthSnapshot -> Html
renderHealthScore Nothing = [hsx|–|]
renderHealthScore (Just s) = [hsx|
healthScoreBadge s.healthScore}>
{show s.healthScore}
|]