Files
inter-hub/Web/View/Hubs/FrictionHeatmap.hs
Bernd Worsch 98fb159582
Some checks failed
Test / test (push) Has been cancelled
feat(P7): IHF Phase 7 complete — advanced observability and operational integration
T01 schema: friction_scores, bottleneck_records, hub_health_snapshots,
cross_hub_propagations + migration 1743552000.

T02 Widget Pain Heatmap: computeFrictionScore (formula documented), RecomputeFriction
action, colour-coded grid view (green/yellow/amber/red).

T03 Workflow Bottleneck Analysis: detectBottlenecks across 4 pipeline stages
(candidate 30d, requirement 60d, decision 30d, observation 14d), idempotent,
severity from age ratio, resolve action.

T04 Hub Health Correlation: computeHubHealth (deduction table documented),
append-only HubHealthSnapshot, health history view, badge on hub Show page.

T05 Cross-Hub Propagation: annotation_cluster + widget_type_friction heuristics,
idempotent detection, acknowledge/resolve lifecycle.

T06 Operational Review Board: 4-panel AutoRefresh global dashboard — health matrix,
top-10 friction, bottleneck stage counts, open propagations.

T07 gate: 5 describe blocks in Test/Integration.hs; SCOPE.md updated Phase 7
complete; docs/phase7-summary.md written.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-29 21:49:22 +00:00

69 lines
2.8 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
module Web.View.Hubs.FrictionHeatmap where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Application.Helper.FrictionScore (scoreBand)
data FrictionHeatmapView = FrictionHeatmapView
{ hub :: !Hub
, widgets :: ![Widget]
, frictionScores :: ![FrictionScore]
}
instance View FrictionHeatmapView where
html FrictionHeatmapView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<div>
<h1 class="text-2xl font-semibold">Friction Heatmap</h1>
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<div class="flex gap-2">
<a href={RecomputeFrictionAction { hubId = hub.id }}
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Recompute
</a>
<a href={ShowHubAction { hubId = hub.id }}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Hub
</a>
</div>
</div>
<div class="mb-4 flex gap-4 text-xs text-gray-500">
<span><span class="inline-block w-3 h-3 rounded bg-green-100 mr-1"></span>Low (019)</span>
<span><span class="inline-block w-3 h-3 rounded bg-yellow-100 mr-1"></span>Medium (2039)</span>
<span><span class="inline-block w-3 h-3 rounded bg-orange-100 mr-1"></span>High (4059)</span>
<span><span class="inline-block w-3 h-3 rounded bg-red-100 mr-1"></span>Critical (60+)</span>
</div>
{if null widgets
then [hsx|<p class="text-sm text-gray-400">No widgets in this hub.</p>|]
else [hsx|
<div class="grid grid-cols-3 gap-3">
{forEach widgets renderWidgetCard}
</div>
|]}
|]
where
scoreFor w = maybe 0 (.score) (find (\fs -> fs.widgetId == w.id) frictionScores)
hasScore w = any (\fs -> fs.widgetId == w.id) frictionScores
renderWidgetCard :: Widget -> Html
renderWidgetCard w =
let s = scoreFor w
band = scoreBand s
in [hsx|
<div class={"rounded-lg border p-4 " <> band}>
<div class="flex items-start justify-between">
<a href={ShowWidgetAction { widgetId = w.id }}
class="font-medium text-sm hover:underline">{w.name}</a>
{if hasScore w
then [hsx|<span class="text-lg font-bold">{show s}</span>|]
else [hsx|<span class="text-xs text-gray-400"></span>|]}
</div>
<p class="text-xs mt-1 opacity-70">{w.widgetType}</p>
</div>
|]