module Web.View.Hubs.GovernanceDashboard where import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude import Web.Routes () data GovernanceDashboardView = GovernanceDashboardView { hub :: !Hub , widgets :: ![Widget] , allCandidates :: ![RequirementCandidate] , allRequirements :: ![Requirement] , recentDecisions :: ![DecisionRecord] , allDecisions :: ![DecisionRecord] , allAnnotations :: ![Annotation] , regressionWidgetIds :: ![Id Widget] } instance View GovernanceDashboardView where html GovernanceDashboardView { .. } = [hsx|
Hubs / {hub.name} / Governance

Governance Dashboard — {hub.name}

Triage Dashboard Antifragility Hub Overview
{forEach outcomeList (\o -> renderKpiCard o (countOutcome allDecisions o))}
{show (length regressionWidgetIds)}
regressions
{if null regressionWidgetIds then mempty else renderGovRegressionAlerts regressedWidgets}

Open Requirements Awaiting Decision ({show (length awaitingDecision)} pending)

{renderAwaitingSection awaitingDecision}

Recent Decisions

{renderRecentDecisionsSection recentDecisions allRequirements allCandidates widgets}

Traceability Coverage

{forEach widgets (renderCoverageRow allAnnotations allCandidates allRequirements allDecisions)}
Widget Annotation Candidate Decision
|] where awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets outcomeList :: [Text] outcomeList = ["accepted", "rejected", "deferred", "split", "merged", "reframed"] countOutcome :: [DecisionRecord] -> Text -> Int countOutcome decisions o = length (filter (\d -> d.outcome == o) decisions) renderKpiCard :: Text -> Int -> Html renderKpiCard outcome count = [hsx|
" rounded-lg px-4 py-3 text-center"}>
{show count}
{outcome}
|] kpiCardClass :: Text -> Text kpiCardClass "accepted" = "bg-green-50 text-green-800" kpiCardClass "rejected" = "bg-red-50 text-red-800" kpiCardClass "deferred" = "bg-gray-50 text-gray-700" kpiCardClass "split" = "bg-purple-50 text-purple-800" kpiCardClass "merged" = "bg-indigo-50 text-indigo-800" kpiCardClass "reframed" = "bg-orange-50 text-orange-800" kpiCardClass _ = "bg-gray-50 text-gray-700" isAwaitingDecision :: [DecisionRecord] -> Requirement -> Bool isAwaitingDecision decisions req = not (any (\d -> d.requirementId == Just req.id) decisions) renderAwaitingReq :: Requirement -> Html renderAwaitingReq req = [hsx|
{req.title} {show req.createdAt}
|] renderDecisionRow :: [Requirement] -> [RequirementCandidate] -> [Widget] -> DecisionRecord -> Html renderDecisionRow reqs candidates widgets dr = [hsx| {dr.title} " text-xs px-2 py-0.5 rounded font-medium"}> {dr.outcome} {originWidget dr reqs candidates widgets} {show dr.decidedAt} |] -- Trace decision → requirement → candidate → widget name originWidget :: DecisionRecord -> [Requirement] -> [RequirementCandidate] -> [Widget] -> Text originWidget dr reqs candidates widgets = case dr.requirementId >>= \rid -> find (\r -> r.id == rid) reqs of Just req -> case find (\c -> c.id == req.sourceCandidateId) candidates of Just c -> case find (\w -> w.id == c.sourceWidgetId) widgets of Just w -> w.name Nothing -> "—" Nothing -> "—" Nothing -> case dr.candidateId >>= \cid -> find (\c -> c.id == cid) candidates of Just c -> case find (\w -> w.id == c.sourceWidgetId) widgets of Just w -> w.name Nothing -> "—" Nothing -> "—" renderCoverageRow :: [Annotation] -> [RequirementCandidate] -> [Requirement] -> [DecisionRecord] -> Widget -> Html renderCoverageRow annotations candidates requirements decisions w = [hsx| {w.name} {coverageMark hasAnnotation} {coverageMark hasCandidate} {coverageMark hasDecision} |] where hasAnnotation = any (\a -> a.widgetId == w.id) annotations widgetCandidates = filter (\c -> c.sourceWidgetId == w.id) candidates hasCandidate = not (null widgetCandidates) candidateIds = map (.id) widgetCandidates widgetReqIds = map (.id) (filter (\r -> r.sourceCandidateId `elem` candidateIds) requirements) hasDecision = any (\d -> d.requirementId `elem` map Just widgetReqIds) decisions renderRegressedBadge :: Widget -> Html renderRegressedBadge w = [hsx| {w.name} |] coverageMark :: Bool -> Html coverageMark True = [hsx||] coverageMark False = [hsx||] renderGovRegressionAlerts :: [Widget] -> Html renderGovRegressionAlerts ws = [hsx|

Regression Alerts

{forEach ws renderRegressedBadge}
|] renderAwaitingSection :: [Requirement] -> Html renderAwaitingSection [] = [hsx|

All requirements have linked decisions.

|] renderAwaitingSection reqs = [hsx|{forEach reqs renderAwaitingReq}|] renderRecentDecisionsSection :: [DecisionRecord] -> [Requirement] -> [RequirementCandidate] -> [Widget] -> Html renderRecentDecisionsSection [] _ _ _ = [hsx|

No decisions recorded yet.

|] renderRecentDecisionsSection decisions reqs candidates ws = [hsx| {forEach decisions (renderDecisionRow reqs candidates ws)}
Title Outcome Source Widget Decided At
|] outcomeClass :: Text -> Text outcomeClass "accepted" = "bg-green-100 text-green-800" outcomeClass "rejected" = "bg-red-100 text-red-800" outcomeClass "deferred" = "bg-gray-100 text-gray-600" outcomeClass "split" = "bg-purple-100 text-purple-800" outcomeClass "merged" = "bg-indigo-100 text-indigo-800" outcomeClass "reframed" = "bg-orange-100 text-orange-800" outcomeClass _ = "bg-gray-100 text-gray-600"