feat(WP-0013): IHF Phase 12 — Platform Memory and Continuous Learning

Closes the long-range feedback loop: outcome signals now enrich the full
traceability chain and feed back into routing, triage, and AI proposals.

Schema (T01):
- outcome_correlations (CHECK correlation_type)
- pattern_performance_records
- adaptive_threshold_configs
- institutional_knowledge_entries (GIN tsvector FTS)
- learning_insights (CHECK insight_type)
- ALTER TABLE decision_records + requirement_candidates: outcome_summary JSONB
- AFTER INSERT trigger trg_enrich_lineage on outcome_signals
- contracts/core/ updated (outcome-summary-columns-v1, append-only addendum)

Correlation engine (T02):
- Application/Helper/CorrelationEngine.hs: pure annotation→outcome SQL
- Web/Controller/OutcomeCorrelations.hs: ComputeCorrelationsAction + index

Pattern performance (T03):
- Web/Controller/PatternPerformance.hs: ComputePatternPerformanceAction

Adaptive thresholds (T04):
- Web/Controller/AdaptiveThresholds.hs: CalibrateThresholdsAction
- Application/Helper/FrictionScore.hs: applyAdaptiveWeights

Institutional knowledge (T05):
- DistilDecisionAction in DecisionRecords controller
- Web/Controller/InstitutionalKnowledge.hs: QueryKnowledgeBaseAction

Lineage enrichment (T06):
- Web/Controller/LineageEnrichment.hs: EnrichLineageAction (batch backfill)
- enrich_lineage_on_outcome_batch() PL/pgSQL helper in migration

Learning dashboard (T07):
- Web/Controller/LearningDashboard.hs: 5-panel autoRefresh view
- "Learning" nav link in FrontController

API v2 learning endpoints (T08):
- GET /api/v2/outcome-correlations, /pattern-performance, /knowledge-base/{id}
- OpenAPI schemas: OutcomeCorrelation, PatternPerformanceRecord, InstitutionalKnowledgeEntry

GAAF scorecard + docs (T09):
- Core 3.8→3.9, Functional 3.6→3.8, overall 3.61→3.68
- CLAUDE.md: IHF v0.2 complete, no active workplan

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-01 23:14:15 +00:00
parent 9643173618
commit 0f505feb2d
28 changed files with 1574 additions and 17 deletions

View File

