Files
inter-hub/Web/View/Hubs/TriageDashboard.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

164 lines
6.6 KiB
Haskell

module Web.View.Hubs.TriageDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data TriageDashboardView = TriageDashboardView
{ hub :: !Hub
, widgets :: ![Widget]
, allCandidates :: ![RequirementCandidate]
, triageQueue :: ![RequirementCandidate]
, recentEscalations :: ![RequirementCandidate]
, allAnnotations :: ![Annotation]
}
instance View TriageDashboardView where
html TriageDashboardView { .. } = [hsx|
{autoRefreshMeta}
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<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>Triage Dashboard</span>
</div>
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Triage Dashboard {hub.name}</h1>
<a href={RequirementCandidatesAction}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
All Candidates
</a>
</div>
<!-- KPI row -->
<div class="grid grid-cols-5 gap-3 mb-8">
{renderKpi "Open" "open" allCandidates "bg-blue-50 border-blue-200 text-blue-800"}
{renderKpi "In Review" "in_review" allCandidates "bg-yellow-50 border-yellow-200 text-yellow-800"}
{renderKpi "Accepted" "accepted" allCandidates "bg-green-50 border-green-200 text-green-800"}
{renderKpi "Rejected" "rejected" allCandidates "bg-red-50 border-red-200 text-red-800"}
{renderKpi "Deferred" "deferred" allCandidates "bg-gray-50 border-gray-200 text-gray-700"}
</div>
<div class="grid grid-cols-2 gap-6 mb-8">
<!-- Triage queue -->
<section>
<h2 class="text-lg font-medium mb-3">Triage Queue (Open)</h2>
{renderTriageQueue triageQueue widgets}
</section>
<!-- Recent escalations -->
<section>
<h2 class="text-lg font-medium mb-3">Recent Escalations</h2>
{renderEscalationsSection recentEscalations widgets}
</section>
</div>
<!-- Category breakdown -->
<section>
<h2 class="text-lg font-medium mb-3">Annotation Category Breakdown</h2>
{renderCategoryBreakdown allAnnotations}
</section>
|]
renderKpi :: Text -> Text -> [RequirementCandidate] -> Text -> Html
renderKpi label status candidates colorClass =
let n = length $ filter (\c -> c.status == status) candidates
in [hsx|
<div class={"rounded-lg border p-4 " <> colorClass}>
<p class="text-xs font-medium uppercase tracking-wide opacity-70">{label}</p>
<p class="text-3xl font-semibold mt-1">{show n}</p>
</div>
|]
renderTriageQueue :: [RequirementCandidate] -> [Widget] -> Html
renderTriageQueue [] _ = [hsx|<p class="text-sm text-gray-400">Queue empty.</p>|]
renderTriageQueue items ws = [hsx|
<div class="space-y-2">
{forEach items (renderQueueItem ws)}
</div>
|]
renderEscalationsSection :: [RequirementCandidate] -> [Widget] -> Html
renderEscalationsSection [] _ = [hsx|<p class="text-sm text-gray-400">No escalations yet.</p>|]
renderEscalationsSection items ws = [hsx|
<div class="space-y-2">
{forEach items (renderEscalationItem ws)}
</div>
|]
renderQueueItem :: [Widget] -> RequirementCandidate -> Html
renderQueueItem widgets c =
let mWidget = find (\w -> w.id == c.sourceWidgetId) widgets
age = show c.createdAt
in [hsx|
<div class="bg-white rounded border border-gray-200 px-4 py-3">
<div class="flex items-start justify-between gap-2">
<a href={ShowRequirementCandidateAction (c.id)}
class="text-sm font-medium text-indigo-600 hover:text-indigo-800 leading-snug">
{c.title}
</a>
<span class="text-xs text-gray-400 whitespace-nowrap shrink-0">{age}</span>
</div>
<div class="mt-1 flex gap-2 text-xs text-gray-500">
<span>{maybe "" (.name) mWidget}</span>
<span class="text-gray-300">·</span>
<span class="bg-gray-100 px-1.5 rounded">{c.category}</span>
</div>
</div>
|]
renderEscalationItem :: [Widget] -> RequirementCandidate -> Html
renderEscalationItem widgets c =
let mWidget = find (\w -> w.id == c.sourceWidgetId) widgets
in [hsx|
<div class="bg-white rounded border border-gray-200 px-4 py-3">
<div class="flex items-center gap-2 mb-1">
<span class={statusClass c.status <> " text-xs px-2 py-0.5 rounded"}>{c.status}</span>
<span class="text-xs text-gray-500">{maybe "" (.name) mWidget}</span>
</div>
<a href={ShowRequirementCandidateAction (c.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{c.title}</a>
</div>
|]
renderCategoryBreakdown :: [Annotation] -> Html
renderCategoryBreakdown annotations =
let categories = ["friction", "defect", "wish", "policy_concern", "doc_gap", "trust", "other"]
counts = map (\cat -> (cat, length $ filter (\a -> a.category == cat) annotations)) categories
nonZero = filter (\(_, n) -> n > 0) counts
total = length annotations
in if total == 0
then [hsx|<p class="text-sm text-gray-400">No annotations yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
<div class="space-y-2">
{forEach nonZero (renderCategoryBar total)}
</div>
</div>
|]
renderCategoryBar :: Int -> (Text, Int) -> Html
renderCategoryBar total (cat, n) =
let pct = if total > 0 then (n * 100) `div` total else 0
in [hsx|
<div class="flex items-center gap-3 text-sm">
<span class="w-32 text-gray-600 text-xs">{cat}</span>
<div class="flex-1 bg-gray-100 rounded-full h-2">
<div class="bg-indigo-500 h-2 rounded-full" style={"width: " <> show pct <> "%"}></div>
</div>
<span class="w-8 text-right text-xs text-gray-500">{show n}</span>
</div>
|]
statusClass :: Text -> Text
statusClass "open" = "bg-blue-100 text-blue-700"
statusClass "in_review" = "bg-yellow-100 text-yellow-800"
statusClass "accepted" = "bg-green-100 text-green-800"
statusClass "rejected" = "bg-red-100 text-red-800"
statusClass "deferred" = "bg-gray-100 text-gray-600"
statusClass _ = "bg-gray-100 text-gray-600"