From 32bb003f3b83b3fe3407228c7479b655a8b82c81 Mon Sep 17 00:00:00 2001 From: Bernd Worsch Date: Sun, 29 Mar 2026 21:14:57 +0000 Subject: [PATCH] feat(P6/T04): WidgetAdapterSpecsController, registry, widget adapter integration MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit CRUD for WidgetAdapterSpec (index, show, new/create, edit/update — status+notes only after creation). Widget new/edit forms expose optional adapter_spec_id select. Widget show page renders adapter badge with link to spec. Widgets controller fetches adapter spec for show action. Co-Authored-By: Claude Sonnet 4.6 --- Web/Controller/WidgetAdapterSpecs.hs | 77 ++++++++++++ Web/Controller/Widgets.hs | 36 ++++-- Web/View/WidgetAdapterSpecs/Edit.hs | 72 +++++++++++ Web/View/WidgetAdapterSpecs/Index.hs | 82 ++++++++++++ Web/View/WidgetAdapterSpecs/New.hs | 89 +++++++++++++ Web/View/WidgetAdapterSpecs/Show.hs | 118 ++++++++++++++++++ Web/View/Widgets/Edit.hs | 7 +- Web/View/Widgets/New.hs | 20 ++- Web/View/Widgets/Show.hs | 11 ++ ...hf-phase6-cross-framework-ui-adaptation.md | 4 +- 10 files changed, 493 insertions(+), 23 deletions(-) create mode 100644 Web/Controller/WidgetAdapterSpecs.hs create mode 100644 Web/View/WidgetAdapterSpecs/Edit.hs create mode 100644 Web/View/WidgetAdapterSpecs/Index.hs create mode 100644 Web/View/WidgetAdapterSpecs/New.hs create mode 100644 Web/View/WidgetAdapterSpecs/Show.hs diff --git a/Web/Controller/WidgetAdapterSpecs.hs b/Web/Controller/WidgetAdapterSpecs.hs new file mode 100644 index 0000000..c88c2a3 --- /dev/null +++ b/Web/Controller/WidgetAdapterSpecs.hs @@ -0,0 +1,77 @@ +module Web.Controller.WidgetAdapterSpecs where + +import Web.Types +import Web.View.WidgetAdapterSpecs.Index +import Web.View.WidgetAdapterSpecs.Show +import Web.View.WidgetAdapterSpecs.New +import Web.View.WidgetAdapterSpecs.Edit +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude + +instance Controller WidgetAdapterSpecsController where + beforeAction = ensureIsUser + + action WidgetAdapterSpecsAction = do + specs <- query @WidgetAdapterSpec |> orderByAsc #name |> fetch + envelopes <- query @EnvelopeEmissionContract |> fetch + reportings <- query @InteractionReportingContract |> fetch + render IndexView { specs, envelopes, reportings } + + action ShowWidgetAdapterSpecAction { widgetAdapterSpecId } = do + spec <- fetch widgetAdapterSpecId + mEnvelope <- case spec.envelopeContractId of + Nothing -> pure Nothing + Just eid -> fetchOneOrNothing eid + mReporting <- case spec.reportingContractId of + Nothing -> pure Nothing + Just rid -> fetchOneOrNothing rid + widgets <- query @Widget + |> filterWhere (#adapterSpecId, Just widgetAdapterSpecId) + |> orderByAsc #name + |> fetch + render ShowView { spec, mEnvelope, mReporting, widgets } + + action NewWidgetAdapterSpecAction = do + let spec = newRecord @WidgetAdapterSpec + envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch + reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch + render NewView { spec, envelopes, reportings } + + action CreateWidgetAdapterSpecAction = do + let spec = newRecord @WidgetAdapterSpec + envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch + reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch + spec + |> fill @'["name", "framework", "version", "envelopeContractId", "reportingContractId", "status", "notes"] + |> validateField #name nonEmpty + |> validateField #framework nonEmpty + |> validateField #version nonEmpty + |> validateField #status (isInList ["draft", "active", "deprecated"]) + |> ifValid \case + Left spec -> render NewView { spec, envelopes, reportings } + Right spec -> do + spec <- createRecord spec + setSuccessMessage ("Adapter spec '" <> spec.name <> "' registered") + redirectTo ShowWidgetAdapterSpecAction { widgetAdapterSpecId = spec.id } + + action EditWidgetAdapterSpecAction { widgetAdapterSpecId } = do + spec <- fetch widgetAdapterSpecId + envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch + reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch + render EditView { spec, envelopes, reportings } + + action UpdateWidgetAdapterSpecAction { widgetAdapterSpecId } = do + spec <- fetch widgetAdapterSpecId + envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch + reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch + -- Only status and notes are editable once a spec exists. + spec + |> fill @'["status", "notes"] + |> validateField #status (isInList ["draft", "active", "deprecated"]) + |> ifValid \case + Left spec -> render EditView { spec, envelopes, reportings } + Right spec -> do + spec |> updateRecord + setSuccessMessage "Adapter spec updated" + redirectTo ShowWidgetAdapterSpecAction { widgetAdapterSpecId = spec.id } diff --git a/Web/Controller/Widgets.hs b/Web/Controller/Widgets.hs index f5db4fd..1757415 100644 --- a/Web/Controller/Widgets.hs +++ b/Web/Controller/Widgets.hs @@ -22,8 +22,12 @@ instance Controller WidgetsController where action NewWidgetAction = do let widget = newRecord @Widget - hubs <- query @Hub |> fetch - render NewView { widget, hubs } + hubs <- query @Hub |> fetch + adapterSpecs <- query @WidgetAdapterSpec + |> filterWhere (#status, "active") + |> orderByAsc #name + |> fetch + render NewView { widget, hubs, adapterSpecs } action ShowWidgetAction { widgetId } = do widget <- fetch widgetId @@ -57,17 +61,21 @@ instance Controller WidgetsController where allDeployments <- query @DeploymentRecord |> fetch let cycleCounts = widgetCycleCounts allCandidates allRequirements allDecisions allDeployments cycleCount = fromMaybe 0 (lookup widgetId cycleCounts) - render ShowView { widget, hub, versions, events, annotations, recentSignals, isRegressed, cycleCount } + mAdapterSpec <- case widget.adapterSpecId of + Nothing -> pure Nothing + Just sid -> fetchOneOrNothing sid + render ShowView { widget, hub, versions, events, annotations, recentSignals, isRegressed, cycleCount, mAdapterSpec } action CreateWidgetAction = do let widget = newRecord @Widget - hubs <- query @Hub |> fetch + hubs <- query @Hub |> fetch + adapterSpecs <- query @WidgetAdapterSpec |> filterWhere (#status, "active") |> orderByAsc #name |> fetch widget - |> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status"] + |> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status", "adapterSpecId"] |> validateField #name nonEmpty |> validateField #widgetType nonEmpty |> ifValid \case - Left widget -> render NewView { widget, hubs } + Left widget -> render NewView { widget, hubs, adapterSpecs } Right widget -> do widget <- createRecord widget let snapshot = object @@ -89,19 +97,21 @@ instance Controller WidgetsController where redirectTo ShowWidgetAction { widgetId = widget.id } action EditWidgetAction { widgetId } = do - widget <- fetch widgetId - hubs <- query @Hub |> fetch - render EditView { widget, hubs } + widget <- fetch widgetId + hubs <- query @Hub |> fetch + adapterSpecs <- query @WidgetAdapterSpec |> filterWhere (#status, "active") |> orderByAsc #name |> fetch + render EditView { widget, hubs, adapterSpecs } action UpdateWidgetAction { widgetId } = do - widget <- fetch widgetId - hubs <- query @Hub |> fetch + widget <- fetch widgetId + hubs <- query @Hub |> fetch + adapterSpecs <- query @WidgetAdapterSpec |> filterWhere (#status, "active") |> orderByAsc #name |> fetch widget - |> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status"] + |> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status", "adapterSpecId"] |> validateField #name nonEmpty |> validateField #widgetType nonEmpty |> ifValid \case - Left widget -> render EditView { widget, hubs } + Left widget -> render EditView { widget, hubs, adapterSpecs } Right widget -> do let newVersion = widget.version + 1 widget <- widget |> set #version newVersion |> updateRecord diff --git a/Web/View/WidgetAdapterSpecs/Edit.hs b/Web/View/WidgetAdapterSpecs/Edit.hs new file mode 100644 index 0000000..2f9bebc --- /dev/null +++ b/Web/View/WidgetAdapterSpecs/Edit.hs @@ -0,0 +1,72 @@ +module Web.View.WidgetAdapterSpecs.Edit where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude + +data EditView = EditView + { spec :: !WidgetAdapterSpec + , envelopes :: ![EnvelopeEmissionContract] + , reportings :: ![InteractionReportingContract] + } + +instance View EditView where + html EditView { .. } = [hsx| +
+ + ← {spec.name} + +
+