@@ -0,0 +1,86 @@
module Web.Controller.AdaptiveThresholds where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T04)
import Web.Controller.Prelude
import Web.View.AdaptiveThresholds.Index
import IHP.ModelSupport (sqlQuery)
import Database.PostgreSQL.Simple (Only(..))
instance Controller AdaptiveThresholdsController where
beforeAction = ensureIsUser
action AdaptiveThresholdsAction = do
hubs <- query @Hub |> orderByAsc #name |> fetch
configs <- query @AdaptiveThresholdConfig |> fetch
insights <- query @LearningInsight
|> filterWhere (#insightType, "threshold_calibration")
|> orderByDesc #computedAt
|> limit 10
|> fetch
render IndexView { hubs, configs, insights }
action CalibrateThresholdsAction { hubIdForThreshold } = do
let hubId = hubIdForThreshold
-- Step 1: find weak-predictor categories (score < 0.3)
weakCats <- sqlQuery
"SELECT annotation_category FROM outcome_correlations \
\ WHERE hub_id = ? AND correlation_score < 0.3"
[hubId]
:: IO [Only Text]
-- Step 2: compute bottleneck threshold override = mean friction score
-- for widgets with at least one negative outcome signal
[Only mBottleneckOverride] <- sqlQuery
"SELECT AVG(fs.score) \
\ FROM friction_scores fs \
\ JOIN widgets w ON w.id = fs.widget_id \
\ WHERE w.hub_id = ? \
\ AND EXISTS ( \
\ SELECT 1 FROM outcome_signals os \
\ JOIN deployment_records dep ON dep.id = os.deployment_id \
\ JOIN decision_records dr ON dr.id = dep.decision_id \
\ JOIN requirements r ON r.id = dr.requirement_id \
\ JOIN requirement_candidates rc ON rc.id = r.candidate_id \
\ WHERE rc.source_widget_id = w.id \
\ AND os.signal_type NOT IN ('success','adoption','satisfaction') \
\ )"
[hubId]
:: IO [Only (Maybe Double)]
now <- getCurrentTime
let weakNote = "Weak predictor categories (score < 0.3): "
<> intercalate ", " (map fromOnly weakCats)
-- Step 3: upsert AdaptiveThresholdConfig
existing <- query @AdaptiveThresholdConfig
|> filterWhere (#hubId, hubId)
|> fetchOneOrNothing
case existing of
Just cfg ->
cfg
|> set #bottleneckThresholdOverride mBottleneckOverride
|> set #calibrationDate now
|> set #notes (Just weakNote)
|> updateRecord
Nothing ->
newRecord @AdaptiveThresholdConfig
|> set #hubId hubId
|> set #weightOverrides (A.Object mempty)
|> set #bottleneckThresholdOverride mBottleneckOverride
|> set #calibrationDate now
|> set #notes (Just weakNote)
|> createRecord
-- Step 4: write LearningInsight
newRecord @LearningInsight
|> set #hubId hubId
|> set #insightType "threshold_calibration"
|> set #title "Adaptive threshold calibration completed"
|> set #body ("Calibrated friction thresholds. " <> weakNote
<> maybe "" (\b -> " Bottleneck override: " <> show b) mBottleneckOverride)
|> set #evidenceLinks (A.toJSON ([] :: [A.Value]))
|> createRecord
setSuccessMessage "Threshold calibration complete"
redirectTo AdaptiveThresholdsAction

View File

@@ -0,0 +1,106 @@
module Web.Controller.Api.V2.Learning where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T08)
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=))
import Web.Controller.Api.V2.Auth (requireApiConsumer, paginatedResponse, getPageParams)
import IHP.ModelSupport (sqlQuery)
instance Controller ApiV2LearningController where
action ApiV2IndexOutcomeCorrelationsAction = do
_consumer <- requireApiConsumer
mHubId <- paramOrNothing @(Id Hub) "hub_id"
mCat <- paramOrNothing @Text "category"
(page, perPage) <- getPageParams
let off = (page - 1) * perPage
baseQuery <- pure $ query @OutcomeCorrelation
filtered <- pure $ case mHubId of
Nothing -> baseQuery
Just hid -> baseQuery |> filterWhere (#hubId, hid)
filteredCat <- pure $ case mCat of
Nothing -> filtered
Just cat -> filtered |> filterWhere (#annotationCategory, cat)
total <- filteredCat |> fetchCount
rows <- filteredCat |> orderByDesc #correlationScore |> limit perPage |> offset off |> fetch
renderJson $ paginatedResponse (map correlationToJson rows) page perPage total
action ApiV2IndexPatternPerformanceAction = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let off = (page - 1) * perPage
total <- query @PatternPerformanceRecord |> fetchCount
rows <- query @PatternPerformanceRecord
|> orderByAsc #outcomeRank
|> limit perPage
|> offset off
|> fetch
renderJson $ paginatedResponse (map patternPerfToJson rows) page perPage total
action ApiV2IndexKnowledgeBaseAction = do
_consumer <- requireApiConsumer
mQ <- paramOrNothing @Text "q"
(page, perPage) <- getPageParams
let off = (page - 1) * perPage
rows <- case mQ of
Nothing -> query @InstitutionalKnowledgeEntry
|> orderByDesc #createdAt
|> limit perPage
|> offset off
|> fetch
Just q -> sqlQuery
"SELECT * FROM institutional_knowledge_entries \
\ WHERE summary_tsv @@ plainto_tsquery('english', ?) \
\ ORDER BY ts_rank(summary_tsv, plainto_tsquery('english', ?)) DESC \
\ LIMIT ? OFFSET ?"
(q, q, perPage, off)
renderJson (map knowledgeToJson rows)
action ApiV2ShowKnowledgeBaseAction { knowledgeEntryId } = do
_consumer <- requireApiConsumer
entry <- fetch knowledgeEntryId
renderJson (knowledgeToJson entry)
correlationToJson :: OutcomeCorrelation -> Value
correlationToJson c = object
[ "id" .= c.id
, "hubId" .= c.hubId
, "annotationCategory" .= c.annotationCategory
, "correlationType" .= c.correlationType
, "correlationScore" .= c.correlationScore
, "sampleCount" .= c.sampleCount
, "computedAt" .= c.computedAt
]
patternPerfToJson :: PatternPerformanceRecord -> Value
patternPerfToJson r =
let positiveRate = if r.totalOutcomeCount > 0
then fromIntegral r.positiveOutcomeCount / fromIntegral r.totalOutcomeCount :: Double
else 0.0
in object
[ "id" .= r.id
, "widgetPatternId" .= r.widgetPatternId
, "hubId" .= r.hubId
, "adoptionCount" .= r.adoptionCount
, "positiveOutcomeCount" .= r.positiveOutcomeCount
, "totalOutcomeCount" .= r.totalOutcomeCount
, "positiveOutcomeRate" .= positiveRate
, "meanOutcomeValue" .= r.meanOutcomeValue
, "outcomeRank" .= r.outcomeRank
, "calibratedAt" .= r.calibratedAt
]
knowledgeToJson :: InstitutionalKnowledgeEntry -> Value
knowledgeToJson e = object
[ "id" .= e.id
, "hubId" .= e.hubId
, "decisionRecordId" .= e.decisionRecordId
, "summary" .= e.summary
, "tags" .= e.tags
, "createdAt" .= e.createdAt
, "updatedAt" .= e.updatedAt
]

View File

@@ -90,6 +90,9 @@ buildOpenApiSpec = do
, "DecisionRecord" .= drSchema
, "DeploymentRecord" .= depSchema
, "OutcomeSignal" .= sigSchema
, "OutcomeCorrelation" .= outcomeCorrelationSchema
, "PatternPerformanceRecord" .= patternPerformanceSchema
, "InstitutionalKnowledgeEntry" .= institutionalKnowledgeSchema
]
, "securitySchemes" .= object
[ "BearerAuth" .= object
@@ -367,6 +370,51 @@ sigSchema = object
]
]
outcomeCorrelationSchema :: Value
outcomeCorrelationSchema = object
[ "type" .= ("object" :: Text)
, "properties" .= object
[ "id" .= uuidProp
, "hubId" .= uuidProp
, "annotationCategory" .= strProp
, "correlationType" .= strProp
, "correlationScore" .= object ["type" .= ("number" :: Text)]
, "sampleCount" .= object ["type" .= ("integer" :: Text)]
, "computedAt" .= dtProp
]
]
patternPerformanceSchema :: Value
patternPerformanceSchema = object
[ "type" .= ("object" :: Text)
, "properties" .= object
[ "id" .= uuidProp
, "widgetPatternId" .= uuidProp
, "hubId" .= uuidProp
, "adoptionCount" .= object ["type" .= ("integer" :: Text)]
, "positiveOutcomeCount" .= object ["type" .= ("integer" :: Text)]
, "totalOutcomeCount" .= object ["type" .= ("integer" :: Text)]
, "positiveOutcomeRate" .= object ["type" .= ("number" :: Text)]
, "meanOutcomeValue" .= object ["type" .= ("number" :: Text)]
, "outcomeRank" .= object ["type" .= ("integer" :: Text)]
, "calibratedAt" .= dtProp
]
]
institutionalKnowledgeSchema :: Value
institutionalKnowledgeSchema = object
[ "type" .= ("object" :: Text)
, "properties" .= object
[ "id" .= uuidProp
, "hubId" .= uuidProp
, "decisionRecordId" .= uuidProp
, "summary" .= strProp
, "tags" .= object ["type" .= ("array" :: Text)]
, "createdAt" .= dtProp
, "updatedAt" .= dtProp
]
]
uuidProp :: Value
uuidProp = object ["type" .= ("string" :: Text), "format" .= ("uuid" :: Text)]

