Something went wrong. Try again.
Juju is a git/jj interface for the Helix editor
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500;; Copyright (C) 2026 Tom Waddington;;;; This program is free software: you can redistribute it and/or modify;; it under the terms of the GNU Affero General Public License as published by;; the Free Software Foundation, either version 3 of the License, or;; (at your option) any later version.
;;; diff.scm - one unified-diff parser for both backends;;;;;; Git and jj both emit Git-format unified diffs (`git diff`, `jj diff --git`),;;; so a single parser serves both. It splits a file's diff into hunks, tagging;;; each body line by its leading character, and reads the metadata lines;;; (binary marker, rename headers) the renderer labels and partial-hunk staging;;; must refuse. Pure functions: text in, structs out.;;;;;; `parse-unified-diff` reads one file's diff and drops the `diff --git` header;;; block, which is all a caller wants when it already knows the path (the;;; per-file fetches behind the status view). `parse-diff-files` is the;;; multi-file entry point: it cuts a stream on those headers first, so a;;; whole-commit diff keeps its per-file attribution.
(require "ui-utils.hx/strings.scm")(require "model.scm")
(provide parse-unified-diff parse-diff-flags parse-hunk-header diff-header-lines build-apply-patch parse-diff-files)
;;@doc;; Parse the body of one file's unified diff into a list of `hunk` structs.;; Lines before the first `@@` (the `diff --git`/`index`/`---`/`+++` headers);; are ignored here; `parse-diff-flags` reads them separately.(define (parse-unified-diff text) (parse-hunk-lines (split-lines text)))
;; The body of `parse-unified-diff` over an already-split line list, so the;; multi-file path below can hand its chunks straight over.(define (parse-hunk-lines all-lines) (let loop ([lines all-lines] [current #f] ; (cons header-info reversed-body-lines) or #f [acc '()]) (cond [(null? lines) (reverse (if current (cons (finish-hunk current) acc) acc))] [(hunk-header-line? (car lines)) (let ([acc2 (if current (cons (finish-hunk current) acc) acc)]) (loop (cdr lines) (cons (parse-hunk-header (car lines)) '()) acc2))] [current ;; Inside a hunk: classify the body line, unless it is the start of the ;; next file's headers (defensive, for multi-file input). (if (file-header-line? (car lines)) (loop (cdr lines) #f (cons (finish-hunk current) acc)) (loop (cdr lines) (cons (car current) (cons (classify-line (car lines)) (cdr current))) acc))] [else ;; Before the first hunk: skip file-header lines. (loop (cdr lines) #f acc)])))
;; current is (cons header-info reversed-lines); build the hunk struct.(define (finish-hunk current) (let ([info (car current)] [lines (reverse (cdr current))]) (make-hunk (hash-ref info 'header) (hash-ref info 'old-range) (hash-ref info 'new-range) lines)))
(define (hunk-header-line? line) (string-prefix? "@@ " line))
;; Lines that begin a new file's header block within a diff stream.(define (file-header-line? line) (string-prefix? "diff --git " line))
(define (classify-line line) (if (= (string-length line) 0) (make-diff-line 'context "") (let ([c (string-ref line 0)]) (cond [(char=? c #\+) (make-diff-line 'add (string-drop line 1))] [(char=? c #\-) (make-diff-line 'del (string-drop line 1))] [(char=? c #\space) (make-diff-line 'context (string-drop line 1))] [(char=? c #\\) (make-diff-line 'meta line)] ; "\ No newline at end of file" [else (make-diff-line 'context line)]))))
;;@doc;; Parse one `@@ -a,b +c,d @@ heading` line into a hash with keys 'header (the;; full line), 'old-range and 'new-range (each a (start . count) pair). A;; missing count defaults to 1 (git omits `,1`).(define (parse-hunk-header line) (let* ([toks (split-many line "@@")] ;; toks: ("" " -a,b +c,d " " heading") ; ranges are in toks[1] [ranges (if (>= (length toks) 2) (string-trim (list-ref toks 1)) "")] [parts (split-many ranges " ")] [old-tok (find-token parts "-")] [new-tok (find-token parts "+")]) (hash 'header line 'old-range (parse-range old-tok) 'new-range (parse-range new-tok))))
;; First token in `parts` that starts with `sign` ("-" or "+"), or #f.(define (find-token parts sign) (let loop ([ps parts]) (cond [(null? ps) #f] [(and (> (string-length (car ps)) 0) (string-prefix? sign (car ps))) (car ps)] [else (loop (cdr ps))])))
;; "-12,3" / "+5" -> (start . count); #f -> (0 . 0).(define (parse-range tok) (if (not tok) (cons 0 0) (let* ([body (string-drop tok 1)] ; drop leading - or + [nums (split-many body ",")] [start (string->number (list-ref nums 0))] [count (if (>= (length nums) 2) (string->number (list-ref nums 1)) 1)]) (cons (if start start 0) (if count count 1)))))
;;; Patch construction (partial-hunk staging) ;;;;;;;;; To stage/unstage/discard part of a file, juju re-fetches the file's diff,;;; keeps the header block, and rebuilds the hunks with only the selected change;;; lines. The result is fed to `git apply` (with `--recount`, so the @@ counts;;; need not be exact). The line-selection rule depends on the apply direction,;;; because the patch's context must match the content git applies against:;;;;;; 'forward (git apply --cached, for staging):;;; - selected + or - kept as-is;;;; - unselected + dropped (not part of this patch);;;; - unselected - becomes context (the deletion is not applied).;;; 'reverse (git apply --reverse, for unstaging/discarding):;;; - selected + or - kept as-is (git negates them on apply);;;; - unselected - dropped;;;; - unselected + becomes context (it is present in the current content the;;; reverse patch is checked against).;;;;;; Context lines are always kept. Validated against `git apply --cached;;; --recount` (forward) and `git apply --cached --reverse --recount` (reverse).
;;@doc;; The header lines of a single file's unified diff: everything before the first;; `@@` hunk (the `diff --git`, `index`, `---`, `+++`, and any rename/mode;; lines). Returned as a list of strings, in order. These are required verbatim;; at the top of a constructed patch.(define (diff-header-lines text) (header-block (split-lines text)))
;; The same over an already-split line list. Scanning stops at the first hunk;; because a deleted line reading "-- x" renders as "--- x" in the body and;; would otherwise be mistaken for the pre-image marker.(define (header-block lines) (collect-header lines '()))
(define (collect-header lines acc) (cond [(null? lines) (reverse acc)] [(hunk-header-line? (car lines)) (reverse acc)] [else (collect-header (cdr lines) (cons (car lines) acc))]))
;;@doc;; Build a patch string from `header-lines` (see `diff-header-lines`) and;; `hunks` (a list of `hunk` structs), including only the change lines for which;; `(include? hunk-index body-line-index)` is true. Hunks with no included;; change line are dropped. Returns the patch string (newline-terminated), or #f;; when nothing is selected. `body-line-index` is the 0-based position of a line;; within `hunk-lines`. Optional `mode` is 'forward (default) or 'reverse and;; selects the line-selection rule (see the section comment above). Pure.(define (build-apply-patch header-lines hunks include? . opt) (let* ([mode (if (pair? opt) (car opt) 'forward)] [built (let loop ([hs hunks] [i 0] [acc '()]) (if (null? hs) (reverse acc) (let ([h (build-hunk-text (car hs) i include? mode)]) (loop (cdr hs) (+ i 1) (if h (cons h acc) acc)))))]) (if (null? built) #f (string-append (lines->text header-lines) (apply string-append built)))))
;; Build the text of one filtered hunk, or #f if it has no included change line.(define (build-hunk-text h hunk-index include? mode) (let* ([lines (hunk-lines h)] [emitted (emit-hunk-lines lines hunk-index include? mode)] [body (car emitted)] [old-count (cadr emitted)] [new-count (caddr emitted)] [any-change? (cadddr emitted)]) (if (not any-change?) #f (let ([old-start (car (hunk-old-range h))] [new-start (car (hunk-new-range h))]) (string-append "@@ -" (number->string old-start) "," (number->string old-count) " +" (number->string new-start) "," (number->string new-count) " @@\n" (apply string-append body))))))
;; Walk a hunk's body lines, deciding what to emit per the selection rule for;; `mode`, and tally the resulting old/new line counts. Returns;; (list emitted-lines old-count new-count any-change?);; where emitted-lines is in order. In 'forward mode an unselected + is dropped;; and an unselected - becomes context; in 'reverse mode an unselected - is;; dropped and an unselected + becomes context.(define (emit-hunk-lines lines hunk-index include? mode) (let ([reverse? (eq? mode 'reverse)]) (let loop ([ls lines] [j 0] [emitted '()] [old 0] [new 0] [changed? #f]) (if (null? ls) (list (reverse emitted) old new changed?) (let* ([dl (car ls)] [k (diff-line-kind dl)] [text (diff-line-text dl)] [sel? (include? hunk-index j)]) (cond [(eq? k 'context) (loop (cdr ls) (+ j 1) (cons (string-append " " text "\n") emitted) (+ old 1) (+ new 1) changed?)] [(eq? k 'add) (cond [sel? (loop (cdr ls) (+ j 1) (cons (string-append "+" text "\n") emitted) old (+ new 1) #t)] [reverse? ;; unselected addition is present in current content: context (loop (cdr ls) (+ j 1) (cons (string-append " " text "\n") emitted) (+ old 1) (+ new 1) changed?)] [else (loop (cdr ls) (+ j 1) emitted old new changed?)])] [(eq? k 'del) (cond [sel? (loop (cdr ls) (+ j 1) (cons (string-append "-" text "\n") emitted) (+ old 1) new #t)] [reverse? ;; unselected deletion is absent from current content: drop it (loop (cdr ls) (+ j 1) emitted old new changed?)] [else ;; forward: unselected deletion becomes context (loop (cdr ls) (+ j 1) (cons (string-append " " text "\n") emitted) (+ old 1) (+ new 1) changed?)])] ;; meta ("\ No newline at end of file"): emit verbatim, no count [(eq? k 'meta) (loop (cdr ls) (+ j 1) (cons (string-append text "\n") emitted) old new changed?)] [else (loop (cdr ls) (+ j 1) emitted old new changed?)]))))))
(define (lines->text lines) (apply string-append (map (lambda (l) (string-append l "\n")) lines)))
;;@doc;; Read the metadata at the head of a file's diff. Returns a hash:;; 'binary? #t when git reported "Binary files ... differ";; 'rename? #t when the diff carries rename headers;; 'orig-path source path of a rename/copy, or #f;; 'new-file? / 'deleted? mode-change markers;; Partial-hunk staging consults these to refuse cases it cannot patch safely.(define (parse-diff-flags text) (diff-flags-from-lines (split-lines text) (empty-diff-flags)))
;; Fold the header lines into the flags hash. Plain recursion, not a named let:;; carrying this hash through a named-let binding miscompiles (see CLAUDE.md).(define (diff-flags-from-lines lines flags) (cond [(null? lines) flags] ;; Stop scanning at the first hunk; metadata is all above it. [(hunk-header-line? (car lines)) flags] [else (diff-flags-from-lines (cdr lines) (flag-line flags (car lines)))]))
(define (empty-diff-flags) (hash 'binary? #f 'rename? #f 'orig-path #f 'new-file? #f 'deleted? #f))
(define (flag-line flags line) (cond [(string-prefix? "Binary files " line) (hash-insert flags 'binary? #t)] [(string-prefix? "GIT binary patch" line) (hash-insert flags 'binary? #t)] [(string-prefix? "rename from " line) (hash-insert (hash-insert flags 'rename? #t) 'orig-path (string-trim (string-drop line (string-length "rename from "))))] [(string-prefix? "copy from " line) (hash-insert (hash-insert flags 'rename? #t) 'orig-path (string-trim (string-drop line (string-length "copy from "))))] [(string-prefix? "new file mode" line) (hash-insert flags 'new-file? #t)] [(string-prefix? "deleted file mode" line) (hash-insert flags 'deleted? #t)] [else flags]))
;;; Multi-file diffs ;;;;;;;;; `git show`, `git diff` over more than one path and `jj diff --git` all emit;;; one `diff --git` header block per file. The single-file parser throws those;;; away, so a whole-commit diff comes out as an unattributed hunk stream. This;;; cuts the stream on those headers first and keeps each file's path and;;; metadata beside its hunks, reusing the single-file parsers per chunk.;;;;;; The stream is split into lines once and the chunks are passed on as lines,;;; so nothing here re-splits what it has already cut apart. Each public parser;;; above is a thin `split-lines` wrapper over the line-list body this path;;; shares (`parse-hunk-lines`, `diff-flags-from-lines`, `header-block`).;;;;;; Definition order matters: a helper used here must appear above its caller,;;; or the module fails to load with `FreeIdentifier`.
;;@doc;; Split a multi-file unified diff into one entry per file, in stream order.;; Each entry is a hash:;; 'path the file's path: the post-image, or the pre-image when the;; file was deleted; #f when the headers carry none;; 'orig-path the rename/copy source, or #f;; 'status-code 'added / 'deleted / 'renamed / 'copied / 'modified;; 'flags the `parse-diff-flags` hash for this file;; 'hunks the file's hunks ('() for a binary or pure-rename diff);; A stream with no `diff --git` header at all is treated as one file.(define (parse-diff-files text) (file-entries (file-chunks (split-lines text)) '()))
(define (file-entries chunks acc) (if (null? chunks) (reverse acc) (file-entries (cdr chunks) (cons (file-entry (car chunks)) acc))))
(define (make-file-entry path orig-path status-code flags hunks) (hash 'path path 'orig-path orig-path 'status-code status-code 'flags flags 'hunks hunks))
(define (file-entry lines) (let ([header (header-block lines)] [flags (diff-flags-from-lines lines (empty-diff-flags))]) (make-file-entry (entry-path header) (hash-ref flags 'orig-path) (entry-status header flags) flags (parse-hunk-lines lines))))
;;; Cutting the stream ;;;
;; One line list per file. Anything before the first `diff --git` is dropped;; unless there is no such header anywhere, in which case the whole stream is one;; file (a bare `diff -u`, or output already narrowed to a single path).(define (file-chunks lines) (drop-preamble (collect-chunks lines #f '())))
(define (collect-chunks lines current acc) (cond [(null? lines) (reverse (close-chunk current acc))] [(file-header-line? (car lines)) (collect-chunks (cdr lines) (list (car lines)) (close-chunk current acc))] [current (collect-chunks (cdr lines) (cons (car lines) current) acc)] [else (collect-chunks (cdr lines) (list (car lines)) acc)]))
(define (close-chunk current acc) (if current (cons (reverse current) acc) acc))
(define (drop-preamble chunks) (if (or (null? chunks) (null? (cdr chunks)) (file-header-line? (car (car chunks)))) chunks (cdr chunks)))
;;; Reading a chunk's headers ;;;
(define (find-line lines prefix) (cond [(null? lines) #f] [(string-prefix? prefix (car lines)) (car lines)] [else (find-line (cdr lines) prefix)]))
;; The path a file entry is filed under. The `+++` marker names the post-image;; and is preferred; a deletion points it at /dev/null, so the `---` pre-image;; stands in. A pure rename has neither marker, leaving the rename target, and;; the `diff --git` line is the last resort (ambiguous when an unquoted path;; holds a space, which is exactly when git quotes it instead).(define (entry-path header) (let ([new (marker-path header "+++ ")] [old (marker-path header "--- ")] [renamed (rename-target header)] [from-git (git-line-path header)]) (cond [new new] [old old] [renamed renamed] [else from-git])))
;; The path from a `--- a/x` / `+++ b/x` marker: unquoted, with the a//b/;; prefix removed. #f when the marker is absent or names /dev/null.(define (marker-path header prefix) (let ([line (find-line header prefix)]) (if line (marker-path-of line prefix) #f)))
(define (marker-path-of line prefix) (let ([raw (marker-tail line prefix)]) (if (string=? raw "/dev/null") #f (strip-side-prefix raw))))
(define (marker-tail line prefix) (unquote-path (string-trim (string-drop line (string-length prefix)))))
(define (strip-side-prefix p) (if (or (string-prefix? "a/" p) (string-prefix? "b/" p)) (string-drop p 2) p))
;; The target of a rename or copy, the only path a pure-rename diff carries.(define (rename-target header) (let ([renamed (find-line header "rename to ")] [copied (find-line header "copy to ")]) (cond [renamed (marker-tail renamed "rename to ")] [copied (marker-tail copied "copy to ")] [else #f])))
(define (git-line-path header) (let ([line (find-line header "diff --git ")]) (if line (git-line-path-of (string-drop line (string-length "diff --git "))) #f)))
(define (git-line-path-of rest) (if (string-prefix? "\"" rest) (quoted-b-side rest) (last-token rest)))
(define (last-token rest) (let ([toks (split-many rest " ")]) (if (null? toks) #f (strip-side-prefix (list-ref toks (- (length toks) 1))))))
;; `"a/x y" "b/x y"` -> the second quoted token, unquoted and unprefixed.(define (quoted-b-side rest) (let ([toks (split-many rest "\" \"")]) (if (< (length toks) 2) #f (strip-side-prefix (unquote-path (string-append "\"" (list-ref toks 1)))))))
(define (entry-status header flags) (cond [(hash-ref flags 'new-file?) 'added] [(hash-ref flags 'deleted?) 'deleted] [(find-line header "copy from ") 'copied] [(hash-ref flags 'rename?) 'renamed] [else 'modified]))
;;; Quoted paths ;;;;;;;;; git quotes a path holding a control, quote or non-ASCII byte in C style.;;; Undo the escapes juju can meet; an unrecognised one keeps its character.
(define (unquote-path s) (if (and (>= (string-length s) 2) (string-prefix? "\"" s) (string-suffix? "\"" s)) (unescape-path (substring s 1 (- (string-length s) 1)) 0 '()) s))
(define (unescape-path s i acc) (cond [(>= i (string-length s)) (list->string (reverse acc))] [(and (char=? (string-ref s i) #\\) (< (+ i 1) (string-length s))) (unescape-path s (+ i 2) (cons (escaped-char (string-ref s (+ i 1))) acc))] [else (unescape-path s (+ i 1) (cons (string-ref s i) acc))]))
(define (escaped-char c) (cond [(char=? c #\t) #\tab] [(char=? c #\n) #\newline] [else c]))