59 lines
2.6 KiB
Haskell
59 lines
2.6 KiB
Haskell
|
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
|