diff --git a/ai-code-mcp-server.el b/ai-code-mcp-server.el index dd8d17d..827cb51 100644 --- a/ai-code-mcp-server.el +++ b/ai-code-mcp-server.el @@ -74,6 +74,16 @@ Use `auto' to prefer Flycheck and then Flymake when available." (const :tag "Flymake" flymake)) :group 'ai-code-mcp-server) +(defcustom ai-code-mcp-diagnostics-max-report-diagnostics 200 + "Maximum number of diagnostics listed in a `get_diagnostics' report. +When a report would exceed this many diagnostics, the observation envelope +lists only the first this-many and records the truncation in its summary, so a +large project cannot overflow the model context. The summary always reports +the true totals. Set to nil to disable truncation; otherwise the value must +be a non-negative integer." + :type '(choice (const :tag "No limit" nil) natnum) + :group 'ai-code-mcp-server) + (defvar ai-code-mcp--sessions (make-hash-table :test 'equal) "Hash table mapping MCP session ids to session metadata.") @@ -492,28 +502,80 @@ no new problems before finishing." (push (ai-code-mcp--diagnostic-action-line uri diagnostic) actions)))) (vconcat (nreverse actions)))) +(defun ai-code-mcp--cap-diagnostics-entries (entries limit) + "Return ENTRIES truncated to at most LIMIT total diagnostics. +The return value is a cons (CAPPED-ENTRIES . SHOWN-COUNT). Whole and partial +file entries beyond LIMIT are dropped so the listed diagnostics never exceed +LIMIT. When LIMIT is nil, ENTRIES are returned unchanged." + (if (null limit) + (cons entries (ai-code-mcp--diagnostics-total-count entries)) + (let ((remaining (max limit 0)) + capped) + (dolist (entry entries) + (when (> remaining 0) + (let* ((diagnostics (append (alist-get 'diagnostics entry) nil)) + (take (min remaining (length diagnostics)))) + (when (> take 0) + (push `((uri . ,(alist-get 'uri entry)) + (diagnostics . ,(vconcat (seq-take diagnostics take)))) + capped) + (setq remaining (- remaining take)))))) + (cons (nreverse capped) (- (max limit 0) remaining))))) + +(defun ai-code-mcp--diagnostics-truncation-note (shown total context) + "Return a truncation note describing SHOWN of TOTAL diagnostics for CONTEXT. +In the `delta' context the caller is already filtering with since=\"baseline\", +so the note only points to per-file (uri) narrowing. In the `current' context +it also offers since=\"baseline\" as a way to focus on newly introduced +diagnostics -- not as a way to page through the omitted ones." + (let ((plural (if (= total 1) "" "s"))) + (if (eq context 'delta) + (format (concat " Listing %d of %d new diagnostic%s here;" + " request a specific file by uri to see the rest.") + shown total plural) + (format (concat " Listing %d of %d diagnostic%s here; request a specific" + " file by uri to see the rest, or use since=\"baseline\"" + " to focus on diagnostics you introduced.") + shown total plural)))) + (defun ai-code-mcp--diagnostics-envelope (entries &optional context) "Return a diagnostics observation envelope alist for ENTRIES. CONTEXT is `current' (default) or `delta'. In the `delta' context the status and summary describe diagnostics that are new since the baseline -and express the done-condition the agent must reach (new == 0)." +and express the done-condition the agent must reach (new == 0). + +The listed `files' and `next_actions' are capped at +`ai-code-mcp-diagnostics-max-report-diagnostics' so a large project cannot +overflow the model context; the summary always reports the true totals and +notes any truncation." (let* ((has-issues (and entries t)) + (total (ai-code-mcp--diagnostics-total-count entries)) + (capped-cell (ai-code-mcp--cap-diagnostics-entries + entries ai-code-mcp-diagnostics-max-report-diagnostics)) + (capped (car capped-cell)) + (shown (cdr capped-cell)) + (truncated (> total shown)) (status (cond ((not has-issues) "clean") ((eq context 'delta) "regression") (t "issues"))) - (summary (cond - ((eq context 'delta) - (if has-issues - (concat (ai-code-mcp--diagnostics-summary entries) - " These are NEW versus the baseline;" - " not done until new == 0.") - (concat "No new diagnostics versus the baseline;" - " done-condition met (new == 0)."))) - (t (ai-code-mcp--diagnostics-summary entries))))) + (base-summary (cond + ((eq context 'delta) + (if has-issues + (concat (ai-code-mcp--diagnostics-summary entries) + " These are NEW versus the baseline;" + " not done until new == 0.") + (concat "No new diagnostics versus the baseline;" + " done-condition met (new == 0)."))) + (t (ai-code-mcp--diagnostics-summary entries)))) + (summary (if truncated + (concat base-summary + (ai-code-mcp--diagnostics-truncation-note + shown total context)) + base-summary))) `((status . ,status) (summary . ,summary) - (files . ,(vconcat entries)) - (next_actions . ,(ai-code-mcp--diagnostics-next-actions entries)) + (files . ,(vconcat capped)) + (next_actions . ,(ai-code-mcp--diagnostics-next-actions capped)) (artifacts . ,(vconcat nil))))) (defun ai-code-mcp--diagnostics-baseline-key () @@ -599,6 +661,27 @@ When no baseline has been recorded, return ENTRIES unchanged." (diagnostics . ,(vconcat new)))))) entries)))))) +(defun ai-code-mcp--diagnostics-source-counts (entries) + "Return an alist of (SOURCE . COUNT) for ENTRIES, ordered by descending count." + (let ((counts (make-hash-table :test 'equal)) + pairs) + (dolist (entry entries) + (seq-doseq (diagnostic (alist-get 'diagnostics entry)) + (let ((source (or (alist-get 'source diagnostic) "unknown"))) + (puthash source (1+ (gethash source counts 0)) counts)))) + (maphash (lambda (source count) (push (cons source count) pairs)) counts) + (sort pairs (lambda (a b) (> (cdr a) (cdr b)))))) + +(defun ai-code-mcp--diagnostics-top-sources-string (entries &optional top-n) + "Return a human string naming the TOP-N diagnostic sources in ENTRIES, or nil. +TOP-N defaults to 3. The string keeps a compact signal about what produced the +diagnostics without listing every diagnostic." + (let ((pairs (seq-take (ai-code-mcp--diagnostics-source-counts entries) + (or top-n 3)))) + (when pairs + (mapconcat (lambda (pair) (format "%s (%d)" (car pair) (cdr pair))) + pairs ", ")))) + (defun ai-code-mcp-diagnostics-baseline () "Record current project diagnostics as the session baseline. Return a JSON observation envelope describing what was recorded. Later @@ -607,18 +690,30 @@ diagnostics relative to this snapshot, which lets the agent verify it did not introduce new problems." (let* ((entries (ai-code-mcp--diagnostics-for-project)) (counts (ai-code-mcp--diagnostics-identity-counts entries)) - (count (ai-code-mcp--diagnostics-total-count entries))) + (count (ai-code-mcp--diagnostics-total-count entries)) + (sources (ai-code-mcp--diagnostics-top-sources-string entries)) + (summary (concat + (format (concat "Recorded %d diagnostic%s as the baseline." + " Edit, then call get_diagnostics with" + " since=\"baseline\" and finish only when" + " status is \"clean\".") + count (if (= count 1) "" "s")) + (when sources (format " Top sources: %s." sources))))) (puthash (ai-code-mcp--diagnostics-baseline-key) counts ai-code-mcp--diagnostics-baselines) (json-encode `((status . "baseline_recorded") - (summary . ,(format (concat "Recorded %d diagnostic%s as the baseline." - " Edit, then call get_diagnostics with" - " since=\"baseline\" and finish only when" - " status is \"clean\".") - count (if (= count 1) "" "s"))) - (files . ,(vconcat entries)) - (next_actions . ,(vconcat nil)) + (summary . ,summary) + ;; The baseline is recorded server-side in `counts' (via `puthash' + ;; above); do not echo the full diagnostics list back into the model + ;; context. Returning every project diagnostic here can produce a + ;; payload far too large to fit in the model context, which defeats the + ;; purpose of keeping the baseline out of context in the first place. + (files . ,(vconcat nil)) + (next_actions . ,(vector + (concat "Edit, then call get_diagnostics with" + " since=\"baseline\" on the touched files and" + " finish only when status is \"clean\"."))) (artifacts . ,(vconcat nil)))))) (defun ai-code-mcp--diagnostics-for-uri (uri) diff --git a/test/test_ai-code-mcp-server.el b/test/test_ai-code-mcp-server.el index 92be35b..abd41b3 100644 --- a/test/test_ai-code-mcp-server.el +++ b/test/test_ai-code-mcp-server.el @@ -627,6 +627,191 @@ DIAGNOSTICS is an expression returning a list of mock diagnostic structs." (kill-buffer session-buffer)) (delete-directory project-dir t)))) +(ert-deftest ai-code-test-mcp-diagnostics-baseline-response-omits-files () + "Recording a baseline must not echo the full diagnostics list into context. +The baseline is stored server-side, so the tool response only needs a status +and summary; returning every diagnostic would bloat the model context." + (let* ((project-dir (make-temp-file "ai-code-mcp-baseline-omit-" t)) + (file-path (expand-file-name "sample.el" project-dir)) + (session-buffer (generate-new-buffer " *ai-code-mcp-baseline-omit*")) + (ai-code-mcp-server-tools nil) + (ai-code-mcp--sessions (make-hash-table :test 'equal)) + (ai-code-mcp--diagnostics-baselines (make-hash-table :test 'equal)) + (ai-code-mcp--current-session-id "session-baseline-omit") + visited-buffer) + (unwind-protect + (progn + (with-temp-file file-path (insert "(message \"alpha\")\n")) + (setq visited-buffer (find-file-noselect file-path t)) + (with-current-buffer visited-buffer + (setq-local flymake-mode t) + (ai-code-mcp-register-session + "session-baseline-omit" project-dir session-buffer) + (ai-code-test-mcp--with-flymake-diagnostics + (list (make-ai-code-test-mcp-mock-diagnostic + :beg (point-min) :end (line-end-position) + :type :warning :text "Existing problem" + :backend 'mock-backend)) + (let ((baseline (ai-code-test-mcp--read-json + (ai-code-test-mcp--content-text + (ai-code-mcp-dispatch + "tools/call" + '((name . "diagnostics_baseline") + (arguments . ()))))))) + ;; The baseline is recorded server-side, not in the response body. + (should (equal "baseline_recorded" + (alist-get 'status baseline))) + ;; So the response must not echo the project diagnostics list. + (should (= 0 (length (alist-get 'files baseline)))))))) + (when (buffer-live-p visited-buffer) + (kill-buffer visited-buffer)) + (when (buffer-live-p session-buffer) + (kill-buffer session-buffer)) + (delete-directory project-dir t)))) + +(ert-deftest ai-code-test-mcp-diagnostics-baseline-response-includes-next-actions () + "The baseline response should carry a structured next action for the harness loop. +Per the observation contract, the follow-up step (edit, then verify with +since=\"baseline\") belongs in `next_actions', not only in the summary prose." + (let* ((project-dir (make-temp-file "ai-code-mcp-baseline-actions-" t)) + (file-path (expand-file-name "sample.el" project-dir)) + (session-buffer (generate-new-buffer " *ai-code-mcp-baseline-actions*")) + (ai-code-mcp-server-tools nil) + (ai-code-mcp--sessions (make-hash-table :test 'equal)) + (ai-code-mcp--diagnostics-baselines (make-hash-table :test 'equal)) + (ai-code-mcp--current-session-id "session-baseline-actions") + visited-buffer) + (unwind-protect + (progn + (with-temp-file file-path (insert "(message \"alpha\")\n")) + (setq visited-buffer (find-file-noselect file-path t)) + (with-current-buffer visited-buffer + (setq-local flymake-mode t) + (ai-code-mcp-register-session + "session-baseline-actions" project-dir session-buffer) + (ai-code-test-mcp--with-flymake-diagnostics + (list (make-ai-code-test-mcp-mock-diagnostic + :beg (point-min) :end (line-end-position) + :type :warning :text "Existing problem" + :backend 'mock-backend)) + (let* ((baseline (ai-code-test-mcp--read-json + (ai-code-test-mcp--content-text + (ai-code-mcp-dispatch + "tools/call" + '((name . "diagnostics_baseline") + (arguments . ())))))) + (actions (alist-get 'next_actions baseline))) + (should (equal "baseline_recorded" (alist-get 'status baseline))) + ;; The harness's follow-up step is exposed as a structured action. + (should (> (length actions) 0)) + (should (string-match-p "since=\"baseline\"" (aref actions 0))))))) + (when (buffer-live-p visited-buffer) + (kill-buffer visited-buffer)) + (when (buffer-live-p session-buffer) + (kill-buffer session-buffer)) + (delete-directory project-dir t)))) + +(ert-deftest ai-code-test-mcp-diagnostics-truncation-note-is-context-aware () + "The truncation note must not circularly suggest since=\"baseline\" in a delta +report (the caller already uses it); it points to per-file (uri) narrowing +instead. The current report may still offer since=\"baseline\" to focus on +newly introduced diagnostics." + (let* ((ai-code-mcp-diagnostics-max-report-diagnostics 1) + (entries (list `((uri . "file:///tmp/a.el") + (diagnostics . ,(vector + (ai-code-mcp--make-diagnostic 1 0 1 1 'warning "checker" "one") + (ai-code-mcp--make-diagnostic 2 0 2 1 'warning "checker" "two")))))) + (delta-summary (alist-get 'summary + (ai-code-mcp--diagnostics-envelope entries 'delta))) + (current-summary (alist-get 'summary + (ai-code-mcp--diagnostics-envelope entries 'current)))) + ;; Both reports are truncated and point to per-file (uri) narrowing. + (should (string-match-p "uri" delta-summary)) + (should (string-match-p "uri" current-summary)) + ;; The delta note must NOT tell the caller to use since="baseline" again. + (should-not (string-match-p "since=\"baseline\"" delta-summary)) + ;; The current note may still offer since="baseline" (to focus on regressions). + (should (string-match-p "since=\"baseline\"" current-summary)))) + +(ert-deftest ai-code-test-mcp-diagnostics-max-report-type-is-non-negative () + "The diagnostics cap customization should restrict input to non-negative integers. +A negative maximum is meaningless and would silently hide every diagnostic." + (let ((type (get 'ai-code-mcp-diagnostics-max-report-diagnostics 'custom-type))) + (should (memq 'natnum (flatten-tree type))) + (should-not (memq 'integer (flatten-tree type))))) + +(ert-deftest ai-code-test-mcp-diagnostics-envelope-truncates-large-reports () + "The diagnostics envelope caps `files' so a large report cannot overflow context." + (let* ((ai-code-mcp-diagnostics-max-report-diagnostics 2) + (entries + (list `((uri . "file:///tmp/a.el") + (diagnostics . ,(vector + (ai-code-mcp--make-diagnostic 1 0 1 1 'warning "checker" "one") + (ai-code-mcp--make-diagnostic 2 0 2 1 'warning "checker" "two") + (ai-code-mcp--make-diagnostic 3 0 3 1 'warning "checker" "three")))) + `((uri . "file:///tmp/b.el") + (diagnostics . ,(vector + (ai-code-mcp--make-diagnostic 1 0 1 1 'error "checker" "four")))))) + (envelope (ai-code-mcp--diagnostics-envelope entries 'current)) + (files (alist-get 'files envelope)) + (shown (apply #'+ (mapcar (lambda (entry) + (length (alist-get 'diagnostics entry))) + (append files nil)))) + (summary (alist-get 'summary envelope)) + (actions (alist-get 'next_actions envelope))) + ;; Only the first `limit' diagnostics are listed (and actions follow them) ... + (should (= 2 shown)) + (should (= 2 (length actions))) + ;; ... while the true totals and the truncation are reported in the summary. + (should (string-match-p "4 diagnostic" summary)) + (should (string-match-p "2 of 4" summary)))) + +(ert-deftest ai-code-test-mcp-diagnostics-baseline-summary-reports-top-sources () + "The baseline summary names the dominant diagnostic sources without listing them. +This keeps a useful signal about what produces the baseline noise even though +the full diagnostics list is intentionally omitted from the response." + (let* ((project-dir (make-temp-file "ai-code-mcp-baseline-sources-" t)) + (file-path (expand-file-name "sample.el" project-dir)) + (session-buffer (generate-new-buffer " *ai-code-mcp-baseline-sources*")) + (ai-code-mcp-server-tools nil) + (ai-code-mcp--sessions (make-hash-table :test 'equal)) + (ai-code-mcp--diagnostics-baselines (make-hash-table :test 'equal)) + (ai-code-mcp--current-session-id "session-baseline-sources") + visited-buffer) + (unwind-protect + (progn + (with-temp-file file-path (insert "(message \"alpha\")\n")) + (setq visited-buffer (find-file-noselect file-path t)) + (with-current-buffer visited-buffer + (setq-local flymake-mode t) + (ai-code-mcp-register-session + "session-baseline-sources" project-dir session-buffer) + (ai-code-test-mcp--with-flymake-diagnostics + (list (make-ai-code-test-mcp-mock-diagnostic + :beg (point-min) :end (point-min) + :type :warning :text "style one" :backend 'checkdoc) + (make-ai-code-test-mcp-mock-diagnostic + :beg (point-min) :end (point-min) + :type :warning :text "style two" :backend 'checkdoc) + (make-ai-code-test-mcp-mock-diagnostic + :beg (point-min) :end (point-min) + :type :error :text "compile one" :backend 'byte-compile)) + (let ((summary (alist-get + 'summary + (ai-code-test-mcp--read-json + (ai-code-test-mcp--content-text + (ai-code-mcp-dispatch + "tools/call" + '((name . "diagnostics_baseline") + (arguments . ())))))))) + (should (string-match-p "Top sources:" summary)) + (should (string-match-p "checkdoc (2)" summary)))))) + (when (buffer-live-p visited-buffer) + (kill-buffer visited-buffer)) + (when (buffer-live-p session-buffer) + (kill-buffer session-buffer)) + (delete-directory project-dir t)))) + (ert-deftest ai-code-test-mcp-get-diagnostics-since-baseline-reports-regression () "Diagnostics that appear after the baseline are reported as a regression." (let* ((project-dir (make-temp-file "ai-code-mcp-baseline-regression-" t))