Files
inter-hub/Web/View/Hubs/OperationalReviewBoard.hs
Bernd Worsch f1978c3888 fix(WP-0014): pre-flight compilation fixes, Tailwind pipeline, and admin seed
A2 — Compilation fixes:
- Remove inline FK constraints from Schema.sql; IHP schema compiler cannot
  parse them. Add 1744329600-restore-fk-constraints.sql migration to restore
  referential integrity at the DB level.
- Rename `#label` → `#label_` throughout to avoid clash with Haskell built-in.
- Fix `hub.id == hid` UUID comparisons to use `toUUID hub.id`.
- Replace non-existent `setStatus`/`respondJson` calls with
  `renderJsonWithStatusCode` throughout Api controllers.
- Fix qualified package import for `cryptohash-sha256` in Auth.hs.
- Add `CanSelect (Text, Text)` instance in Helper.View.
- Refactor HSX inline lambdas to named helper functions in 100+ views
  (GHC cannot infer types for anonymous functions inside quasi-quoted HSX).
- Fix missing imports (IHP.QueryBuilder, IHP.Fetch, Web.Routes, Only, etc.)
  across helpers and controllers.
- Remove duplicate `diffUTCTime` definition in BottleneckDetector.
- Change `createEventForHub` return type from `IO ResponseReceived` to `IO ()`.
- Seed type-registry vocabulary via 1744502400-seed-type-registries.sql
  (moved from Schema.sql where IHP does not execute INSERT statements).

A3 — Tailwind build pipeline:
- Add `tailwindcss` to flake.nix native packages.
- Uncomment `tailwind.exec` process in devenv shell config.
- Add tailwind/tailwind.config.js (scans Web/View/**/*.hs).
- Add tailwind/app.css with @tailwind directives.

A4 — Admin user seed:
- Add 1744416000-seed-admin-user.sql: inserts admin@inter-hub.local
  with bcrypt-hashed password admin1234! (cost 10).
- Add .env.example documenting all required environment variables
  and default admin credentials.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-04 09:55:12 +00:00

191 lines
8.2 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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|
<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>
{renderHubHealthTable hubs}
</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>
{renderFrictionTable topFrictionScores topWidgets}
</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>
{renderBottlenecksPanel bottlenecks}
</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>
{renderPropagationsPanel openPropagations}
</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 (h.id)}
class="text-indigo-600 hover:underline">{h.name}</a>
</td>
<td class="px-3 py-2">
{renderHealthScore mSnap}
</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 (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 (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 (p.id)}
class="text-xs text-yellow-600 hover:underline whitespace-nowrap">Acknowledge</a>
<a href={ResolvePropagationAction (p.id)}
class="text-xs text-green-600 hover:underline">Resolve</a>
</div>
</div>
|]
renderHubHealthTable :: [Hub] -> Html
renderHubHealthTable [] = [hsx|<p class="text-sm text-gray-400">No hubs registered.</p>|]
renderHubHealthTable hs = [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 hs renderHubRow}
</tbody>
</table>
|]
renderFrictionTable :: [FrictionScore] -> [Widget] -> Html
renderFrictionTable [] _ = [hsx|<p class="text-sm text-gray-400">No friction scores computed yet.</p>|]
renderFrictionTable scores ws = [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 scores ws) renderFrictionRow}
</tbody>
</table>
|]
renderBottlenecksPanel :: [BottleneckRecord] -> Html
renderBottlenecksPanel [] = [hsx|<p class="text-sm text-gray-400">No active bottlenecks.</p>|]
renderBottlenecksPanel _ = [hsx|
<div class="grid grid-cols-4 gap-3">
{forEach stages renderBottleneckStage}
</div>
|]
renderPropagationsPanel :: [CrossHubPropagation] -> Html
renderPropagationsPanel [] = [hsx|<p class="text-sm text-gray-400">No open propagation events.</p>|]
renderPropagationsPanel ps = [hsx|
<div class="space-y-2">
{forEach ps renderPropagationRow}
</div>
|]
renderHealthScore :: Maybe HubHealthSnapshot -> Html
renderHealthScore Nothing = [hsx|<span class="text-xs text-gray-400"></span>|]
renderHealthScore (Just s) = [hsx|
<span class={"px-2 py-0.5 rounded text-xs font-semibold " <> healthScoreBadge s.healthScore}>
{show s.healthScore}
</span>
|]