View File

@@ -11,6 +11,8 @@ import IHP.ControllerPrelude
import Application.Helper.AgentBridge (callAgent, checkGovernancePolicy, bridgeErrorMessage)
import Application.Helper.ModelRouter (resolveAgent)
import Data.List (intercalate)
import IHP.ModelSupport (sqlQuery)
import qualified Data.Aeson as A
validOutcomes :: [Text]
validOutcomes = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]
@@ -242,3 +244,60 @@ instance Controller DecisionRecordsController where
|> createRecord
setSuccessMessage "Implementation proposal created"
redirectTo ShowDecisionRecordAction { decisionRecordId }
-- T05 / Phase 12: Distil decision into institutional knowledge entry
action DistilDecisionAction { decisionRecordId } = do
record <- fetch decisionRecordId
outcomes <- sqlQuery
"SELECT os.signal_type, os.value FROM outcome_signals os \
\ JOIN deployment_records dep ON dep.id = os.deployment_id \
\ WHERE dep.decision_id = ?"
[decisionRecordId]
:: IO [(Text, Maybe Double)]
let signalText = intercalate ", " $
map (\(st, mv) -> st <> maybe "" (\v -> "=" <> show v) mv) outcomes
prompt = "Distil this decision into a 2-3 sentence institutional knowledge entry. "
<> "Include the outcome data.\n\nDecision: " <> record.title
<> "\nRationale: " <> record.rationale
<> "\nOutcome: " <> record.outcome
<> "\nSignals: " <> signalText
-- Resolve hub from requirement chain
mHubId <- case record.requirementId of
Nothing -> pure Nothing
Just rid -> do
mReq <- fetchOneOrNothing rid
pure $ case mReq >>= (.sourceWidgetId) of
Nothing -> Nothing
Just _ -> Nothing -- hub resolution via widget lookup below
mHubIdResolved <- case record.requirementId of
Nothing -> pure Nothing
Just rid -> do
mReq <- fetchOneOrNothing rid
case mReq >>= (.sourceWidgetId) of
Nothing -> pure Nothing
Just wid -> fmap (.hubId) <$> fetchOneOrNothing @Widget wid
case mHubIdResolved of
Nothing -> do
setErrorMessage "Cannot resolve hub — ensure decision has a linked requirement with a source widget"
redirectTo ShowDecisionRecordAction { decisionRecordId }
Just hubId -> do
mAgent <- resolveAgent hubId "synthesis"
case mAgent of
Nothing -> do
setErrorMessage "No routing policy for 'synthesis' task type"
redirectTo ShowDecisionRecordAction { decisionRecordId }
Just agent -> do
result <- liftIO $ callAgent agent prompt
case result of
Left err -> do
setErrorMessage ("Distillation failed: " <> bridgeErrorMessage err)
redirectTo ShowDecisionRecordAction { decisionRecordId }
Right resp -> do
newRecord @InstitutionalKnowledgeEntry
|> set #hubId hubId
|> set #decisionRecordId (Just decisionRecordId)
|> set #summary resp.content
|> set #tags (A.toJSON ["decision" :: Text])
|> createRecord
setSuccessMessage "Knowledge entry created"
redirectTo ShowDecisionRecordAction { decisionRecordId }

