module Web.Controller.RequirementCandidates where import Web.Types import Web.View.RequirementCandidates.Index import Web.View.RequirementCandidates.Show import Web.View.RequirementCandidates.New import Web.View.RequirementCandidates.Edit import Generated.Types import IHP.Prelude import IHP.ControllerPrelude validStatuses :: [Text] validStatuses = ["open", "in_review", "accepted", "rejected", "deferred"] validCategories :: [Text] validCategories = ["friction", "defect", "wish", "policy_concern", "doc_gap", "trust", "other"] -- Allowed triage transitions allowedTransition :: Text -> Text -> Bool allowedTransition "open" "in_review" = True allowedTransition "in_review" "accepted" = True allowedTransition "in_review" "rejected" = True allowedTransition "in_review" "deferred" = True allowedTransition "deferred" "in_review" = True allowedTransition _ _ = False instance Controller RequirementCandidatesController where beforeAction = ensureIsUser action RequirementCandidatesAction = do mStatusFilter <- paramOrNothing @Text "status" candidates <- case mStatusFilter of Nothing -> query @RequirementCandidate |> orderByDesc #createdAt |> fetch Just s -> query @RequirementCandidate |> filterWhere (#status, s) |> orderByDesc #createdAt |> fetch -- Fetch reviewer assignments for display assignments <- query @ReviewerAssignment |> fetch users <- query @User |> fetch widgets <- query @Widget |> fetch render IndexView { candidates, assignments, users, widgets, mStatusFilter } action ShowRequirementCandidateAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId widget <- fetch candidate.sourceWidgetId triageStates <- query @TriageState |> filterWhere (#candidateId, requirementCandidateId) |> orderByAsc #changedAt |> fetch mAssignment <- query @ReviewerAssignment |> filterWhere (#candidateId, requirementCandidateId) |> fetchOneOrNothing users <- query @User |> fetch mSourceAnnotation <- case candidate.sourceAnnotationId of Nothing -> pure Nothing Just aid -> fetchOneOrNothing aid mSourceThread <- case candidate.sourceThreadId of Nothing -> pure Nothing Just tid -> fetchOneOrNothing tid render ShowView { candidate, widget, triageStates, mAssignment, users, mSourceAnnotation, mSourceThread } action NewRequirementCandidateAction = do widgets <- query @Widget |> fetch threads <- query @AnnotationThread |> fetch let candidate = newRecord @RequirementCandidate render NewView { candidate, widgets, threads } action CreateRequirementCandidateAction = do widgets <- query @Widget |> fetch threads <- query @AnnotationThread |> fetch mUser <- currentUserOrNothing let createdBy = fmap (.id) mUser let candidate = newRecord @RequirementCandidate candidate |> fill @'["title", "description", "sourceWidgetId", "sourceThreadId", "category"] |> set #status "open" |> set #createdBy (fmap (Id . unId) createdBy) |> validateField #title nonEmpty |> validateField #description nonEmpty |> validateField #category (`elem` validCategories) |> ifValid \case Left candidate -> render NewView { candidate, widgets, threads } Right candidate -> do created <- createRecord candidate setSuccessMessage "Requirement candidate created" redirectTo ShowRequirementCandidateAction { requirementCandidateId = created.id } action EditRequirementCandidateAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId widgets <- query @Widget |> fetch threads <- query @AnnotationThread |> fetch render EditView { candidate, widgets, threads } action UpdateRequirementCandidateAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId widgets <- query @Widget |> fetch threads <- query @AnnotationThread |> fetch candidate |> fill @'["title", "description", "sourceWidgetId", "sourceThreadId", "category"] |> validateField #title nonEmpty |> validateField #description nonEmpty |> validateField #category (`elem` validCategories) |> ifValid \case Left candidate -> render EditView { candidate, widgets, threads } Right candidate -> do updateRecord candidate setSuccessMessage "Candidate updated" redirectTo ShowRequirementCandidateAction { requirementCandidateId } action UpdateTriageStatusAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId newStatus <- param @Text "status" notes <- paramOrNothing @Text "notes" mUser <- currentUserOrNothing let changedBy = fmap (.id) mUser if allowedTransition candidate.status newStatus then do -- Insert triage state row (append-only audit trail) newRecord @TriageState |> set #candidateId requirementCandidateId |> set #status newStatus |> set #notes notes |> set #changedBy (fmap (Id . unId) changedBy) |> createRecord -- Update current status on candidate candidate |> set #status newStatus |> updateRecord setSuccessMessage ("Status updated to " <> newStatus) redirectTo ShowRequirementCandidateAction { requirementCandidateId } else do setErrorMessage ("Invalid transition: " <> candidate.status <> " → " <> newStatus) respondWith 422 do redirectTo ShowRequirementCandidateAction { requirementCandidateId } action AssignReviewerAction { requirementCandidateId } = do userId <- param @(Id User) "userId" mUser <- currentUserOrNothing let assignedBy = fmap (.id) mUser -- Upsert: delete existing assignment then insert existing <- query @ReviewerAssignment |> filterWhere (#candidateId, requirementCandidateId) |> fetchOneOrNothing case existing of Just ra -> deleteRecord ra Nothing -> pure () newRecord @ReviewerAssignment |> set #candidateId requirementCandidateId |> set #userId userId |> set #assignedBy (fmap (Id . unId) assignedBy) |> createRecord setSuccessMessage "Reviewer assigned" redirectTo ShowRequirementCandidateAction { requirementCandidateId } action MyQueueAction = do mUser <- currentUserOrNothing case mUser of Nothing -> redirectTo RequirementCandidatesAction Just user -> do assignments <- query @ReviewerAssignment |> filterWhere (#userId, user.id) |> fetch let candidateIds = map (.candidateId) assignments candidates <- mapM fetch candidateIds let active = filter (\c -> c.status `elem` ["open", "in_review"]) candidates widgets <- query @Widget |> fetch render IndexView { candidates = active , assignments , users = [user] , widgets , mStatusFilter = Just "my_queue" } action PromoteToRequirementAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId -- Guard: only accepted candidates may be promoted when (candidate.status /= "accepted") do setErrorMessage "Only accepted candidates can be promoted to a requirement" respondWith 422 do redirectTo ShowRequirementCandidateAction { requirementCandidateId } -- Idempotent: if already promoted, redirect to existing requirement case candidate.requirementId of Just rid -> redirectTo ShowRequirementAction { requirementId = rid } Nothing -> do mUser <- currentUserOrNothing let createdBy = fmap (.id) mUser req <- newRecord @Requirement |> set #title candidate.title |> set #description candidate.description |> set #sourceCandidateId requirementCandidateId |> set #status "active" |> set #createdBy (fmap (Id . unId) createdBy) |> createRecord candidate |> set #requirementId (Just req.id) |> updateRecord setSuccessMessage "Promoted to requirement" redirectTo ShowRequirementAction { requirementId = req.id } action LinkToDecisionAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId -- Guard: only accepted candidates when (candidate.status /= "accepted") do setErrorMessage "Only accepted candidates can be linked to a decision" respondWith 422 do redirectTo ShowRequirementCandidateAction { requirementCandidateId } -- Idempotent: check if a decision already links to this candidate existing <- query @DecisionRecord |> filterWhere (#candidateId, Just requirementCandidateId) |> fetchOneOrNothing case existing of Just dr -> redirectTo ShowDecisionRecordAction { decisionRecordId = dr.id } Nothing -> do mUser <- currentUserOrNothing let decidedBy = fmap (.id) mUser -- Use promoted requirement id if available let mReqId = candidate.requirementId dr <- newRecord @DecisionRecord |> set #title candidate.title |> set #rationale candidate.description |> set #outcome "accepted" |> set #candidateId (Just requirementCandidateId) |> set #requirementId mReqId |> set #decidedBy (fmap (Id . unId) decidedBy) |> createRecord setSuccessMessage "Decision record created" redirectTo ShowDecisionRecordAction { decisionRecordId = dr.id }