inter-hub-haskell/Web/View/LearningDashboard/Show.hs

152 lines
6.6 KiB
Haskell
Raw Normal View History

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>
2026-04-01 23:14:15 +00:00
module Web.View.LearningDashboard.Show where
import Web.View.Prelude
import Data.Time (diffUTCTime, getCurrentTime, nominalDay)
data ShowView = ShowView
{ topCorrelations :: ![OutcomeCorrelation]
, patternRankings :: ![PatternPerformanceRecord]
, thresholdStatus :: ![(Hub, Maybe AdaptiveThresholdConfig)]
, recentInsights :: ![LearningInsight]
, knowledgeHighlights :: ![InstitutionalKnowledgeEntry]
}
instance View ShowView where
html ShowView { .. } = [hsx|
<div class="p-6">
<h1 class="text-2xl font-bold text-gray-900 mb-6">Learning Dashboard</h1>
<div class="grid grid-cols-1 lg:grid-cols-2 gap-6 mb-6">
{-- Panel 1: Top annotation predictors --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Top Annotation Predictors</h2>
{if null topCorrelations
then [hsx|<p class="text-sm text-gray-400">No data run correlation analysis per hub.</p>|]
else [hsx|
<div class="space-y-2">
{forM_ topCorrelations renderCorrelation}
</div>
|]}
</div>
{-- Panel 2: Pattern performance ranking --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Pattern Performance Ranking</h2>
{if null patternRankings
then [hsx|<p class="text-sm text-gray-400">No data run pattern performance per hub.</p>|]
else [hsx|
<div class="space-y-2">
{forM_ patternRankings renderPatternRank}
</div>
|]}
</div>
</div>
<div class="grid grid-cols-1 lg:grid-cols-3 gap-6">
{-- Panel 3: Adaptive threshold status --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Adaptive Threshold Status</h2>
<div class="space-y-2">
{forM_ thresholdStatus renderThresholdStatus}
</div>
</div>
{-- Panel 4: Recent learning insights --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Recent Insights</h2>
{if null recentInsights
then [hsx|<p class="text-sm text-gray-400">No insights yet.</p>|]
else [hsx|
<div class="space-y-3">
{forM_ recentInsights renderInsight}
</div>
|]}
</div>
{-- Panel 5: Knowledge base highlights --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Knowledge Highlights</h2>
{if null knowledgeHighlights
then [hsx|<p class="text-sm text-gray-400">No entries yet distil a decision.</p>|]
else [hsx|
<div class="space-y-3">
{forM_ knowledgeHighlights renderKnowledge}
</div>
|]}
</div>
</div>
</div>
|]
where
renderCorrelation c = [hsx|
<div class="flex items-center gap-3">
<span class="text-sm text-gray-700 w-32 truncate">{c.annotationCategory}</span>
<div class="flex-1 bg-gray-200 rounded-full h-2">
<div class={barColor c.correlationScore}
style={"width:" <> show (round (c.correlationScore * 100) :: Int) <> "%"}></div>
</div>
<span class="text-xs text-gray-500">{show (round (c.correlationScore * 100) :: Int)}%</span>
</div>
|]
barColor s
| s >= 0.7 = "h-2 rounded-full bg-green-500" :: Text
| s >= 0.4 = "h-2 rounded-full bg-yellow-500"
| otherwise = "h-2 rounded-full bg-red-400"
renderPatternRank r =
let rate = if r.totalOutcomeCount > 0
then fromIntegral r.positiveOutcomeCount / fromIntegral r.totalOutcomeCount :: Double
else 0.0
in [hsx|
<div class="flex items-center gap-2">
<span class="text-xs text-gray-400 w-5">{maybe "-" show r.outcomeRank}</span>
<a href={ShowWidgetPatternAction { widgetPatternId = r.widgetPatternId }}
class="text-sm text-blue-600 hover:underline truncate flex-1">
{show r.widgetPatternId}
</a>
<span class="text-xs text-gray-500">{show (round (rate * 100) :: Int)}%</span>
</div>
|]
renderThresholdStatus (h, mCfg) =
let driftClass = case mCfg of
Nothing -> "text-red-500" :: Text
Just cfg -> "text-green-600"
label = case mCfg of
Nothing -> "Not calibrated"
Just cfg -> "Calibrated"
in [hsx|
<div class="flex justify-between text-sm">
<span class="text-gray-700">{h.name}</span>
<span class={driftClass}>{label}</span>
</div>
|]
renderInsight i = [hsx|
<div class="border-l-4 border-indigo-400 pl-3">
<p class="text-xs font-medium text-gray-700">{i.title}</p>
<p class="text-xs text-gray-400">{insightTypeBadge i.insightType}</p>
</div>
|]
insightTypeBadge t = case t of
"annotation_predictor" -> "Annotation predictor" :: Text
"threshold_calibration" -> "Threshold calibration"
"pattern_ranking" -> "Pattern ranking"
"routing_improvement" -> "Routing improvement"
_ -> t
renderKnowledge e = [hsx|
<div>
<a href={ShowInstitutionalKnowledgeAction { knowledgeEntryId = e.id }}
class="text-sm text-blue-600 hover:underline">
{take 80 e.summary <> if length e.summary > 80 then "" else ""}
</a>
</div>
|]