generated from coulomb/repo-seed
Bernd Worsch
98fb159582
Some checks failed
Test / test (push) Has been cancelled
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>
38 lines
1.4 KiB
Haskell
38 lines
1.4 KiB
Haskell
module Web.Controller.CrossHubPropagations where
|
|
|
|
import Web.Types
|
|
import Web.View.CrossHubPropagations.Index
|
|
import Generated.Types
|
|
import IHP.Prelude
|
|
import IHP.ControllerPrelude
|
|
import Application.Helper.CrossHubPropagation (detectPropagations)
|
|
|
|
instance Controller CrossHubPropagationsController where
|
|
beforeAction = ensureIsUser
|
|
|
|
action CrossHubPropagationsAction = autoRefresh do
|
|
propagations <- query @CrossHubPropagation
|
|
|> orderByDesc #detectedAt
|
|
|> fetch
|
|
hubs <- query @Hub |> fetch
|
|
render IndexView { propagations, hubs }
|
|
|
|
action DetectPropagationsAction = do
|
|
hubs <- query @Hub |> fetch
|
|
widgets <- query @Widget |> fetch
|
|
annotations <- query @Annotation |> fetch
|
|
frictionScores <- query @FrictionScore |> fetch
|
|
_ <- detectPropagations hubs annotations widgets frictionScores
|
|
setSuccessMessage "Propagation detection complete"
|
|
redirectTo CrossHubPropagationsAction
|
|
|
|
action AcknowledgePropagationAction { crossHubPropagationId } = do
|
|
p <- fetch crossHubPropagationId
|
|
p |> set #status "acknowledged" |> updateRecord
|
|
redirectTo CrossHubPropagationsAction
|
|
|
|
action ResolvePropagationAction { crossHubPropagationId } = do
|
|
p <- fetch crossHubPropagationId
|
|
p |> set #status "resolved" |> updateRecord
|
|
redirectTo CrossHubPropagationsAction
|