generated from coulomb/repo-seed
feat(P6/T04): WidgetAdapterSpecsController, registry, widget adapter integration
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:
77
Web/Controller/WidgetAdapterSpecs.hs
Normal file
77
Web/Controller/WidgetAdapterSpecs.hs
Normal file
@@ -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 }
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user