inter-hub-haskell/Web/Controller/Hubs.hs

module Web.Controller.Hubs where

import Web.Types
import Web.View.Hubs.Index
import Web.View.Hubs.Show
import Web.View.Hubs.New
import Web.View.Hubs.Edit
import Web.View.Hubs.TriageDashboard
import Web.View.Hubs.GovernanceDashboard
import Web.View.Hubs.AntifragilityDashboard
import Web.View.Hubs.AgentAuditDashboard
import Web.View.Hubs.AdapterCompatibilityDashboard
import Web.View.Hubs.FrictionHeatmap
import Web.View.Hubs.BottleneckDashboard
import Web.View.Hubs.HubHealthHistory
import Web.View.Hubs.OperationalReviewBoard
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.Controller (regressedWidgetIds, widgetCycleCounts)
import Application.Helper.FrictionScore (computeFrictionScore)
import Application.Helper.BottleneckDetector (detectBottlenecks)
import Application.Helper.HubHealth (computeHubHealth)

instance Controller HubsController where
    beforeAction = ensureIsUser

    action HubsAction = do
        hubs <- query @Hub |> orderByAsc #createdAt |> fetch
        render IndexView { hubs }

    action NewHubAction = do
        let hub = newRecord @Hub
        render NewView { hub }

    action ShowHubAction { hubId } = autoRefresh do
        hub <- fetch hubId
        widgets <- query @Widget
            |> filterWhere (#hubId, hubId)
            |> orderByAsc #name
            |> fetch
        let widgetIds = map (.id) widgets
        recentEvents <- query @InteractionEvent
            |> filterWhereIn (#widgetId, widgetIds)
            |> orderByDesc #occurredAt
            |> limit 50
            |> fetch
        recentAnnotations <- query @Annotation
            |> filterWhereIn (#widgetId, widgetIds)
            |> orderByDesc #createdAt
            |> limit 20
            |> fetch
        mManifest <- query @HubCapabilityManifest
            |> filterWhere (#hubId, hubId)
            |> fetchOneOrNothing
        render ShowView { hub, widgets, recentEvents, recentAnnotations, mManifest }

    action CreateHubAction = do
        let hub = newRecord @Hub
        hub
            |> fill @'["slug", "name", "domain", "hubKind"]
            |> validateField #slug nonEmpty
            |> validateField #name nonEmpty
            |> validateField #domain nonEmpty
            |> validateField #hubKind (isInList ["domain", "shared"])
            -- 'framework' cannot be set via the UI
            |> ifValid \case
                Left hub -> render NewView { hub }
                Right hub -> do
                    hub <- createRecord hub
                    setSuccessMessage "Hub created"
                    redirectTo ShowHubAction { hubId = hub.id }

    action EditHubAction { hubId } = do
        hub <- fetch hubId
        render EditView { hub }

    action UpdateHubAction { hubId } = do
        hub <- fetch hubId
        hub
            |> fill @'["slug", "name", "domain", "hubKind"]
            |> validateField #slug nonEmpty
            |> validateField #name nonEmpty
            |> validateField #domain nonEmpty
            |> validateField #hubKind (isInList ["framework", "domain", "shared"])
            |> ifValid \case
                Left hub -> render EditView { hub }
                Right hub -> do
                    updateRecord hub
                    setSuccessMessage "Hub updated"
                    redirectTo ShowHubAction { hubId = hub.id }

    action DeleteHubAction { hubId } = do
        hub <- fetch hubId
        deleteRecord hub
        setSuccessMessage "Hub deleted"
        redirectTo HubsAction

    action TriageDashboardAction { hubId } = autoRefresh do
        hub     <- fetch hubId
        widgets <- query @Widget
            |> filterWhere (#hubId, hubId)
            |> fetch
        let widgetIds = map (.id) widgets

        -- All candidates for this hub's widgets
        allCandidates <- query @RequirementCandidate
            |> filterWhereIn (#sourceWidgetId, widgetIds)
            |> orderByAsc #createdAt
            |> fetch

        -- Triage queue: open candidates, oldest first
        let triageQueue = filter (\c -> c.status == "open") allCandidates

        -- Recent escalations: last 20
        recentEscalations <- query @RequirementCandidate
            |> filterWhereIn (#sourceWidgetId, widgetIds)
            |> orderByDesc #createdAt
            |> limit 20
            |> fetch

        -- All annotations for category breakdown
        allAnnotations <- query @Annotation
            |> filterWhereIn (#widgetId, widgetIds)
            |> fetch

        render TriageDashboardView
            { hub
            , widgets
            , allCandidates
            , triageQueue
            , recentEscalations
            , allAnnotations
            }

    action GovernanceDashboardAction { hubId } = autoRefresh do
        hub     <- fetch hubId
        widgets <- query @Widget
            |> filterWhere (#hubId, hubId)
            |> fetch
        let widgetIds = map (.id) widgets

        -- All requirements whose source candidate is in this hub's widgets
        allCandidates <- query @RequirementCandidate
            |> filterWhereIn (#sourceWidgetId, widgetIds)
            |> fetch
        let acceptedCandidateIds = map (.id) (filter (\c -> c.status == "accepted") allCandidates)

        allRequirements <- query @Requirement
            |> filterWhereIn (#sourceCandidateId, acceptedCandidateIds)
            |> fetch

        -- Recent decisions (last 20) — scoped to this hub's requirements
        let requirementIds = map (.id) allRequirements
        recentDecisions <- query @DecisionRecord
            |> filterWhereIn (#requirementId, map Just requirementIds)
            |> orderByDesc #decidedAt
            |> limit 20
            |> fetch

        -- All hub decisions (for outcome counts)
        allDecisions <- query @DecisionRecord
            |> filterWhereIn (#requirementId, map Just requirementIds)
            |> fetch

        -- All annotations for traceability coverage
        allAnnotations <- query @Annotation
            |> filterWhereIn (#widgetId, widgetIds)
            |> fetch

        -- Outcome signals for regression detection
        allSignals <- query @OutcomeSignal
            |> filterWhereIn (#widgetId, widgetIds)
            |> fetch

        let regressionWidgetIds = regressedWidgetIds allSignals allAnnotations

        render GovernanceDashboardView
            { hub
            , widgets
            , allCandidates
            , allRequirements
            , recentDecisions
            , allDecisions
            , allAnnotations
            , regressionWidgetIds
            }

    action AntifragilityDashboardAction { hubId } = autoRefresh do
        hub     <- fetch hubId
        widgets <- query @Widget
            |> filterWhere (#hubId, hubId)
            |> fetch
        let widgetIds = map (.id) widgets

        -- Deployments for this hub's decisions
        allCandidates <- query @RequirementCandidate
            |> filterWhereIn (#sourceWidgetId, widgetIds)
            |> fetch
        let acceptedCandidateIds = map (.id) (filter (\c -> c.status == "accepted") allCandidates)
        allRequirements <- query @Requirement
            |> filterWhereIn (#sourceCandidateId, acceptedCandidateIds)
            |> fetch
        let requirementIds = map (.id) allRequirements
        allDecisions <- query @DecisionRecord
            |> filterWhereIn (#requirementId, map Just requirementIds)
            |> fetch
        let decisionIds = map (.id) allDecisions
        allDeployments <- query @DeploymentRecord
            |> filterWhereIn (#decisionId, decisionIds)
            |> orderByDesc #deployedAt
            |> fetch
        let deploymentIds = map (.id) allDeployments
        allSignals <- query @OutcomeSignal
            |> filterWhereIn (#widgetId, widgetIds)
            |> fetch
        allEvaluations <- query @ChangeEvaluation
            |> filterWhereIn (#deploymentId, deploymentIds)
            |> fetch
        allImplRefs <- query @ImplementationChangeReference
            |> filterWhereIn (#decisionId, decisionIds)
            |> fetch
        allAnnotations <- query @Annotation
            |> filterWhereIn (#widgetId, widgetIds)
            |> fetch

        let regressionWidgetIds     = regressedWidgetIds allSignals allAnnotations
            recurrenceLeaderboard   = take 10 (widgetCycleCounts allCandidates allRequirements allDecisions allDeployments)

        render AntifragilityDashboardView
            { hub
            , widgets
            , allDeployments
            , allDecisions
            , allSignals
            , allEvaluations
            , allImplRefs
            , regressionWidgetIds
            , recurrenceLeaderboard
            }
    action AgentAuditDashboardAction { hubId } = autoRefresh do
        hub       <- fetch hubId
        proposals <- query @AgentProposal
            |> orderByDesc #createdAt
            |> fetch
        reviews   <- query @AgentReviewRecord |> fetch
        widgets   <- query @Widget |> fetch
        render AgentAuditDashboardView { hub, proposals, reviews, widgets }

    action AdapterCompatibilityDashboardAction { hubId } = autoRefresh do
        hub      <- fetch hubId
        specs    <- query @WidgetAdapterSpec |> orderByAsc #name |> fetch
        widgets  <- query @Widget |> filterWhere (#hubId, hubId) |> fetch
        envelopes  <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch
        reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch
        render AdapterCompatibilityDashboardView { hub, specs, widgets, envelopes, reportings }

    action FrictionHeatmapAction { hubId } = autoRefresh do
        hub     <- fetch hubId
        widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch
        let widgetIds = map (.id) widgets
        frictionScores <- query @FrictionScore
            |> filterWhereIn (#widgetId, widgetIds)
            |> fetch
        render FrictionHeatmapView { hub, widgets, frictionScores }

    action RecomputeFrictionAction { hubId } = do
        hub     <- fetch hubId
        widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch
        let widgetIds = map (.id) widgets
        annotations <- query @Annotation |> filterWhereIn (#widgetId, widgetIds) |> fetch
        events      <- query @InteractionEvent |> filterWhereIn (#widgetId, widgetIds) |> fetch
        signals     <- query @OutcomeSignal |> filterWhereIn (#widgetId, widgetIds) |> fetch
        candidates  <- query @RequirementCandidate |> filterWhereIn (#sourceWidgetId, widgetIds) |> fetch
        let regressionWids = regressedWidgetIds signals annotations
        mapM_ (\w ->
            let wAnnotations = filter (\a -> a.widgetId == w.id) annotations
                wEvents      = filter (\e -> e.widgetId == w.id) events
                wCandidates  = filter (\c -> c.sourceWidgetId == w.id) candidates
                isRegressed  = w.id `elem` regressionWids
            in computeFrictionScore w.id wAnnotations wEvents isRegressed wCandidates
            ) widgets
        setSuccessMessage "Friction scores recomputed"
        redirectTo FrictionHeatmapAction { hubId }

    action BottleneckDashboardAction { hubId } = autoRefresh do
        hub        <- fetch hubId
        widgets    <- query @Widget |> filterWhere (#hubId, hubId) |> fetch
        bottlenecks <- query @BottleneckRecord
            |> filterWhere (#hubId, hubId)
            |> orderByAsc #stalledSince
            |> fetch
        render BottleneckDashboardView { hub, widgets, bottlenecks }

    action DetectBottlenecksAction { hubId } = do
        hub        <- fetch hubId
        widgets    <- query @Widget |> filterWhere (#hubId, hubId) |> fetch
        let widgetIds = map (.id) widgets
        candidates  <- query @RequirementCandidate |> filterWhereIn (#sourceWidgetId, widgetIds) |> fetch
        let candidateIds = map (.id) candidates
            acceptedIds  = map (.id) (filter (\c -> c.status == "accepted") candidates)
        requirements <- query @Requirement |> filterWhereIn (#sourceCandidateId, acceptedIds) |> fetch
        let reqIds = map (.id) requirements
        decisions <- query @DecisionRecord
            |> filterWhereIn (#requirementId, map Just reqIds)
            |> fetch
        let decisionIds = map (.id) decisions
        deployments <- query @DeploymentRecord |> filterWhereIn (#decisionId, decisionIds) |> fetch
        _ <- detectBottlenecks hubId widgets candidates requirements decisions deployments
        setSuccessMessage "Bottleneck detection complete"
        redirectTo BottleneckDashboardAction { hubId }

    action ResolveBottleneckAction { bottleneckRecordId } = do
        bottleneck <- fetch bottleneckRecordId
        now <- getCurrentTime
        bottleneck |> set #resolvedAt (Just now) |> updateRecord
        setSuccessMessage "Bottleneck resolved"
        redirectTo BottleneckDashboardAction { hubId = bottleneck.hubId }

    action SnapshotHubHealthAction { hubId } = do
        hub        <- fetch hubId
        widgets    <- query @Widget |> filterWhere (#hubId, hubId) |> fetch
        let widgetIds = map (.id) widgets
        candidates  <- query @RequirementCandidate |> filterWhereIn (#sourceWidgetId, widgetIds) |> fetch
        let acceptedIds  = map (.id) (filter (\c -> c.status == "accepted") candidates)
        requirements <- query @Requirement |> filterWhereIn (#sourceCandidateId, acceptedIds) |> fetch
        let reqIds = map (.id) requirements
        decisions <- query @DecisionRecord |> filterWhereIn (#requirementId, map Just reqIds) |> fetch
        let decisionIds = map (.id) decisions
        deployments <- query @DeploymentRecord |> filterWhereIn (#decisionId, decisionIds) |> fetch
        signals    <- query @OutcomeSignal |> filterWhereIn (#widgetId, widgetIds) |> fetch
        annotations <- query @Annotation  |> filterWhereIn (#widgetId, widgetIds) |> fetch
        bottlenecks <- query @BottleneckRecord
            |> filterWhere (#hubId, hubId)
            |> filterWhereSql (#resolvedAt, "IS NULL")
            |> fetch
        _ <- computeHubHealth hubId widgets candidates decisions deployments signals annotations bottlenecks
        setSuccessMessage "Hub health snapshot taken"
        redirectTo HubHealthHistoryAction { hubId }

    action HubHealthHistoryAction { hubId } = autoRefresh do
        hub       <- fetch hubId
        snapshots <- query @HubHealthSnapshot
            |> filterWhere (#hubId, hubId)
            |> orderByDesc #computedAt
            |> fetch
        render HubHealthHistoryView { hub, snapshots }

    action OperationalReviewBoardAction = autoRefresh do
        hubs               <- query @Hub |> orderByAsc #name |> fetch
        allSnapshots       <- query @HubHealthSnapshot |> orderByDesc #computedAt |> fetch
        topFrictionScores  <- query @FrictionScore |> orderByDesc #score |> limit 10 |> fetch
        topWidgets         <- mapM (\fs -> fetch fs.widgetId) topFrictionScores
        bottlenecks        <- query @BottleneckRecord
            |> filterWhereSql (#resolvedAt, "IS NULL")
            |> orderByAsc #stage
            |> fetch
        propagations       <- query @CrossHubPropagation
            |> orderByDesc #detectedAt
            |> fetch
        let openPropagations = filter (\p -> p.status `elem` ["open","acknowledged"]) propagations
        render OperationalReviewBoardView
            { hubs
            , allSnapshots
            , topFrictionScores
            , topWidgets
            , bottlenecks
            , openPropagations
            }