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