inter-hub-haskell/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
        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 }