generated from coulomb/repo-seed
Fix compilation errors across 6 controllers and 29 views: import cleanup, ResponseException pattern for API auth, type fixes, unused import removal. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
242 lines
11 KiB
Haskell
242 lines
11 KiB
Haskell
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|
|
|
<div class="mb-6 flex items-center justify-between">
|
|
<div>
|
|
<div class="flex items-center gap-2 text-sm text-gray-500 mb-1">
|
|
<a href={HubsAction} class="hover:text-gray-700">Hubs</a>
|
|
<span>/</span>
|
|
<a href={ShowHubAction (hub.id)} class="hover:text-gray-700">{hub.name}</a>
|
|
<span>/</span>
|
|
<span>Governance</span>
|
|
</div>
|
|
<h1 class="text-2xl font-semibold">Governance Dashboard — {hub.name}</h1>
|
|
</div>
|
|
<div class="flex gap-2">
|
|
<a href={TriageDashboardAction (hub.id)}
|
|
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
|
|
Triage Dashboard
|
|
</a>
|
|
<a href={AntifragilityDashboardAction (hub.id)}
|
|
class="text-sm border border-green-300 text-green-700 px-3 py-1.5 rounded hover:bg-green-50">
|
|
Antifragility
|
|
</a>
|
|
<a href={ShowHubAction (hub.id)}
|
|
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
|
|
Hub Overview
|
|
</a>
|
|
</div>
|
|
</div>
|
|
|
|
<!-- KPI row: decision outcomes + regression -->
|
|
<div class="grid grid-cols-3 gap-4 mb-4 sm:grid-cols-7">
|
|
{forEach outcomeList (\o -> renderKpiCard o (countOutcome allDecisions o))}
|
|
<div class="bg-red-50 text-red-800 rounded-lg px-4 py-3 text-center">
|
|
<div class="text-2xl font-bold">{show (length regressionWidgetIds)}</div>
|
|
<div class="text-xs mt-0.5 opacity-75">regressions</div>
|
|
</div>
|
|
</div>
|
|
|
|
{if null regressionWidgetIds then mempty else renderGovRegressionAlerts regressedWidgets}
|
|
|
|
<!-- Open requirements awaiting decision -->
|
|
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-6">
|
|
<h2 class="text-sm font-semibold text-gray-700 mb-3">
|
|
Open Requirements Awaiting Decision
|
|
<span class="ml-2 text-xs font-normal text-gray-400">
|
|
({show (length awaitingDecision)} pending)
|
|
</span>
|
|
</h2>
|
|
{renderAwaitingSection awaitingDecision}
|
|
</div>
|
|
|
|
<!-- Recent decisions -->
|
|
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-6">
|
|
<h2 class="text-sm font-semibold text-gray-700 mb-3">Recent Decisions</h2>
|
|
{renderRecentDecisionsSection recentDecisions allRequirements allCandidates widgets}
|
|
</div>
|
|
|
|
<!-- Traceability coverage per widget -->
|
|
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5">
|
|
<h2 class="text-sm font-semibold text-gray-700 mb-3">Traceability Coverage</h2>
|
|
<table class="w-full text-sm">
|
|
<thead class="border-b border-gray-100">
|
|
<tr>
|
|
<th class="text-left py-2 text-xs font-medium text-gray-500">Widget</th>
|
|
<th class="text-center py-2 text-xs font-medium text-gray-500">Annotation</th>
|
|
<th class="text-center py-2 text-xs font-medium text-gray-500">Candidate</th>
|
|
<th class="text-center py-2 text-xs font-medium text-gray-500">Decision</th>
|
|
</tr>
|
|
</thead>
|
|
<tbody class="divide-y divide-gray-50">
|
|
{forEach widgets (renderCoverageRow allAnnotations allCandidates allRequirements allDecisions)}
|
|
</tbody>
|
|
</table>
|
|
</div>
|
|
|]
|
|
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|
|
|
<div class={kpiCardClass outcome <> " rounded-lg px-4 py-3 text-center"}>
|
|
<div class="text-2xl font-bold">{show count}</div>
|
|
<div class="text-xs mt-0.5 opacity-75">{outcome}</div>
|
|
</div>
|
|
|]
|
|
|
|
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|
|
|
<div class="flex items-center justify-between py-2 border-b border-gray-50 last:border-0">
|
|
<a href={ShowRequirementAction (req.id)}
|
|
class="text-sm text-indigo-600 hover:text-indigo-800">{req.title}</a>
|
|
<span class="text-xs text-gray-400">{show req.createdAt}</span>
|
|
</div>
|
|
|]
|
|
|
|
renderDecisionRow :: [Requirement] -> [RequirementCandidate] -> [Widget] -> DecisionRecord -> Html
|
|
renderDecisionRow reqs candidates widgets dr = [hsx|
|
|
<tr>
|
|
<td class="py-2 pr-4">
|
|
<a href={ShowDecisionRecordAction (dr.id)}
|
|
class="text-indigo-600 hover:text-indigo-800">{dr.title}</a>
|
|
</td>
|
|
<td class="py-2 pr-4">
|
|
<span class={outcomeClass dr.outcome <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
|
{dr.outcome}
|
|
</span>
|
|
</td>
|
|
<td class="py-2 pr-4 text-gray-600 text-xs">
|
|
{originWidget dr reqs candidates widgets}
|
|
</td>
|
|
<td class="py-2 text-gray-400 text-xs">{show dr.decidedAt}</td>
|
|
</tr>
|
|
|]
|
|
|
|
-- 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|
|
|
<tr>
|
|
<td class="py-2 pr-4 text-sm text-gray-700">{w.name}</td>
|
|
<td class="py-2 text-center">{coverageMark hasAnnotation}</td>
|
|
<td class="py-2 text-center">{coverageMark hasCandidate}</td>
|
|
<td class="py-2 text-center">{coverageMark hasDecision}</td>
|
|
</tr>
|
|
|]
|
|
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|
|
|
<a href={ShowWidgetAction (w.id)}
|
|
class="text-xs bg-red-100 text-red-800 border border-red-300 rounded px-2 py-1 hover:bg-red-200">
|
|
{w.name}
|
|
</a>
|
|
|]
|
|
|
|
coverageMark :: Bool -> Html
|
|
coverageMark True = [hsx|<span class="text-green-600 font-bold">✓</span>|]
|
|
coverageMark False = [hsx|<span class="text-gray-300">✗</span>|]
|
|
|
|
renderGovRegressionAlerts :: [Widget] -> Html
|
|
renderGovRegressionAlerts ws = [hsx|
|
|
<div class="bg-red-50 border border-red-200 rounded-lg px-6 py-4 mb-6">
|
|
<h2 class="text-sm font-semibold text-red-700 mb-3">Regression Alerts</h2>
|
|
<div class="flex flex-wrap gap-2">
|
|
{forEach ws renderRegressedBadge}
|
|
</div>
|
|
</div>
|
|
|]
|
|
|
|
renderAwaitingSection :: [Requirement] -> Html
|
|
renderAwaitingSection [] = [hsx|<p class="text-sm text-gray-400">All requirements have linked decisions.</p>|]
|
|
renderAwaitingSection reqs = [hsx|{forEach reqs renderAwaitingReq}|]
|
|
|
|
renderRecentDecisionsSection :: [DecisionRecord] -> [Requirement] -> [RequirementCandidate] -> [Widget] -> Html
|
|
renderRecentDecisionsSection [] _ _ _ = [hsx|<p class="text-sm text-gray-400">No decisions recorded yet.</p>|]
|
|
renderRecentDecisionsSection decisions reqs candidates ws = [hsx|
|
|
<table class="w-full text-sm">
|
|
<thead class="border-b border-gray-100">
|
|
<tr>
|
|
<th class="text-left py-2 text-xs font-medium text-gray-500">Title</th>
|
|
<th class="text-left py-2 text-xs font-medium text-gray-500">Outcome</th>
|
|
<th class="text-left py-2 text-xs font-medium text-gray-500">Source Widget</th>
|
|
<th class="text-left py-2 text-xs font-medium text-gray-500">Decided At</th>
|
|
</tr>
|
|
</thead>
|
|
<tbody class="divide-y divide-gray-50">
|
|
{forEach decisions (renderDecisionRow reqs candidates ws)}
|
|
</tbody>
|
|
</table>
|
|
|]
|
|
|
|
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"
|