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

213 lines
9.1 KiB
Haskell

module Web.View.Hubs.AdapterCompatibilityDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
import Data.List (nub, sortBy)
import Data.Ord (comparing, Down(..))
data AdapterCompatibilityDashboardView = AdapterCompatibilityDashboardView
{ hub :: !Hub
, specs :: ![WidgetAdapterSpec]
, widgets :: ![Widget]
, envelopes :: ![EnvelopeEmissionContract]
, reportings :: ![InteractionReportingContract]
}
instance View AdapterCompatibilityDashboardView where
html AdapterCompatibilityDashboardView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<div>
<h1 class="text-2xl font-semibold">Adapter Compatibility Dashboard</h1>
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<a href={ShowHubAction (hub.id)}
class="text-sm text-indigo-600 hover:underline"> Hub</a>
</div>
<!-- Panel 1: Adapter summary -->
<h2 class="text-base font-semibold mb-3">Adapter Specs</h2>
<div class="grid grid-cols-3 gap-4 mb-6">
{kpiCard "Active" (show activeCount) "text-green-700"}
{kpiCard "Draft" (show draftCount) "text-yellow-700"}
{kpiCard "Deprecated" (show deprecatedCount) "text-gray-500"}
</div>
<!-- Panel 2: Widget coverage -->
<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">Widget Coverage</h2>
<div class="flex gap-6 mb-3 text-sm">
<div>
<span class="font-medium">{length widgets}</span>
<span class="text-gray-500 ml-1">total widgets</span>
</div>
<div>
<span class="font-medium text-teal-700">{adapterBacked}</span>
<span class="text-gray-500 ml-1">adapter-backed</span>
</div>
<div>
<span class="font-medium text-indigo-700">{nativeCount}</span>
<span class="text-gray-500 ml-1">native IHP</span>
</div>
</div>
{renderCoverageBar adapterBacked nativeCount}
{forEach coverageBySpec (\(sid, cnt) ->
let mSpec = find (\s -> s.id == sid) specs
label = maybe "(unknown)" (.name) mSpec
in [hsx|
<div class="flex items-center gap-3 mt-2 text-xs text-gray-600">
<span class="bg-purple-100 text-purple-700 px-1.5 py-0.5 rounded">{label}</span>
<span>{show cnt} widgets</span>
</div>
|]
)}
</div>
<!-- Panel 3: Contract versions in use -->
<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 Contracts</h2>
<div class="flex gap-6 text-sm">
<div>
<span class="text-gray-500 mr-1">Envelope:</span>
{forEach envelopes renderEnvelopeLink}
</div>
<div>
<span class="text-gray-500 mr-1">Reporting:</span>
{forEach reportings renderReportingLink}
</div>
</div>
</div>
<!-- Panel 4: Unassigned 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">
Unassigned Widgets
<span class="ml-1 text-xs text-gray-400">(no adapter_spec_id)</span>
</h2>
{renderUnassignedWidgets unassignedWidgets}
</div>
<!-- Panel 5: Stale adapters -->
<div class="bg-white rounded-lg border border-gray-200 p-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">
Active Adapter Specs
</h2>
{renderActiveSpecsTable activeSpecs}
</div>
|]
where
activeCount = length (filter (\s -> s.status == "active") specs)
draftCount = length (filter (\s -> s.status == "draft") specs)
deprecatedCount = length (filter (\s -> s.status == "deprecated") specs)
activeSpecs = filter (\s -> s.status == "active") specs
adapterBacked = length (filter (\w -> isJust w.adapterSpecId) widgets)
nativeCount = length widgets - adapterBacked
unassignedWidgets = filter (\w -> isNothing w.adapterSpecId) widgets
-- Count widgets per adapter spec ID
coverageBySpec :: [(Id WidgetAdapterSpec, Int)]
coverageBySpec =
let assigned = [ sid | w <- widgets, Just sid <- [w.adapterSpecId] ]
specIds = nub assigned
in sortBy (comparing (Down . snd))
[ (sid, length (filter (== sid) assigned)) | sid <- specIds ]
renderActiveSpecsTable :: [WidgetAdapterSpec] -> Html
renderActiveSpecsTable [] = [hsx|<p class="text-sm text-gray-400">No active adapter specs.</p>|]
renderActiveSpecsTable ss = [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">Adapter</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Framework</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Widgets</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Status</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach ss renderSpecRow}
</tbody>
</table>
|]
renderSpecRow :: WidgetAdapterSpec -> Html
renderSpecRow s =
let widgetCount = length (filter (\w -> w.adapterSpecId == Just s.id) widgets)
in [hsx|
<tr class="hover:bg-gray-50">
<td class="px-3 py-2">
<a href={ShowWidgetAdapterSpecAction (s.id)}
class="text-indigo-600 hover:underline">{s.name}</a>
</td>
<td class="px-3 py-2">
<span class="bg-purple-100 text-purple-700 text-xs px-1.5 py-0.5 rounded">{s.framework}</span>
</td>
<td class="px-3 py-2 text-gray-700">{show widgetCount}</td>
<td class="px-3 py-2">
<span class={adapterStatusBadge s.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{s.status}
</span>
</td>
</tr>
|]
renderEnvelopeLink :: EnvelopeEmissionContract -> Html
renderEnvelopeLink e = [hsx|
<a href={ShowEnvelopeEmissionContractAction (e.id)}
class="font-mono text-indigo-600 hover:underline mr-2">v{e.contractVersion}</a>
|]
renderReportingLink :: InteractionReportingContract -> Html
renderReportingLink r = [hsx|
<a href={ShowInteractionReportingContractAction (r.id)}
class="font-mono text-indigo-600 hover:underline mr-2">v{r.contractVersion}</a>
|]
renderUnassignedWidgets :: [Widget] -> Html
renderUnassignedWidgets [] = [hsx|<p class="text-sm text-gray-400">All widgets have adapter assignments.</p>|]
renderUnassignedWidgets ws = [hsx|
<div class="text-sm text-gray-600 space-y-1">
{forEach ws renderUnassignedWidgetRow}
</div>
|]
renderUnassignedWidgetRow :: Widget -> Html
renderUnassignedWidgetRow w = [hsx|
<div>
<a href={ShowWidgetAction (w.id)}
class="text-indigo-600 hover:underline">{w.name}</a>
<span class="text-xs text-gray-400 ml-2">{w.widgetType}</span>
</div>
|]
kpiCard :: Text -> Text -> Text -> Html
kpiCard label value textClass = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
<div class="text-xs text-gray-500 mb-1">{label}</div>
<div class={"text-2xl font-bold " <> textClass}>{value}</div>
</div>
|]
renderCoverageBar :: Int -> Int -> Html
renderCoverageBar adapted native =
let total = adapted + native
in if total == 0
then mempty
else
let adaptedPct = show (round ((fromIntegral adapted / fromIntegral total :: Double) * 100) :: Int) <> "%"
nativePct = show (round ((fromIntegral native / fromIntegral total :: Double) * 100) :: Int) <> "%"
in [hsx|
<div class="flex rounded overflow-hidden h-2.5 w-full mb-1">
<div class="bg-purple-400" style={"width:" <> adaptedPct}></div>
<div class="bg-indigo-300" style={"width:" <> nativePct}></div>
</div>
<div class="flex gap-4 text-xs text-gray-500">
<span><span class="inline-block w-2 h-2 bg-purple-400 rounded mr-1"></span>Adapter-backed {adaptedPct}</span>
<span><span class="inline-block w-2 h-2 bg-indigo-300 rounded mr-1"></span>Native IHP {nativePct}</span>
</div>
|]