View File

@@ -0,0 +1,49 @@
module Web.Controller.InstitutionalKnowledge where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T05)
import Web.Controller.Prelude
import Web.View.InstitutionalKnowledge.Index
import Web.View.InstitutionalKnowledge.Show
import IHP.ModelSupport (sqlQuery)
instance Controller InstitutionalKnowledgeController where
beforeAction = ensureIsUser
action InstitutionalKnowledgeAction = do
entries <- query @InstitutionalKnowledgeEntry
|> orderByDesc #createdAt
|> limit 50
|> fetch
hubs <- query @Hub |> fetch
render IndexView { entries, hubs, mQuery = Nothing }
action ShowInstitutionalKnowledgeAction { knowledgeEntryId } = do
entry <- fetch knowledgeEntryId
hub <- fetch entry.hubId
mDecision <- case entry.decisionRecordId of
Nothing -> pure Nothing
Just did -> fetchOneOrNothing did
render ShowView { entry, hub, mDecision }
action QueryKnowledgeBaseAction = do
q <- param @Text "q"
mHubStr <- paramOrNothing @Text "hubId"
hubs <- query @Hub |> fetch
entries <- case mHubStr of
Nothing ->
sqlQuery
"SELECT * FROM institutional_knowledge_entries \
\ WHERE summary_tsv @@ plainto_tsquery('english', ?) \
\ ORDER BY ts_rank(summary_tsv, plainto_tsquery('english', ?)) DESC \
\ LIMIT 20"
(q, q)
Just hid ->
sqlQuery
"SELECT * FROM institutional_knowledge_entries \
\ WHERE hub_id = ? \
\ AND summary_tsv @@ plainto_tsquery('english', ?) \
\ ORDER BY ts_rank(summary_tsv, plainto_tsquery('english', ?)) DESC \
\ LIMIT 20"
(hid, q, q)
render IndexView { entries, hubs, mQuery = Just q }

