inter-hub/Web/Controller/AgentProposals.hs

module Web.Controller.AgentProposals where

import Web.Types
import Web.View.AgentProposals.Index
import Web.View.AgentProposals.Show
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (decode)
import Data.ByteString.Lazy (fromStrict)
import Data.Text.Encoding (encodeUtf8)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap

instance Controller AgentProposalsController where
    beforeAction = ensureIsUser

    action AgentProposalsAction = do
        let mTypeFilter   = paramOrNothing @Text "proposal_type"
            mStatusFilter = paramOrNothing @Text "status"
        proposals <- case (mTypeFilter, mStatusFilter) of
            (Nothing, Nothing) ->
                query @AgentProposal |> orderByDesc #createdAt |> fetch
            (Just t, Nothing) ->
                query @AgentProposal
                    |> filterWhere (#proposalType, t)
                    |> orderByDesc #createdAt |> fetch
            (Nothing, Just s) ->
                query @AgentProposal
                    |> filterWhere (#status, s)
                    |> orderByDesc #createdAt |> fetch
            (Just t, Just s) ->
                query @AgentProposal
                    |> filterWhere (#proposalType, t)
                    |> filterWhere (#status, s)
                    |> orderByDesc #createdAt |> fetch
        widgets  <- query @Widget |> fetch
        render IndexView { proposals, widgets, mTypeFilter, mStatusFilter }

    action ShowAgentProposalAction { agentProposalId } = do
        proposal    <- fetch agentProposalId
        mWidget     <- case proposal.sourceWidgetId of
            Nothing  -> pure Nothing
            Just wid -> fetchOneOrNothing wid
        mCandidate  <- case proposal.sourceCandidateId of
            Nothing  -> pure Nothing
            Just cid -> fetchOneOrNothing cid
        mDecision   <- case proposal.sourceDecisionId of
            Nothing  -> pure Nothing
            Just did -> fetchOneOrNothing did
        mReview     <- query @AgentReviewRecord
            |> filterWhere (#proposalId, agentProposalId)
            |> fetchOneOrNothing
        confidences <- query @ConfidenceAnnotation
            |> filterWhere (#proposalId, agentProposalId)
            |> orderByAsc #createdAt
            |> fetch
        users       <- query @User |> fetch
        render ShowView
            { proposal, mWidget, mCandidate, mDecision
            , mReview, confidences, users }

    action AcceptProposalAction { agentProposalId } = do
        proposal  <- fetch agentProposalId
        mExisting <- query @AgentReviewRecord
            |> filterWhere (#proposalId, agentProposalId)
            |> fetchOneOrNothing
        case mExisting of
            Just _ -> do
                setSuccessMessage "Already reviewed"
                redirectTo ShowAgentProposalAction { agentProposalId }
            Nothing -> do
                let mUser = currentUserOrNothing
                let reviewerId = fmap (.id) mUser
                proposal
                    |> set #status "accepted"
                    |> updateRecord
                let notes = paramOrNothing @Text "notes"
                newRecord @AgentReviewRecord
                    |> set #proposalId agentProposalId
                    |> set #reviewerId (reviewerId)
                    |> set #decision "accepted"
                    |> set #notes notes
                    |> createRecord
                -- T04: if requirement_draft, promote to RequirementCandidate
                when (proposal.proposalType == "requirement_draft") do
                    let mParsed = decode (fromStrict (encodeUtf8 proposal.content))
                                    :: Maybe (HashMap Text Text)
                    case (mParsed, proposal.sourceWidgetId) of
                        (Just m, Just srcWid) -> do
                            let title = fromMaybe "AI Draft" (HashMap.lookup "title" m)
                                desc  = fromMaybe ""         (HashMap.lookup "description" m)
                            newRecord @RequirementCandidate
                                |> set #title title
                                |> set #description desc
                                |> set #sourceWidgetId srcWid
                                |> set #category "friction"
                                |> set #status "open"
                                |> createRecord
                            setSuccessMessage "Requirement candidate created from AI draft"
                        _ ->
                            setSuccessMessage "Proposal accepted (could not create candidate)"
                redirectTo ShowAgentProposalAction { agentProposalId }

    action RejectProposalAction { agentProposalId } = do
        proposal  <- fetch agentProposalId
        mExisting <- query @AgentReviewRecord
            |> filterWhere (#proposalId, agentProposalId)
            |> fetchOneOrNothing
        case mExisting of
            Just _ -> do
                setSuccessMessage "Already reviewed"
                redirectTo ShowAgentProposalAction { agentProposalId }
            Nothing -> do
                let mUser = currentUserOrNothing
                let reviewerId = fmap (.id) mUser
                proposal
                    |> set #status "rejected"
                    |> updateRecord
                let notes = paramOrNothing @Text "notes"
                newRecord @AgentReviewRecord
                    |> set #proposalId agentProposalId
                    |> set #reviewerId (reviewerId)
                    |> set #decision "rejected"
                    |> set #notes notes
                    |> createRecord
                setSuccessMessage "Proposal rejected"
                redirectTo ShowAgentProposalAction { agentProposalId }