inter-hub-haskell/Web/View/Hubs/OperationalReviewBoard.hs

180 lines
8.2 KiB
Haskell
Raw Normal View History

module Web.View.Hubs.OperationalReviewBoard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
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|
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Operational Review Board</h1>
</div>
<!-- Panel 1: Hub health matrix -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Hub Health Matrix</h2>
{if null hubs
then [hsx|<p class="text-sm text-gray-400">No hubs registered.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Hub</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Health</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Snapshot</th>
<th class="px-3 py-2"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach hubs renderHubRow}
</tbody>
</table>
|]}
</div>
<!-- Panel 2: Top friction widgets -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Top Friction Widgets</h2>
{if null topFrictionScores
then [hsx|<p class="text-sm text-gray-400">No friction scores computed yet.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Widget</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Score</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Type</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach (zip topFrictionScores topWidgets) renderFrictionRow}
</tbody>
</table>
|]}
</div>
<!-- Panel 3: Active bottlenecks by stage -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Active Bottlenecks by Stage</h2>
{if null bottlenecks
then [hsx|<p class="text-sm text-gray-400">No active bottlenecks.</p>|]
else [hsx|
<div class="grid grid-cols-4 gap-3">
{forEach stages renderBottleneckStage}
</div>
|]}
</div>
<!-- Panel 4: Open cross-hub propagations -->
<div class="bg-white rounded-lg border border-gray-200 p-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Open Cross-Hub Propagations</h2>
{if null openPropagations
then [hsx|<p class="text-sm text-gray-400">No open propagation events.</p>|]
else [hsx|
<div class="space-y-2">
{forEach openPropagations renderPropagationRow}
</div>
|]}
</div>
|]
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|
<tr class="hover:bg-gray-50">
<td class="px-3 py-2">
<a href={ShowHubAction { hubId = h.id }}
class="text-indigo-600 hover:underline">{h.name}</a>
</td>
<td class="px-3 py-2">
{case mSnap of
Nothing -> [hsx|<span class="text-xs text-gray-400"></span>|]
Just s -> [hsx|
<span class={"px-2 py-0.5 rounded text-xs font-semibold " <> healthScoreBadge s.healthScore}>
{show s.healthScore}
</span>
|]}
</td>
<td class="px-3 py-2 text-xs text-gray-400">
{maybe "never" (\s -> show s.computedAt) mSnap}
</td>
<td class="px-3 py-2 text-right">
<a href={HubHealthHistoryAction { hubId = h.id }}
class="text-xs text-indigo-600 hover:underline">History</a>
</td>
</tr>
|]
renderFrictionRow :: (FrictionScore, Widget) -> Html
renderFrictionRow (fs, w) = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-3 py-2">
<a href={ShowWidgetAction { widgetId = w.id }}
class="text-indigo-600 hover:underline">{w.name}</a>
</td>
<td class="px-3 py-2">
<span class={"px-2 py-0.5 rounded text-xs font-semibold " <> scoreBand fs.score}>
{show fs.score}
</span>
</td>
<td class="px-3 py-2 text-gray-500 text-xs">{w.widgetType}</td>
</tr>
|]
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"
in [hsx|
<div class={"rounded-lg p-4 text-center " <> colourCls}>
<div class="text-2xl font-bold">{show cnt}</div>
<div class="text-xs mt-1">{stageLabel stage}</div>
</div>
|]
renderPropagationRow :: CrossHubPropagation -> Html
renderPropagationRow p = [hsx|
<div class="flex items-start justify-between p-3 bg-gray-50 rounded border border-gray-200">
<div>
<span class="text-xs bg-purple-100 text-purple-700 px-1.5 py-0.5 rounded mr-2">{p.patternType}</span>
<span class="text-sm text-gray-700">{p.summary}</span>
<p class="text-xs text-gray-400 mt-0.5">{show p.detectedAt}</p>
</div>
<div class="flex gap-2 ml-4">
<a href={AcknowledgePropagationAction { crossHubPropagationId = p.id }}
class="text-xs text-yellow-600 hover:underline whitespace-nowrap">Acknowledge</a>
<a href={ResolvePropagationAction { crossHubPropagationId = p.id }}
class="text-xs text-green-600 hover:underline">Resolve</a>
</div>
</div>
|]