Files
inter-hub/Web/View/Hubs/AdapterCompatibilityDashboard.hs
Bernd Worsch c40f11d657 fix(WP-0017/E3): Layer 3 error fixes — controllers and views
Fix compilation errors across 6 controllers and 29 views: import cleanup,
ResponseException pattern for API auth, type fixes, unused import removal.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-11 23:40:31 +00:00

215 lines
9.2 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 (renderCoverageSpecRow specs)}
</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 ]
renderCoverageSpecRow :: [WidgetAdapterSpec] -> (Id WidgetAdapterSpec, Int) -> Html
renderCoverageSpecRow ss (sid, cnt) =
let mSpec = find (\s -> s.id == sid) ss
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>
|]
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>
|]