View File

@@ -0,0 +1,32 @@
module Web.Controller.LearningDashboard where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T07)
import Web.Controller.Prelude
import Web.View.LearningDashboard.Show
instance Controller LearningDashboardController where
beforeAction = ensureIsUser
action LearningDashboardAction = do
autoRefresh
topCorrelations <- query @OutcomeCorrelation
|> orderByDesc #correlationScore
|> limit 10
|> fetch
patternRankings <- query @PatternPerformanceRecord
|> orderByAsc #outcomeRank
|> limit 10
|> fetch
hubs <- query @Hub |> orderByAsc #name |> fetch
configs <- query @AdaptiveThresholdConfig |> fetch
let thresholdStatus = map (\h -> (h, find (\c -> c.hubId == h.id) configs)) hubs
recentInsights <- query @LearningInsight
|> orderByDesc #computedAt
|> limit 10
|> fetch
knowledgeHighlights <- query @InstitutionalKnowledgeEntry
|> orderByDesc #createdAt
|> limit 5
|> fetch
render ShowView { topCorrelations, patternRankings, thresholdStatus, recentInsights, knowledgeHighlights }

View File

@@ -0,0 +1,42 @@
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"
[hubId]
:: IO [Only Int]
setSuccessMessage ("Lineage enriched for " <> show enriched <> " signals")
redirectTo LineageEnrichmentAction

View File

@@ -0,0 +1,58 @@
module Web.Controller.OutcomeCorrelations where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T02)
import Web.Controller.Prelude
import Web.View.OutcomeCorrelations.Index
import Application.Helper.CorrelationEngine (computeAnnotationCorrelations)
import Data.Aeson ((.=), object)
instance Controller OutcomeCorrelationsController where
beforeAction = ensureIsUser
action OutcomeCorrelationsAction = do
mHubFilter <- paramOrNothing @(Id Hub) "hubId"
correlations <- case mHubFilter of
Nothing -> query @OutcomeCorrelation
|> orderByDesc #correlationScore
|> fetch
Just hid -> query @OutcomeCorrelation
|> filterWhere (#hubId, hid)
|> orderByDesc #correlationScore
|> fetch
hubs <- query @Hub |> orderByAsc #name |> fetch
render IndexView { correlations, hubs, mHubFilter }
action ComputeCorrelationsAction { hubId } = do
rows <- liftIO $ computeAnnotationCorrelations hubId
now <- getCurrentTime
-- Upsert: delete existing rows for this hub then insert fresh
deleteWhere @OutcomeCorrelation (#hubId, hubId)
forM_ rows \(category, score, sampleCount) ->
newRecord @OutcomeCorrelation
|> set #hubId hubId
|> set #annotationCategory category
|> set #correlationType "annotation_predictor"
|> set #correlationScore score
|> set #sampleCount sampleCount
|> set #computedAt now
|> createRecord
-- Generate LearningInsight for top-scoring category
case rows of
((topCat, topScore, _) : _) | topScore >= 0.4 ->
newRecord @LearningInsight
|> set #hubId hubId
|> set #insightType "annotation_predictor"
|> set #title ("Strong predictor: annotation category '" <> topCat <> "'")
|> set #body ("Annotation category '" <> topCat <> "' shows a correlation score of "
<> show topScore <> " with positive outcomes. Consider weighting this category "
<> "higher in triage and routing decisions.")
|> set #evidenceLinks (A.toJSON
[object ["type" .= ("outcome_correlation" :: Text), "category" .= topCat]])
|> createRecord
>> pure ()
_ -> pure ()
setSuccessMessage ("Correlations computed: " <> show (length rows) <> " categories")
redirectTo OutcomeCorrelationsAction

