inter-hub/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 Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.Controller (regressedWidgetIds, widgetCycleCounts)

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
        widgetIds <- pure (map (.id) widgets)
        recentEvents <- sqlQuery
            "SELECT * FROM interaction_events WHERE widget_id = ANY(?) ORDER BY occurred_at DESC LIMIT 50"
            (Only (PGArray widgetIds))
        recentAnnotations <- sqlQuery
            "SELECT * FROM annotations WHERE widget_id = ANY(?) ORDER BY created_at DESC LIMIT 20"
            (Only (PGArray widgetIds))
        render ShowView { hub, widgets, recentEvents, recentAnnotations }

    action CreateHubAction = do
        let hub = newRecord @Hub
        hub
            |> fill @'["slug", "name", "domain"]
            |> validateField #slug nonEmpty
            |> validateField #name nonEmpty
            |> validateField #domain nonEmpty
            |> 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"]
            |> validateField #slug nonEmpty
            |> validateField #name nonEmpty
            |> validateField #domain nonEmpty
            |> 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
            }