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|
{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
| Widget |
Annotation |
Candidate |
Decision |
{forEach widgets (renderCoverageRow allAnnotations allCandidates allRequirements allDecisions)}
|]
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|
|]
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|
| Title |
Outcome |
Source Widget |
Decided At |
{forEach decisions (renderDecisionRow reqs candidates ws)}
|]
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"