generated from coulomb/repo-seed
Bernd Worsch
3737845e02
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>
70 lines
3.0 KiB
Haskell
70 lines
3.0 KiB
Haskell
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"
|
|
(Only hubId)
|
|
:: IO [(Id WidgetPattern, Int, Int, Int, Maybe Double)]
|
|
|
|
now <- getCurrentTime
|
|
-- Delete existing records for this hub then insert fresh
|
|
query @PatternPerformanceRecord
|
|
|> filterWhere (#hubId, hubId)
|
|
|> fetch
|
|
>>= deleteRecords
|
|
-- 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
|