Files
inter-hub/Web/View/HubRegistry/Show.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

188 lines
7.4 KiB
Haskell

module Web.View.HubRegistry.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), encode)
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as BL
-- | Row from the adopted patterns query.
-- (patternId, patternName, widgetType, patternHubId, adoptionId, isVersionPinned, adoptedAt)
type AdoptedPatternRow = (Id WidgetPattern, Text, Text, Id Hub, Id PatternAdoption, Bool, UTCTime)
data ShowView = ShowView
{ hub :: !Hub
, mManifest :: !(Maybe HubCapabilityManifest)
, healthHistory :: ![HubHealthSnapshot]
, adoptedPatterns :: ![AdoptedPatternRow]
}
instance View ShowView where
html ShowView { .. } =
let gs = gaafStatus mManifest
in [hsx|
<div class="mb-4">
<a href={HubRegistryAction} class="text-sm text-gray-500 hover:text-gray-700">
Hub Registry
</a>
</div>
<div class="flex items-center gap-3 mb-6">
<h1 class="text-2xl font-semibold">{hub.name}</h1>
<span class="text-sm text-gray-400 font-mono">{hub.hubKind}</span>
{gaafBadge gs}
</div>
<div class="grid grid-cols-2 gap-4 mb-6">
<div class="bg-white rounded-lg border border-gray-200 p-4">
<p class="text-xs text-gray-500 uppercase tracking-wide">Domain</p>
<p class="font-medium mt-1">{hub.domain}</p>
</div>
<div class="bg-white rounded-lg border border-gray-200 p-4">
<p class="text-xs text-gray-500 uppercase tracking-wide">Capability Manifest</p>
{manifestCell mManifest hub.id}
</div>
</div>
{manifestSection mManifest}
<h2 class="text-lg font-semibold mb-3">Health History</h2>
{renderHealthHistory healthHistory}
<h2 class="text-lg font-semibold mb-3">Adopted Patterns</h2>
{renderAdoptedPatternsSection adoptedPatterns}
|]
manifestSection :: Maybe HubCapabilityManifest -> Html
manifestSection Nothing = [hsx|
<div class="bg-amber-50 border border-amber-200 rounded p-3 mb-6 text-sm text-amber-800">
No active manifest. <a href={NewHubCapabilityManifestAction} class="underline">Create one</a> to register hub-owned types.
</div>
|]
manifestSection (Just m) = [hsx|
<div class="grid grid-cols-2 gap-4 mb-6">
{jsonArraySection "Widget Types" m.declaredWidgetTypes}
{jsonArraySection "Event Types" m.declaredEventTypes}
{jsonArraySection "Annotation Categories" m.declaredAnnotationCategories}
{jsonArraySection "Policy Scopes" m.declaredPolicyScopes}
</div>
|]
renderAdoptedPatternsSection :: [AdoptedPatternRow] -> Html
renderAdoptedPatternsSection [] = [hsx|<p class="text-sm text-gray-400">No patterns adopted yet. <a href={WidgetPatternsAction} class="text-indigo-600 hover:underline">Browse patterns </a></p>|]
renderAdoptedPatternsSection ps = [hsx|
<div class="space-y-2">
{forEach ps renderAdoptedPattern}
</div>
|]
renderPinnedBadge :: Bool -> Html
renderPinnedBadge True = [hsx|<span class="px-2 py-0.5 rounded bg-blue-100 text-blue-700">pinned</span>|]
renderPinnedBadge False = [hsx|<span class="px-2 py-0.5 rounded bg-gray-100 text-gray-500">follow latest</span>|]
renderHealthHistory :: [HubHealthSnapshot] -> Html
renderHealthHistory [] = [hsx|<p class="text-sm text-gray-400 mb-6">No snapshots recorded yet.</p>|]
renderHealthHistory history = [hsx|
<div class="overflow-x-auto mb-6">
<table class="w-full text-sm">
<thead>
<tr class="text-xs text-gray-500 border-b border-gray-200">
<th class="text-left py-2">Score</th>
<th class="text-left py-2">Open Candidates</th>
<th class="text-left py-2">Regressed Widgets</th>
<th class="text-left py-2">Stale Decisions</th>
<th class="text-left py-2">Active Bottlenecks</th>
<th class="text-left py-2">Computed At</th>
</tr>
</thead>
<tbody>
{forEach history renderSnapshotRow}
</tbody>
</table>
</div>
|]
manifestCell :: Maybe HubCapabilityManifest -> Id Hub -> Html
manifestCell Nothing hubId = [hsx|
<div class="mt-1">
<span class="text-sm text-gray-400">None</span>
<a href={NewHubCapabilityManifestAction}
class="ml-2 text-xs text-indigo-600 hover:underline">Create</a>
</div>
|]
manifestCell (Just m) _ = [hsx|
<div class="mt-1 flex items-center gap-2">
<span class="font-mono text-sm">{m.manifestVersion}</span>
<a href={ShowHubCapabilityManifestAction (m.id)}
class="text-xs text-indigo-600 hover:underline">View</a>
</div>
|]
gaafBadge :: GaafStatus -> Html
gaafBadge GaafCompliant =
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-green-100 text-green-800">GAAF compliant</span>|]
gaafBadge GaafDraftOnly =
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-amber-100 text-amber-800">draft manifest</span>|]
gaafBadge GaafNoManifest =
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-red-100 text-red-700">no manifest</span>|]
jsonArraySection :: Text -> Value -> Html
jsonArraySection title val = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
<h3 class="text-sm font-semibold text-gray-700 mb-2">
{title} <span class="text-gray-400 font-normal ml-1">({arrayLen val})</span>
</h3>
{renderArrayItems val}
</div>
|]
renderArrayItems :: Value -> Html
renderArrayItems (Array v) | V.null v =
[hsx|<p class="text-xs text-gray-400">None declared</p>|]
renderArrayItems (Array v) = [hsx|
<ul class="space-y-1">
{forEach (V.toList v) renderItem}
</ul>
|]
renderArrayItems _ = [hsx|<p class="text-xs text-gray-400"></p>|]
renderItem :: Value -> Html
renderItem (String t) = [hsx|<li class="font-mono text-xs text-gray-700">{t}</li>|]
renderItem v = [hsx|<li class="font-mono text-xs text-gray-500">{cs (BL.unpack (encode v)) :: Text}</li>|]
arrayLen :: Value -> Text
arrayLen (Array v) = tshow (V.length v)
arrayLen _ = "0"
renderSnapshotRow :: HubHealthSnapshot -> Html
renderSnapshotRow s = [hsx|
<tr class="border-b border-gray-100 text-sm">
<td class="py-2 font-medium">{tshow s.healthScore}</td>
<td class="py-2">{tshow s.openCandidates}</td>
<td class="py-2">{tshow s.regressedWidgets}</td>
<td class="py-2">{tshow s.staleDecisions}</td>
<td class="py-2">{tshow s.activeBottlenecks}</td>
<td class="py-2 text-gray-500">{tshow s.computedAt}</td>
</tr>
|]
renderAdoptedPattern :: AdoptedPatternRow -> Html
renderAdoptedPattern (patternId, patternName, widgetType, _, _, isPinned, adoptedAt) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 flex items-center justify-between">
<div>
<a href={ShowWidgetPatternAction (patternId)}
class="font-medium text-sm text-indigo-700 hover:underline">
{patternName}
</a>
<span class="ml-2 font-mono text-xs text-gray-400">{widgetType}</span>
</div>
<div class="flex items-center gap-2 text-xs text-gray-500">
{renderPinnedBadge isPinned}
<span>{tshow adoptedAt}</span>
</div>
</div>
|]