generated from coulomb/repo-seed
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:
106
Web/Controller/Api/V2/Learning.hs
Normal file
106
Web/Controller/Api/V2/Learning.hs
Normal 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
|
||||
]
|
||||
@@ -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)]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user