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 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 mUser <- currentUserOrNothing let reviewerId = fmap (.id) mUser proposal |> set #status "accepted" |> updateRecord notes <- paramOrNothing @Text "notes" newRecord @AgentReviewRecord |> set #proposalId agentProposalId |> set #reviewerId (fmap (Id . unId) 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 of Just m -> 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 proposal.sourceWidgetId |> set #category "friction" |> set #status "open" |> createRecord setSuccessMessage "Requirement candidate created from AI draft" Nothing -> setSuccessMessage "Proposal accepted (could not parse JSON for 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 mUser <- currentUserOrNothing let reviewerId = fmap (.id) mUser proposal |> set #status "rejected" |> updateRecord notes <- paramOrNothing @Text "notes" newRecord @AgentReviewRecord |> set #proposalId agentProposalId |> set #reviewerId (fmap (Id . unId) reviewerId) |> set #decision "rejected" |> set #notes notes |> createRecord setSuccessMessage "Proposal rejected" redirectTo ShowAgentProposalAction { agentProposalId }