View File

@@ -0,0 +1,66 @@
module Web.Controller.PatternPerformance where
-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T03)
import Web.Controller.Prelude
import Web.View.PatternPerformance.Index
import IHP.ModelSupport (sqlQuery)
instance Controller PatternPerformanceController where
beforeAction = ensureIsUser
action PatternPerformanceAction = do
records <- query @PatternPerformanceRecord
|> orderByAsc #outcomeRank
|> fetch
hubs <- query @Hub |> orderByAsc #name |> fetch
render IndexView { records, hubs }
action ComputePatternPerformanceAction { hubIdForPerformance } = do
let hubId = hubIdForPerformance
rows <- sqlQuery
"SELECT \
\ wp.id AS pattern_id, \
\ COUNT(DISTINCT pa.id)::int AS adoption_count, \
\ COUNT(os.id)::int AS total_outcome_count, \
\ COUNT(os.id) FILTER ( \
\ WHERE os.signal_type IN ('success','adoption','satisfaction') \
\ )::int AS positive_outcome_count, \
\ AVG(os.value) AS mean_outcome_value \
\ FROM widget_patterns wp \
\ JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
\ JOIN widgets w ON w.hub_id = pa.adopting_hub_id \
\ AND w.widget_type = wp.widget_type \
\ JOIN deployment_records dep ON dep.id IN ( \
\ SELECT dep2.id FROM deployment_records dep2 \
\ JOIN decision_records dr2 ON dr2.id = dep2.decision_id \
\ JOIN requirements r2 ON r2.id = dr2.requirement_id \
\ JOIN requirement_candidates rc2 ON rc2.id = r2.candidate_id \
\ WHERE rc2.source_widget_id = w.id \
\ ) \
\ JOIN outcome_signals os ON os.deployment_id = dep.id \
\ WHERE pa.adopting_hub_id = ? \
\ GROUP BY wp.id"
[hubId]
:: IO [(Id WidgetPattern, Int, Int, Int, Maybe Double)]
now <- getCurrentTime
-- Delete existing records for this hub then insert fresh
deleteWhere @PatternPerformanceRecord (#hubId, hubId)
-- Insert with rank computation
let sorted = sortBy (\(_, _, _, pos1, _) (_, _, _, pos2, _) -> compare pos2 pos1) rows
ranked = zip [1..] sorted
forM_ ranked \(rank, (patId, adoptions, total, positive, meanVal)) ->
newRecord @PatternPerformanceRecord
|> set #widgetPatternId patId
|> set #hubId hubId
|> set #adoptionCount adoptions
|> set #positiveOutcomeCount positive
|> set #totalOutcomeCount total
|> set #meanOutcomeValue meanVal
|> set #outcomeRank (Just rank)
|> set #calibratedAt now
|> createRecord
setSuccessMessage ("Pattern performance computed: " <> show (length rows) <> " patterns")
redirectTo PatternPerformanceAction