Files
inter-hub/Web/Controller/LineageEnrichment.hs
Bernd Worsch 3737845e02 fix(WP-0017/E4): Layer 3 error fixes — round 2 (18 files)
Fixes 46 compile errors across 18 controllers and views:
- BridgeResponse missing from explicit import lists (Widgets, RequirementCandidates,
  DecisionRecords, AgentDelegations) — dot-notation HasField resolution fails without
  the type in scope under DuplicateRecordFields
- unId not in IHP v1.5 — replaced all fmap (Id . unId) with fmap coerce
- respondWith not in IHP — replaced with plain redirectTo in 5 controllers
- [hubId] list param to sqlQuery — replaced with (Only hubId) tuple
- deleteWhere not in IHP — replaced with query/filterWhere/fetch/deleteRecords
- fill @'["label"] mismatch — field is label_ in generated types, not label
- PersistUUID/toUUID (persistent-style) — replaced with (Only id)
- intercalate + jsonArrayTexts ambiguity in GovernanceTemplates — hid Index import,
  removed local duplicates, added Data.Text (intercalate)
- Int16 not in scope in AntifragilityDashboard — changed to Int (score :: Int)
- typeArraySection type mismatch in HubCapabilityManifests/Edit — unified to [Text]
- renderForm arity mismatch — added action param to DecisionRecords/New.renderForm
- Missing qualified Data.Aeson import in AdaptiveThresholds
- Missing ?request::Request constraint in Api/V2/WidgetPatterns.renderJsonWithStatus

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-12 12:17:45 +00:00

43 lines
1.8 KiB
Haskell

module Web.Controller.LineageEnrichment where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T06)
-- The AFTER INSERT trigger trg_enrich_lineage handles real-time enrichment.
-- This controller provides on-demand batch backfill for existing records.
import Web.Controller.Prelude
import Web.View.LineageEnrichment.Index
import IHP.ModelSupport (sqlQuery)
import Database.PostgreSQL.Simple (Only(..))
instance Controller LineageEnrichmentController where
beforeAction = ensureIsUser
action LineageEnrichmentAction = do
hubs <- query @Hub |> orderByAsc #name |> fetch
-- Count unenriched decisions per hub
counts <- sqlQuery
"SELECT dr.hub_id, COUNT(*) FILTER (WHERE dr.outcome_summary IS NULL)::int AS unenriched \
\ FROM decision_records dr \
\ GROUP BY dr.hub_id"
()
:: IO [(Id Hub, Int)]
render IndexView { hubs, counts }
action EnrichLineageAction { hubIdForLineage } = do
let hubId = hubIdForLineage
-- Batch-call the trigger logic via a PL/pgSQL function for all
-- outcome_signals in this hub that haven't yet enriched their chain.
[Only enriched] <- sqlQuery
"SELECT COUNT(*) FROM ( \
\ SELECT enrich_lineage_on_outcome_batch(os.id) \
\ FROM outcome_signals os \
\ JOIN deployment_records dep ON dep.id = os.deployment_id \
\ JOIN decision_records dr ON dr.id = dep.decision_id \
\ WHERE dr.hub_id = ? \
\ AND dr.outcome_summary IS NULL \
\ ) sub"
(Only hubId)
:: IO [Only Int]
setSuccessMessage ("Lineage enriched for " <> show enriched <> " signals")
redirectTo LineageEnrichmentAction