coulomb/inter-hub
2
0
Fork 0
generated from coulomb/repo-seed
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(P6/T04): WidgetAdapterSpecsController, registry, widget adapter integration

Browse Source 
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 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-03-29 21:14:57 +00:00
parent 14779f0768
commit 32bb003f3b
10 changed files with 493 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
Web/Controller/Widgets.hs
View File

@@ -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