diff --git a/Web/Controller/Hubs.hs b/Web/Controller/Hubs.hs index fc1670a..09c7b4b 100644 --- a/Web/Controller/Hubs.hs +++ b/Web/Controller/Hubs.hs @@ -9,6 +9,7 @@ import Web.View.Hubs.TriageDashboard import Web.View.Hubs.GovernanceDashboard import Web.View.Hubs.AntifragilityDashboard import Web.View.Hubs.AgentAuditDashboard +import Web.View.Hubs.AdapterCompatibilityDashboard import Generated.Types import IHP.Prelude import IHP.ControllerPrelude @@ -228,3 +229,11 @@ instance Controller HubsController where reviews <- query @AgentReviewRecord |> fetch widgets <- query @Widget |> fetch render AgentAuditDashboardView { hub, proposals, reviews, widgets } + + action AdapterCompatibilityDashboardAction { hubId } = autoRefresh do + hub <- fetch hubId + specs <- query @WidgetAdapterSpec |> orderByAsc #name |> fetch + widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch + envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch + reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch + render AdapterCompatibilityDashboardView { hub, specs, widgets, envelopes, reportings } diff --git a/Web/View/Hubs/AdapterCompatibilityDashboard.hs b/Web/View/Hubs/AdapterCompatibilityDashboard.hs new file mode 100644 index 0000000..f30bce6 --- /dev/null +++ b/Web/View/Hubs/AdapterCompatibilityDashboard.hs @@ -0,0 +1,198 @@ +module Web.View.Hubs.AdapterCompatibilityDashboard where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude +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| +
+
+

Adapter Compatibility Dashboard

+

{hub.name}

+
+ ← Hub +
+ + +

Adapter Specs

+
+ {kpiCard "Active" (show activeCount) "text-green-700"} + {kpiCard "Draft" (show draftCount) "text-yellow-700"} + {kpiCard "Deprecated" (show deprecatedCount) "text-gray-500"} +
+ + +
+

Widget Coverage

+
+
+ {length widgets} + total widgets +
+
+ {adapterBacked} + adapter-backed +
+
+ {nativeCount} + native IHP +
+
+ {renderCoverageBar adapterBacked nativeCount} + {forEach coverageBySpec (\(sid, cnt) -> + let mSpec = find (\s -> s.id == sid) specs + label = maybe "(unknown)" (.name) mSpec + in [hsx| +
+ {label} + {show cnt} widgets +
+ |] + )} +
+ + +
+

Active Contracts

+
+
+ Envelope: + {forEach envelopes (\e -> [hsx| + v{e.contractVersion} + |])} +
+
+ Reporting: + {forEach reportings (\r -> [hsx| + v{r.contractVersion} + |])} +
+
+
+ + +
+

+ Unassigned Widgets + (no adapter_spec_id) +

+ {if null unassignedWidgets + then [hsx|

All widgets have adapter assignments.

|] + else [hsx| +
+ {forEach unassignedWidgets (\w -> [hsx| +
+ {w.name} + {w.widgetType} +
+ |])} +
+ |]} +
+ + +
+

+ Active Adapter Specs +

+ {if null activeSpecs + then [hsx|

No active adapter specs.

|] + else [hsx| + + + + + + + + + + + {forEach activeSpecs renderSpecRow} + +
AdapterFrameworkWidgetsStatus
+ |]} +
+ |] + 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 ] + + renderSpecRow :: WidgetAdapterSpec -> Html + renderSpecRow s = + let widgetCount = length (filter (\w -> w.adapterSpecId == Just s.id) widgets) + in [hsx| + + + {s.name} + + + {s.framework} + + {show widgetCount} + + " text-xs px-2 py-0.5 rounded font-medium"}> + {s.status} + + + + |] + +kpiCard :: Text -> Text -> Text -> Html +kpiCard label value textClass = [hsx| +
+
{label}
+
textClass}>{value}
+
+|] + +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| +
+
adaptedPct}>
+
nativePct}>
+
+
+ Adapter-backed {adaptedPct} + Native IHP {nativePct} +
+ |] diff --git a/Web/View/Hubs/Show.hs b/Web/View/Hubs/Show.hs index 31ae647..e35981e 100644 --- a/Web/View/Hubs/Show.hs +++ b/Web/View/Hubs/Show.hs @@ -45,6 +45,10 @@ instance View ShowView where class="text-sm border border-purple-300 text-purple-700 px-3 py-1.5 rounded hover:bg-purple-50"> Agent Audit + + Adapters + Edit diff --git a/workplans/IHUB-WP-0006-ihf-phase6-cross-framework-ui-adaptation.md b/workplans/IHUB-WP-0006-ihf-phase6-cross-framework-ui-adaptation.md index 452a744..d98b78b 100644 --- a/workplans/IHUB-WP-0006-ihf-phase6-cross-framework-ui-adaptation.md +++ b/workplans/IHUB-WP-0006-ihf-phase6-cross-framework-ui-adaptation.md @@ -250,7 +250,7 @@ test page (not IHP-rendered). ```task id: IHUB-WP-0006-T06 -status: todo +status: done priority: medium state_hub_task_id: "023269d8-9835-40b4-a394-478a0f36eee0" ```