Edit Adapter Spec

+

+ Only status and notes can be changed once a spec is registered. + Name, framework, version, and linked contracts are immutable. +

+ {renderForm spec} + |] + +renderForm :: WidgetAdapterSpec -> Html +renderForm spec = formFor spec [hsx| +
+ +
+ +
{spec.name}
+
+ +
+
+ +
{spec.framework}
+
+
+ +
{spec.version}
+
+
+ +
+ + +
+ +
+ + {textareaField #notes} +
+ +
+ {submitButton} + + Cancel + +
+
+|] diff --git a/Web/View/WidgetAdapterSpecs/Index.hs b/Web/View/WidgetAdapterSpecs/Index.hs new file mode 100644 index 0000000..4ac2fdb --- /dev/null +++ b/Web/View/WidgetAdapterSpecs/Index.hs @@ -0,0 +1,82 @@ +module Web.View.WidgetAdapterSpecs.Index where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude +import Application.Helper.View (adapterStatusBadge) + +data IndexView = IndexView + { specs :: ![WidgetAdapterSpec] + , envelopes :: ![EnvelopeEmissionContract] + , reportings :: ![InteractionReportingContract] + } + +instance View IndexView where + html IndexView { .. } = [hsx| +
+
+

Widget Adapter Specs

+

+ Register adapters that allow non-IHP UI frameworks to participate in IHF. +

+
+ + + Register Adapter + +
+ +
+ Envelope Contracts ({length envelopes}) + Reporting Contracts ({length reportings}) +
+ + {if null specs + then [hsx|

No adapter specs registered yet.

|] + else renderTable specs} + |] + +renderTable :: [WidgetAdapterSpec] -> Html +renderTable specs = [hsx| +
+ + + + + + + + + + + + {forEach specs renderRow} + +
NameFrameworkVersionStatusCreated
+
+|] + +renderRow :: WidgetAdapterSpec -> Html +renderRow s = [hsx| + + + {s.name} + + + + {s.framework} + + + {s.version} + + " text-xs px-2 py-0.5 rounded font-medium"}> + {s.status} + + + {show s.createdAt} + +|] diff --git a/Web/View/WidgetAdapterSpecs/New.hs b/Web/View/WidgetAdapterSpecs/New.hs new file mode 100644 index 0000000..56484ad --- /dev/null +++ b/Web/View/WidgetAdapterSpecs/New.hs @@ -0,0 +1,89 @@ +module Web.View.WidgetAdapterSpecs.New where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude + +data NewView = NewView + { spec :: !WidgetAdapterSpec + , envelopes :: ![EnvelopeEmissionContract] + , reportings :: ![InteractionReportingContract] + } + +instance View NewView where + html NewView { .. } = [hsx| +
+ + ← Adapter Specs + +
+

Register Adapter Spec

+ {renderForm spec envelopes reportings} + |] + +renderForm :: WidgetAdapterSpec -> [EnvelopeEmissionContract] -> [InteractionReportingContract] -> Html +renderForm spec envelopes reportings = formFor spec [hsx| +
+ +
+ + {textField #name} +

Unique identifier, e.g. react-18, vue-3, web-component

+
+ +
+ + {textField #framework} +

e.g. react, vue, angular, vanilla

+
+ +
+ + {textField #version} +

Adapter spec version, e.g. 1.0

+
+ +
+ + +
+ +
+ + +
+ +
+ + +
+ +
+ + {textareaField #notes} +
+ +
+ {submitButton} + + Cancel + +
+
+|] diff --git a/Web/View/WidgetAdapterSpecs/Show.hs b/Web/View/WidgetAdapterSpecs/Show.hs new file mode 100644 index 0000000..3f29586 --- /dev/null +++ b/Web/View/WidgetAdapterSpecs/Show.hs @@ -0,0 +1,118 @@ +module Web.View.WidgetAdapterSpecs.Show where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude +import Application.Helper.View (adapterStatusBadge) + +data ShowView = ShowView + { spec :: !WidgetAdapterSpec + , mEnvelope :: !(Maybe EnvelopeEmissionContract) + , mReporting :: !(Maybe InteractionReportingContract) + , widgets :: ![Widget] + } + +instance View ShowView where + html ShowView { .. } = [hsx| +
+ + ← Adapter Specs + +
+ +
+
+ + {spec.framework} + +

{spec.name}

+ " text-xs px-2 py-0.5 rounded font-medium"}> + {spec.status} + +
+ + Edit status / notes + +
+ +
+
+
Spec Version
+
{spec.version}
+
+
+
Registered Widgets
+
{length widgets}
+
+
+ +
+
+
Envelope Contract
+ {renderEnvelopeLink mEnvelope} +
+
+
Reporting Contract
+ {renderReportingLink mReporting} +
+
+ + {forEach (specNotes spec) (\n -> [hsx| +
+ Notes: {n} +
+ |])} + + {if null widgets + then [hsx|

No widgets assigned to this adapter spec.

|] + else [hsx| +

Assigned Widgets

+
+ + + + + + + + + + {forEach widgets renderWidgetRow} + +
NameTypeStatus
+
+ |]} + |] + +renderEnvelopeLink :: Maybe EnvelopeEmissionContract -> Html +renderEnvelopeLink Nothing = [hsx|—|] +renderEnvelopeLink (Just c) = [hsx| + v{c.contractVersion} +|] + +renderReportingLink :: Maybe InteractionReportingContract -> Html +renderReportingLink Nothing = [hsx|—|] +renderReportingLink (Just c) = [hsx| + v{c.contractVersion} +|] + +renderWidgetRow :: Widget -> Html +renderWidgetRow w = [hsx| + + + {w.name} + + {w.widgetType} + {w.status} + +|] + +specNotes :: WidgetAdapterSpec -> [Text] +specNotes s = case s.notes of + Just n -> [n] + Nothing -> [] diff --git a/Web/View/Widgets/Edit.hs b/Web/View/Widgets/Edit.hs index 25d319a..b740210 100644 --- a/Web/View/Widgets/Edit.hs +++ b/Web/View/Widgets/Edit.hs @@ -7,8 +7,9 @@ import IHP.ViewPrelude import Web.View.Widgets.New (renderForm) data EditView = EditView - { widget :: !Widget - , hubs :: ![Hub] + { widget :: !Widget + , hubs :: ![Hub] + , adapterSpecs :: ![WidgetAdapterSpec] } instance View EditView where @@ -22,6 +23,6 @@ instance View EditView where Edit

Edit Widget

- {renderForm widget hubs} + {renderForm widget hubs adapterSpecs} |] diff --git a/Web/View/Widgets/New.hs b/Web/View/Widgets/New.hs index 1e0015d..a01f8f2 100644 --- a/Web/View/Widgets/New.hs +++ b/Web/View/Widgets/New.hs @@ -6,20 +6,21 @@ import IHP.Prelude import IHP.ViewPrelude data NewView = NewView - { widget :: !Widget - , hubs :: ![Hub] + { widget :: !Widget + , hubs :: ![Hub] + , adapterSpecs :: ![WidgetAdapterSpec] } instance View NewView where html NewView { .. } = [hsx|

Register Widget

- {renderForm widget hubs} + {renderForm widget hubs adapterSpecs}
|] -renderForm :: Widget -> [Hub] -> Html -renderForm widget hubs = formFor widget [hsx| +renderForm :: Widget -> [Hub] -> [WidgetAdapterSpec] -> Html +renderForm widget hubs adapterSpecs = formFor widget [hsx| {textField #name} {selectField #widgetType widgetTypeOptions} {selectField #hubId (hubOptions hubs)} @@ -27,6 +28,15 @@ renderForm widget hubs = formFor widget [hsx| {textField #viewContext} {selectField #policyScope policyScopeOptions} {selectField #status statusOptions} +
+ + +
{submitButton} |] diff --git a/Web/View/Widgets/Show.hs b/Web/View/Widgets/Show.hs index ecabb52..9bdcd78 100644 --- a/Web/View/Widgets/Show.hs +++ b/Web/View/Widgets/Show.hs @@ -15,6 +15,7 @@ data ShowView = ShowView , recentSignals :: ![OutcomeSignal] , isRegressed :: !Bool , cycleCount :: !Int + , mAdapterSpec :: !(Maybe WidgetAdapterSpec) } instance View ShowView where @@ -54,6 +55,7 @@ instance View ShowView where {widget.policyScope} {widget.status} v{show widget.version} + {renderAdapterBadge mAdapterSpec}

Html +renderAdapterBadge Nothing = mempty +renderAdapterBadge (Just s) = [hsx| + + adapter: {s.name} + +|] 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 20f6e30..86c83e8 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 @@ -135,7 +135,7 @@ CREATE INDEX widgets_adapter_spec_id_idx ON widgets (adapter_spec_id); ```task id: IHUB-WP-0006-T02 -status: todo +status: done priority: high state_hub_task_id: "298af675-550b-480b-bed6-05efc79cd0c9" ``` @@ -163,7 +163,7 @@ against it; contract index/show pages render correctly. ```task id: IHUB-WP-0006-T03 -status: todo +status: done priority: high state_hub_task_id: "f2767465-ff00-48be-b2dc-5bf3b179cca9" ```