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

module Web.Controller.HubRoutingRules where

import Web.Types
import Web.View.HubRoutingRules.Index
import Web.View.HubRoutingRules.Show
import Web.View.HubRoutingRules.New
import Web.View.HubRoutingRules.Edit
import Web.View.HubRoutingRules.RoutedCandidates
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.RoutingEngine (applyRoutingRules)

instance Controller HubRoutingRulesController where
    beforeAction = ensureIsUser

    action HubRoutingRulesAction = autoRefresh do
        rules <- query @HubRoutingRule |> orderByDesc #priority |> fetch
        hubs  <- query @Hub |> fetch
        render IndexView { rules, hubs }

    action ShowHubRoutingRuleAction { hubRoutingRuleId } = do
        rule      <- fetch hubRoutingRuleId
        sourceHub <- fetch rule.sourceHubId
        targetHub <- fetch rule.targetHubId
        render ShowView { rule, sourceHub, targetHub }

    action NewHubRoutingRuleAction = do
        let rule = newRecord @HubRoutingRule
        hubs <- query @Hub |> orderByAsc #name |> fetch
        render NewView { rule, hubs }

    action CreateHubRoutingRuleAction = do
        let rule = newRecord @HubRoutingRule
        hubs <- query @Hub |> orderByAsc #name |> fetch
        rule
            |> fill @'["sourceHubId","targetHubId","matchCategory","matchWidgetType","priority","notes"]
            |> validateField #sourceHubId nonEmpty
            |> validateField #targetHubId nonEmpty
            |> ifValid \case
                Left r  -> render NewView { rule = r, hubs }
                Right r -> do
                    r <- createRecord r
                    setSuccessMessage "Routing rule created"
                    redirectTo ShowHubRoutingRuleAction { hubRoutingRuleId = r.id }

    action EditHubRoutingRuleAction { hubRoutingRuleId } = do
        rule <- fetch hubRoutingRuleId
        hubs <- query @Hub |> orderByAsc #name |> fetch
        render EditView { rule, hubs }

    action UpdateHubRoutingRuleAction { hubRoutingRuleId } = do
        rule <- fetch hubRoutingRuleId
        hubs <- query @Hub |> orderByAsc #name |> fetch
        rule
            |> fill @'["matchCategory","matchWidgetType","priority","notes"]
            |> ifValid \case
                Left r  -> render EditView { rule = r, hubs }
                Right r -> do
                    updateRecord r
                    setSuccessMessage "Routing rule updated"
                    redirectTo ShowHubRoutingRuleAction { hubRoutingRuleId = r.id }

    action ActivateRoutingRuleAction { hubRoutingRuleId } = do
        rule <- fetch hubRoutingRuleId
        rule |> set #status "active" |> updateRecord
        setSuccessMessage "Rule activated"
        redirectTo HubRoutingRulesAction

    action DeactivateRoutingRuleAction { hubRoutingRuleId } = do
        rule <- fetch hubRoutingRuleId
        rule |> set #status "inactive" |> updateRecord
        setSuccessMessage "Rule deactivated"
        redirectTo HubRoutingRulesAction

    action RoutedCandidatesAction { hubId } = autoRefresh do
        hub        <- fetch hubId
        candidates <- query @RequirementCandidate
            |> filterWhere (#routedToHubId, Just hubId)
            |> orderByDesc #createdAt
            |> fetch
        render RoutedCandidatesView { hub, candidates }

    action RouteNowAction { requirementCandidateId } = do
        candidate <- fetch requirementCandidateId
        widgets   <- query @Widget |> fetch
        _         <- applyRoutingRules candidate widgets
        setSuccessMessage "Routing re-evaluated"
        redirectTo ShowRequirementCandidateAction { requirementCandidateId }