Add range filtering and explain output
ober
e650afd5dd02d28b0c286a1264a2c3f5e66caf89
--- a/README.md +++ b/README.md @@ -17,6 +17,8 @@ repository data over the network. ```bash ./bin/jerboa-aigit scan /path/to/repo --count 25 ./bin/jerboa-aigit scan /path/to/repo --format json +./bin/jerboa-aigit scan /path/to/repo --from main~20 --to HEAD --file src/app.ss +./bin/jerboa-aigit explain HEAD /path/to/repo --format markdown ./bin/jerboa-aigit stats /path/to/repo --count 100 ./bin/jerboa-aigit verify-authorship /path/to/repo --count 25 ``` @@ -27,8 +29,10 @@ During development, the same entrypoint can be run directly: jerboa main-binary.ss scan /path/to/repo --format json ``` -Supported options are `--count N`, `--commit REV`, `--format table|json|jsonl`, -`--metadata-only`, and `--heuristics-only`. +Supported options are `--count N`, `--all`, `--from REV`, `--to REV`, +`--commit REV`, `--file PATH`, `--min-lines N`, +`--format table|json|jsonl|markdown`, `--metadata-only`, and +`--heuristics-only`. ## What It Reads @@ -75,4 +79,3 @@ make verify All Jerboa source is in `main-binary.ss`. Per `AGENTS.md`, edit `.ss` files only with Jerboa MCP balanced tools and run balance plus verification after every change. - --- a/main-binary.ss +++ b/main-binary.ss @@ -5,7 +5,7 @@ (def us (integer->char 31)) (def tab (integer->char 9)) -(defstruct options (command path count format commit metadata-only? heuristics-only?)) +(defstruct options (command path count format commit from to file min-lines metadata-only? heuristics-only?)) (defstruct signal (name category score weight confidence reason evidence limitations)) (defstruct finding (commit parent author-name author-email time subject files additions deletions @@ -21,7 +21,8 @@ xs))) (def (usage) - (displayln "usage: jerboa main-binary.ss scan [PATH] [--count N] [--commit REV] [--format table|json|jsonl] [--metadata-only|--heuristics-only]") + (displayln "usage: jerboa main-binary.ss scan [PATH] [--count N|--all] [--from REV] [--to REV] [--file PATH] [--min-lines N] [--format table|json|jsonl|markdown]") + (displayln " jerboa main-binary.ss explain REV [PATH] [--format json|markdown|table]") (displayln " jerboa main-binary.ss stats [PATH] [--count N]") (displayln " jerboa main-binary.ss verify-authorship [PATH] [--count N]")) @@ -61,6 +62,20 @@ (def (count-where pred xs) (for/fold ([n 0]) ([x xs]) (if (pred x) (+ n 1) n))) (def (any-contains? text needles) (for/or ([needle needles]) (contains? text needle))) (def (starts-with-any? text prefixes) (for/or ([prefix prefixes]) (string-prefix? prefix text))) +(def (maybe-append xs ys) + (if (null? ys) xs (append xs ys))) + +(def (pathspec-args file) + (if file (list "--" file) '())) + +(def (range-spec from to) + (cond [(and from to) (str from ".." to)] + [from (str from "..HEAD")] + [to to] + [else "HEAD"])) + +(def (count-args count) + (if (> count 0) (list (str "--max-count=" count)) '())) (def (git repo args) (try @@ -71,11 +86,13 @@ (let ([root (string-trim (git path '("rev-parse" "--show-toplevel")))]) (if (string-empty? root) #f root))) -(def (commit-list repo count commit) +(def (commit-list repo count commit from to file) (if commit (list commit) - (filter (lambda (line) (not (blank? line))) - (split-lines (git repo (list "rev-list" (str "--max-count=" count) "HEAD")))))) + (let* ([base (append (list "rev-list") (count-args count) (list (range-spec from to)))] + [args (append base (pathspec-args file))]) + (filter (lambda (line) (not (blank? line))) + (split-lines (git repo args)))))) (def (commit-fields repo rev) (let* ([fmt "%H%x1f%P%x1f%an%x1f%ae%x1f%ct%x1f%s"] @@ -98,20 +115,24 @@ [path (safe-ref parts 2 "")]) (list path adds dels))) -(def (changed-files repo rev) - (map parse-numstat - (filter (lambda (line) (not (blank? line))) - (split-lines (git repo (list "show" "--format=" "--numstat" "--first-parent" rev)))))) +(def (changed-files repo rev file) + (let ([args (append (list "show" "--format=" "--numstat" "--first-parent" rev) + (pathspec-args file))]) + (map parse-numstat + (filter (lambda (line) (not (blank? line))) + (split-lines (git repo args)))))) (def (numstat-adds files) (sum (map cadr files))) (def (numstat-dels files) (sum (map caddr files))) (def (numstat-paths files) (map car files)) -(def (added-lines repo rev) - (map (lambda (line) (substring line 1 (string-length line))) - (filter (lambda (line) - (and (string-prefix? "+" line) (not (string-prefix? "+++" line)))) - (split-lines (git repo (list "show" "--format=" "--first-parent" "--unified=0" "--no-ext-diff" rev)))))) +(def (added-lines repo rev file) + (let ([args (append (list "show" "--format=" "--first-parent" "--unified=0" "--no-ext-diff" rev) + (pathspec-args file))]) + (map (lambda (line) (substring line 1 (string-length line))) + (filter (lambda (line) + (and (string-prefix? "+" line) (not (string-prefix? "+++" line)))) + (split-lines (git repo args)))))) (def known-agents '("codex" "copilot" "claude" "cursor" "openai" "anthropic" "aider" "windsurf" "cody" "tabnine" "ai-agent")) @@ -287,13 +308,13 @@ [(>= score 0.20) "mixed-uncertain"] [else "likely-human-style"])) -(def (prior-additions repo revs email current) +(def (prior-additions repo revs email current file) (let loop ([xs revs] [out '()]) (if (null? xs) out (let* ([rev (car xs)] [fields (commit-fields repo rev)] [e (safe-ref fields 3 "")]) (if (and (string=? e email) (not (string=? rev current))) - (loop (cdr xs) (cons (numstat-adds (changed-files repo rev)) out)) + (loop (cdr xs) (cons (numstat-adds (changed-files repo rev file)) out)) (loop (cdr xs) out)))))) (def (author-times repo revs email) @@ -305,36 +326,42 @@ [t (parse-int (safe-ref fields 4 "0") 0)]) (if (string=? e email) (loop (cdr xs) (cons t out)) (loop (cdr xs) out)))))) -(def (warnings files lines note metadata-only? heuristics-only?) +(def (warnings files lines note metadata-only? heuristics-only? min-lines) (append (if (null? files) '("no changed text files found or commit is unavailable") '()) (if (null? lines) '("no added UTF-8 patch lines available") '()) + (if (and (> min-lines 0) (< (length lines) min-lines)) + (list (str "heuristics skipped below --min-lines " min-lines)) + '()) (if (and (string-empty? note) (not metadata-only?)) '("no refs/notes/ai authorship note found") '()) (if (and metadata-only? heuristics-only?) '("metadata-only and heuristics-only were both requested") '()))) -(def (scan-one repo rev hashes revs metadata-only? heuristics-only?) +(def (scan-one repo rev hashes revs file min-lines metadata-only? heuristics-only?) (let* ([fields (commit-fields repo rev)] [id (safe-ref fields 0 rev)] [parents (safe-ref fields 1 "")] [parent (first-parent parents)] [author-name (safe-ref fields 2 "")] [author-email (safe-ref fields 3 "")] [time (parse-int (safe-ref fields 4 "0") 0)] [subject (safe-ref fields 5 "")] - [body (commit-message repo rev)] [files (changed-files repo rev)] [paths (numstat-paths files)] - [adds (numstat-adds files)] [dels (numstat-dels files)] [lines (added-lines repo rev)] + [body (commit-message repo rev)] [files (changed-files repo rev file)] [paths (numstat-paths files)] + [adds (numstat-adds files)] [dels (numstat-dels files)] [lines (added-lines repo rev file)] [note (note-text repo rev)] [metadata (metadata-hits author-name author-email subject body note)] + [eligible? (or (= min-lines 0) (>= (length lines) min-lines))] [sim-pair (similarity-signal lines hashes)] - [raw-signals (list (message-signal subject body adds) (code-signal lines) (structure-signal paths adds dels lines) - (car sim-pair) (history-signal adds time (parent-time repo parent) (author-times repo revs author-email)) - (baseline-signal adds (prior-additions repo revs author-email rev)))] + [raw-signals (if eligible? + (list (message-signal subject body adds) (code-signal lines) (structure-signal paths adds dels lines) + (car sim-pair) (history-signal adds time (parent-time repo parent) (author-times repo revs author-email)) + (baseline-signal adds (prior-additions repo revs author-email rev file))) + '())] [signals (if metadata-only? '() raw-signals)] [score (if metadata-only? 0.0 (aggregate-score signals))] [v (if heuristics-only? (verdict score '() "") (verdict score metadata note))]) (list (make-finding id parent author-name author-email time subject paths adds dels (length lines) note metadata signals score v - (warnings files lines note metadata-only? heuristics-only?)) + (warnings files lines note metadata-only? heuristics-only? min-lines)) (cadr sim-pair)))) -(def (scan-repo repo revs metadata-only? heuristics-only?) +(def (scan-repo repo revs file min-lines metadata-only? heuristics-only?) (let loop ([xs revs] [hashes '()] [out '()]) (if (null? xs) (reverse out) - (let ([pair (scan-one repo (car xs) hashes revs metadata-only? heuristics-only?)]) + (let ([pair (scan-one repo (car xs) hashes revs file min-lines metadata-only? heuristics-only?)]) (loop (cdr xs) (cons (cadr pair) hashes) (cons (car pair) out)))))) (def (json-escape-to s port) @@ -392,50 +419,144 @@ (for ([f findings]) (displayln (str (short-sha (finding-commit f)) " " (finding-score f) " " (finding-verdict f) " " (finding-author-email f) " " (finding-subject f))))) +(def (display-markdown findings) + (displayln "| commit | score | verdict | author | subject |") + (displayln "|---|---:|---|---|---|") + (for ([f findings]) + (displayln (str "| `" (short-sha (finding-commit f)) "` | " (finding-score f) " | " + (finding-verdict f) " | " (finding-author-email f) " | " (finding-subject f) " |")))) + +(def (display-explain f) + (displayln (str "commit: " (finding-commit f))) + (displayln (str "verdict: " (finding-verdict f))) + (displayln (str "score: " (finding-score f))) + (displayln (str "author: " (finding-author-name f) " <" (finding-author-email f) ">")) + (displayln (str "subject: " (finding-subject f))) + (displayln "signals:") + (for ([s (finding-signals f)]) + (displayln (str "- " (signal-name s) " [" (signal-category s) "] score=" (signal-score s) + " weight=" (signal-weight s))) + (for ([e (signal-evidence s)]) + (displayln (str " evidence: " e)))) + (if (pair? (finding-warnings f)) + (begin + (displayln "warnings:") + (for ([w (finding-warnings f)]) (displayln (str "- " w)))))) (def (display-stats findings) (displayln (str "commits: " (length findings))) (displayln (str "recorded AI notes: " (count-where (lambda (f) (not (string-empty? (finding-note f)))) findings))) (displayln (str "metadata indicated agents: " (count-where (lambda (f) (pair? (finding-metadata f))) findings))) (displayln (str "likely AI-assisted by heuristics: " (count-where (lambda (f) (string=? (finding-verdict f) "likely-ai-assisted")) findings)))) -(def (default-options) (make-options "scan" "." 50 "table" #f #f #f)) +(def (default-options) (make-options "scan" "." 50 "table" #f #f #f #f 0 #f #f)) (def (parse-options args) (let loop ([xs args] [opts (default-options)] [path-set? #f]) (cond [(null? xs) opts] - [(member (car xs) '("scan" "stats" "verify-authorship")) - (loop (cdr xs) (make-options (car xs) (options-path opts) (options-count opts) (options-format opts) - (options-commit opts) (options-metadata-only? opts) (options-heuristics-only? opts)) path-set?)] + [(member (car xs) '("scan" "stats" "explain" "verify-authorship")) + (loop (cdr xs) + (make-options (car xs) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] + [(string=? (car xs) "--all") + (loop (cdr xs) + (make-options (options-command opts) (options-path opts) 0 (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] [(and (string=? (car xs) "--count") (pair? (cdr xs))) - (loop (cddr xs) (make-options (options-command opts) (options-path opts) (parse-int (cadr xs) (options-count opts)) - (options-format opts) (options-commit opts) (options-metadata-only? opts) (options-heuristics-only? opts)) path-set?)] + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (parse-int (cadr xs) (options-count opts)) + (options-format opts) (options-commit opts) (options-from opts) (options-to opts) + (options-file opts) (options-min-lines opts) (options-metadata-only? opts) + (options-heuristics-only? opts)) + path-set?)] [(and (string=? (car xs) "--format") (pair? (cdr xs))) - (loop (cddr xs) (make-options (options-command opts) (options-path opts) (options-count opts) (cadr xs) - (options-commit opts) (options-metadata-only? opts) (options-heuristics-only? opts)) path-set?)] + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (cadr xs) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] [(and (string=? (car xs) "--commit") (pair? (cdr xs))) - (loop (cddr xs) (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) - (cadr xs) (options-metadata-only? opts) (options-heuristics-only? opts)) path-set?)] + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (cadr xs) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] + [(and (string=? (car xs) "--from") (pair? (cdr xs))) + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (cadr xs) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] + [(and (string=? (car xs) "--to") (pair? (cdr xs))) + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (cadr xs) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] + [(and (string=? (car xs) "--file") (pair? (cdr xs))) + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (cadr xs) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] + [(and (string=? (car xs) "--min-lines") (pair? (cdr xs))) + (loop (cddr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (parse-int (cadr xs) (options-min-lines opts)) (options-metadata-only? opts) + (options-heuristics-only? opts)) + path-set?)] [(string=? (car xs) "--metadata-only") - (loop (cdr xs) (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) - (options-commit opts) #t (options-heuristics-only? opts)) path-set?)] - [(string=? (car xs) "--heuristics-only") - (loop (cdr xs) (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) - (options-commit opts) (options-metadata-only? opts) #t) path-set?)] + (loop (cdr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) #t (options-heuristics-only? opts)) + path-set?)] + [(or (string=? (car xs) "--heuristics-only") (string=? (car xs) "--heuristics")) + (loop (cdr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) #t) + path-set?)] [(option-flag? (car xs)) (loop (cdr xs) opts path-set?)] + [(and (string=? (options-command opts) "explain") (not (options-commit opts))) + (loop (cdr xs) + (make-options (options-command opts) (options-path opts) (options-count opts) (options-format opts) + (car xs) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + path-set?)] [path-set? (loop (cdr xs) opts path-set?)] - [else (loop (cdr xs) (make-options (options-command opts) (car xs) (options-count opts) (options-format opts) - (options-commit opts) (options-metadata-only? opts) (options-heuristics-only? opts)) #t)]))) + [else (loop (cdr xs) + (make-options (options-command opts) (car xs) (options-count opts) (options-format opts) + (options-commit opts) (options-from opts) (options-to opts) (options-file opts) + (options-min-lines opts) (options-metadata-only? opts) (options-heuristics-only? opts)) + #t)]))) + +(def (display-findings root findings fmt) + (cond [(string=? fmt "json") (display-json root findings)] + [(string=? fmt "jsonl") (display-jsonl root findings)] + [(string=? fmt "markdown") (display-markdown findings)] + [else (display-table findings)])) (def (run opts) (let ([root (repo-root (options-path opts))]) (if (not root) (begin (displayln "error: path is not inside a Git repository") (exit 2)) - (let* ([revs (commit-list root (options-count opts) (options-commit opts))] - [findings (scan-repo root revs (options-metadata-only? opts) (options-heuristics-only? opts))]) + (let* ([commit (options-commit opts)] + [revs (commit-list root (options-count opts) commit (options-from opts) (options-to opts) (options-file opts))] + [findings (scan-repo root revs (options-file opts) (options-min-lines opts) + (options-metadata-only? opts) (options-heuristics-only? opts))]) (cond [(string=? (options-command opts) "stats") (display-stats findings)] [(string=? (options-command opts) "verify-authorship") (display-json root findings)] - [(string=? (options-format opts) "json") (display-json root findings)] - [(string=? (options-format opts) "jsonl") (display-jsonl root findings)] - [else (display-table findings)]))))) + [(string=? (options-command opts) "explain") + (if (pair? findings) + (if (string=? (options-format opts) "json") + (displayln (json-string (finding-json root (car findings)))) + (display-explain (car findings))) + (begin (displayln "error: commit not found") (exit 3)))] + [else (display-findings root findings (options-format opts))]))))) (if (or (null? cli-args) (member "--help" cli-args) (member "-h" cli-args)) (usage) --- a/tests/fixture-smoke.sh +++ b/tests/fixture-smoke.sh @@ -65,6 +65,28 @@ printf '%s\n' "$stats" | grep -q 'recorded AI notes: 1' jsonl_lines=$("$root/bin/jerboa-aigit" scan "$fixture" --format jsonl --count 2 | wc -l | tr -d ' ') test "$jsonl_lines" = 2 +head_rev=$(git -C "$fixture" rev-parse HEAD) +base_rev=$(git -C "$fixture" rev-parse HEAD~1) + +explain=$("$root/bin/jerboa-aigit" explain "$head_rev" "$fixture") +printf '%s\n' "$explain" | grep -q "commit: $head_rev" +printf '%s\n' "$explain" | grep -q 'signals:' + +markdown=$("$root/bin/jerboa-aigit" scan "$fixture" --format markdown --count 1) +printf '%s\n' "$markdown" | grep -q '| commit | score | verdict | author | subject |' + +file_json=$("$root/bin/jerboa-aigit" scan "$fixture" --format json --count 5 --file src/generated.py) +printf '%s\n' "$file_json" | grep -q '"count":1' +printf '%s\n' "$file_json" | grep -q '"files":\["src/generated.py"\]' + +min_json=$("$root/bin/jerboa-aigit" scan "$fixture" --format json --count 1 --min-lines 999) +printf '%s\n' "$min_json" | grep -q '"signals":\[\]' +printf '%s\n' "$min_json" | grep -q 'heuristics skipped below --min-lines 999' + +range_json=$("$root/bin/jerboa-aigit" scan "$fixture" --format json --from "$base_rev" --to HEAD) +printf '%s\n' "$range_json" | grep -q '"count":1' +printf '%s\n' "$range_json" | grep -q "$head_rev" + if "$root/bin/jerboa-aigit" scan "$fixture/nope" >/tmp/jerboa-aigit-invalid.out 2>&1; then echo "invalid repository path should fail" >&2 exit 1 @@ -72,4 +94,3 @@ fi grep -q 'not inside a Git repository' /tmp/jerboa-aigit-invalid.out echo "fixture smoke tests passed" -