mcp: stop flagging analysis findings as tool errors; make analyzers project- and .sls-aware
ober
7f48f25ab21b98532e29f904e28bd9990890e366
--- a/mcp/server.ss +++ b/mcp/server.ss @@ -870,8 +870,7 @@ "; raise max_findings to continue)") "") ":\n\n" - (string-join findings "\n")) - #t)))])) + (string-join findings "\n")))))])) (def (tool-run-tests args) (def file (hash-get* args "file_path" #f)) @@ -1418,14 +1417,32 @@ (def (tool-check-duplicates args) (let ([src (read-tool-source args)]) - (if (not src) - (text-result "file_path or code is required." #t) + (if src (let* ([analysis (parse-source (car src) (cdr src))] [dupes (duplicate-names (definition-names analysis))]) (if (null? dupes) (text-result (string-append "No duplicate definitions in " (car src) ".")) (text-result (string-append "Duplicate definitions in " (car src) ":\n\n " (string-join dupes "\n ")) + #t))) + ;; No single file/code: scan a whole project, mirroring the sibling + ;; analysis tools (dead_code, lint) which accept project_path/directory. + ;; Previously this returned the misleading "file_path or code is + ;; required." when handed a project_path or a directory. Reports + ;; within-file duplicate definitions, grouped by file. + (let ([root (hash-get* args "project_path" (hash-get* args "directory" (repo-root)))] + [hits '()]) + (for-each + (lambda (file) + (let* ([source (guard (e [else ""]) (read-file-string file))] + [dupes (duplicate-names (definition-names (parse-source file source)))]) + (unless (null? dupes) + (set! hits (cons (string-append file ":\n " (string-join dupes "\n ")) hits))))) + (scheme-files root)) + (if (null? hits) + (text-result (string-append "No duplicate definitions in " root ".")) + (text-result (string-append "Duplicate definitions in " root ":\n\n" + (string-join (reverse hits) "\n\n")) #t)))))) (def (project-analyses root) @@ -1479,8 +1496,7 @@ [(and (not src) (not root)) (text-result "file_path, code, project_path, or directory is required." #t)] [(null? warnings) (text-result "Lint: no issues found.")] [else (text-result (string-append "Lint found " (number->string (length warnings)) " issue(s):\n\n" - (string-join (reverse warnings) "\n")) - #t)])) + (string-join (reverse warnings) "\n")))])) (def (tool-check-arity args) (def root (hash-get* args "project_path" (hash-get* args "directory" (repo-root)))) @@ -1555,8 +1571,7 @@ "\nFiles: " (number->string (length files)) "\nBalance issues: " (number->string balance-errors) "\nDuplicate definitions: " (number->string duplicate-errors) - "\nHealth score: " (number->string score) "/100") - (> issue-count 0)))) + "\nHealth score: " (number->string score) "/100")))) (def (tool-batch-audit args) (def root (hash-get* args "project_path" (hash-get* args "directory" (repo-root)))) @@ -2874,12 +2889,19 @@ (tool-stdlib-search args)) (def (files-from-args args extensions) - (let ([file (hash-get* args "file_path" #f)] - [project (hash-get* args "project_path" #f)]) + ;; Jerboa source compiles .ss → .sls; scheme-files/scan-files already treat + ;; both as scheme source, so match .sls too whenever .ss is requested — else a + ;; project of generated/.sls files (e.g. a jerboa lib) scans as empty and the + ;; tool wrongly reports "file_path or project_path is required". Also accept + ;; "directory" as a synonym for project_path, like the sibling analysis tools. + (let* ([exts (if (member ".ss" extensions) (cons ".sls" extensions) extensions)] + [file (hash-get* args "file_path" #f)] + [root (or (hash-get* args "project_path" #f) + (hash-get* args "directory" #f))]) (cond [file (list file)] - [project (filter (lambda (f) (any (lambda (ext) (string-suffix? ext f)) extensions)) - (scan-files project))] + [root (filter (lambda (f) (any (lambda (ext) (string-suffix? ext f)) exts)) + (scan-files root))] [else '()]))) (def (line-findings files patterns label) @@ -2905,9 +2927,10 @@ (def (format-findings title findings) (if (null? findings) (text-result (string-append title ": no findings.")) + ;; A scan that surfaces findings still ran successfully — reserve isError + ;; for genuine failures so clients don't treat "issues found" as a crash. (text-result (string-append title " found " (number->string (length findings)) " issue(s):\n\n" - (string-join findings "\n")) - #t))) + (string-join findings "\n"))))) (def (tool-security-audit args) (let* ([root (hash-get* args "project_path" (repo-root))] @@ -2962,7 +2985,7 @@ (text-result (string-append "Unsafe import lint found " (number->string (length findings)) " issue(s). Prefer safe prelude wrappers or scoped imports:\n\n" (string-join findings "\n")) - #t)))))) + )))))) (def unsafe-api-patterns '("sqlite-open" "tcp-connect" "open-input-file" "open-output-file" "call-with-output-file" "system " "system*"))