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

module Web.Controller.DecisionRecords where

import Web.Types
import Web.View.DecisionRecords.Index
import Web.View.DecisionRecords.Show
import Web.View.DecisionRecords.New
import Web.View.DecisionRecords.Edit
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.Controller (callClaudeApi)
import Data.List (intercalate)

validOutcomes :: [Text]
validOutcomes = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]

validPolicyScopes :: [Text]
validPolicyScopes = ["internal", "external", "regulatory", "contractual", "architectural"]

validSystems :: [Text]
validSystems = ["github", "linear", "jira", "other"]

instance Controller DecisionRecordsController where
    beforeAction = ensureIsUser

    action DecisionRecordsAction = do
        mOutcomeFilter <- paramOrNothing @Text "outcome"
        records <- case mOutcomeFilter of
            Nothing -> query @DecisionRecord |> orderByDesc #decidedAt |> fetch
            Just o  -> query @DecisionRecord
                |> filterWhere (#outcome, o)
                |> orderByDesc #decidedAt
                |> fetch
        requirements <- query @Requirement |> fetch
        users        <- query @User |> fetch
        render IndexView { records, requirements, users, mOutcomeFilter }

    action ShowDecisionRecordAction { decisionRecordId } = do
        record            <- fetch decisionRecordId
        policyRefs        <- query @PolicyReference
            |> filterWhere (#decisionId, decisionRecordId)
            |> orderByAsc #createdAt
            |> fetch
        implRefs          <- query @ImplementationChangeReference
            |> filterWhere (#decisionId, decisionRecordId)
            |> orderByAsc #linkedAt
            |> fetch
        deploymentRecords <- query @DeploymentRecord
            |> filterWhere (#decisionId, decisionRecordId)
            |> orderByDesc #deployedAt
            |> fetch
        let deploymentIds = map (.id) deploymentRecords
        evaluations       <- query @ChangeEvaluation
            |> filterWhereIn (#deploymentId, deploymentIds)
            |> fetch
        mRequirement      <- case record.requirementId of
            Nothing  -> pure Nothing
            Just rid -> fetchOneOrNothing rid
        mCandidate        <- case record.candidateId of
            Nothing  -> pure Nothing
            Just cid -> fetchOneOrNothing cid
        users             <- query @User |> fetch
        render ShowView
            { record
            , policyRefs
            , implRefs
            , deploymentRecords
            , evaluations
            , mRequirement
            , mCandidate
            , users
            }

    action NewDecisionRecordAction = do
        requirements <- query @Requirement |> fetch
        candidates   <- query @RequirementCandidate |> fetch
        users        <- query @User |> fetch
        let record = newRecord @DecisionRecord
        render NewView { record, requirements, candidates, users }

    action CreateDecisionRecordAction = do
        requirements <- query @Requirement |> fetch
        candidates   <- query @RequirementCandidate |> fetch
        users        <- query @User |> fetch
        mUser        <- currentUserOrNothing
        let decidedBy = fmap (.id) mUser

        let record = newRecord @DecisionRecord
        record
            |> fill @'["title", "rationale", "outcome", "requirementId", "candidateId", "notes"]
            |> set #decidedBy (fmap (Id . unId) decidedBy)
            |> validateField #title nonEmpty
            |> validateField #rationale nonEmpty
            |> validateField #outcome (`elem` validOutcomes)
            |> ifValid \case
                Left record -> render NewView { record, requirements, candidates, users }
                Right record -> do
                    created <- createRecord record
                    setSuccessMessage "Decision record created"
                    redirectTo ShowDecisionRecordAction { decisionRecordId = created.id }

    action EditDecisionRecordAction { decisionRecordId } = do
        record       <- fetch decisionRecordId
        requirements <- query @Requirement |> fetch
        candidates   <- query @RequirementCandidate |> fetch
        users        <- query @User |> fetch
        render EditView { record, requirements, candidates, users }

    action UpdateDecisionRecordAction { decisionRecordId } = do
        record       <- fetch decisionRecordId
        requirements <- query @Requirement |> fetch
        candidates   <- query @RequirementCandidate |> fetch
        users        <- query @User |> fetch

        -- Outcome is immutable: only update non-outcome fields
        record
            |> fill @'["title", "rationale", "requirementId", "candidateId", "notes"]
            |> validateField #title nonEmpty
            |> validateField #rationale nonEmpty
            |> ifValid \case
                Left record -> render EditView { record, requirements, candidates, users }
                Right record -> do
                    updateRecord record
                    setSuccessMessage "Decision record updated"
                    redirectTo ShowDecisionRecordAction { decisionRecordId }

    action AddPolicyReferenceAction { decisionRecordId } = do
        mUser <- currentUserOrNothing
        let createdBy = fmap (.id) mUser
        policyScope    <- param @Text "policyScope"
        constraintNote <- paramOrNothing @Text "constraintNote"
        unless (policyScope `elem` validPolicyScopes) do
            setErrorMessage ("Invalid policy scope: " <> policyScope)
            respondWith 422 do
                redirectTo ShowDecisionRecordAction { decisionRecordId }
        newRecord @PolicyReference
            |> set #decisionId decisionRecordId
            |> set #policyScope policyScope
            |> set #constraintNote constraintNote
            |> set #createdBy (fmap (Id . unId) createdBy)
            |> createRecord
        setSuccessMessage "Policy reference added"
        redirectTo ShowDecisionRecordAction { decisionRecordId }

    action DeletePolicyReferenceAction { policyReferenceId } = do
        ref <- fetch policyReferenceId
        let decisionRecordId = ref.decisionId
        deleteRecord ref
        setSuccessMessage "Policy reference removed"
        redirectTo ShowDecisionRecordAction { decisionRecordId }

    action AddImplementationRefAction { decisionRecordId } = do
        mUser       <- currentUserOrNothing
        let linkedBy = fmap (.id) mUser
        workItemRef <- param @Text "workItemRef"
        system      <- param @Text "system"
        unless (system `elem` validSystems) do
            setErrorMessage ("Invalid system: " <> system)
            respondWith 422 do
                redirectTo ShowDecisionRecordAction { decisionRecordId }
        when (workItemRef == "") do
            setErrorMessage "Work item reference cannot be empty"
            respondWith 422 do
                redirectTo ShowDecisionRecordAction { decisionRecordId }
        newRecord @ImplementationChangeReference
            |> set #decisionId decisionRecordId
            |> set #workItemRef workItemRef
            |> set #system system
            |> set #linkedBy (fmap (Id . unId) linkedBy)
            |> createRecord
        setSuccessMessage "Implementation reference added"
        redirectTo ShowDecisionRecordAction { decisionRecordId }

    action DeleteImplementationRefAction { implementationChangeReferenceId } = do
        ref <- fetch implementationChangeReferenceId
        let decisionRecordId = ref.decisionId
        deleteRecord ref
        setSuccessMessage "Implementation reference removed"
        redirectTo ShowDecisionRecordAction { decisionRecordId }

    -- T07: Propose implementation paths via Claude API
    action ProposeImplementationAction { decisionRecordId } = do
        record   <- fetch decisionRecordId
        implRefs <- query @ImplementationChangeReference
            |> filterWhere (#decisionId, decisionRecordId)
            |> fetch
        mRequirement <- case record.requirementId of
            Nothing  -> pure Nothing
            Just rid -> fetchOneOrNothing rid
        let implLines = map (\r -> r.system <> ": " <> r.workItemRef) implRefs
            reqDesc   = maybe "" (.description) mRequirement
            userMsg   = "Decision: " <> record.title
                     <> "\nRationale: " <> record.rationale
                     <> "\nOutcome: " <> record.outcome
                     <> "\nRequirement: " <> reqDesc
                     <> "\nExisting impl refs: " <> intercalate ", " implLines
        result <- liftIO $ callClaudeApi
            "You are a traceability-aware implementation analyst. Propose 1\x20133 concrete implementation paths for this decision. Each path should include a work_item_ref (e.g. PROJ-123), a system (github|linear|jira), and a rationale. Respond with JSON: {\"proposals\": [{\"work_item_ref\": \"...\", \"system\": \"...\", \"rationale\": \"...\"}]}."
            userMsg
            600
        case result of
            Left err -> do
                setErrorMessage ("Implementation proposal failed: " <> err)
                redirectTo ShowDecisionRecordAction { decisionRecordId }
            Right content -> do
                newRecord @AgentProposal
                    |> set #proposalType "impl_proposal"
                    |> set #sourceDecisionId (Just decisionRecordId)
                    |> set #content content
                    |> set #modelRef "claude-sonnet-4-6"
                    |> set #status "pending"
                    |> createRecord
                setSuccessMessage "Implementation proposal created"
                redirectTo ShowDecisionRecordAction { decisionRecordId }