From 125d9f13986d68081c8fa9e625f84b9a9dd2a3e9 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 12:11:04 +0000 Subject: [PATCH] =?UTF-8?q?sx-git=20Phase=204:=20worktree=20=E2=80=94=20tr?= =?UTF-8?q?ee=20materialization,=20index=20overlay,=20status=20(TDD)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Worktree is a value (path->data dict). tree-from-files/tree-files round-trip through real tree objects (cid-identical to hand-built trees); index = {:base tree-cid :staged overlay} in kv with add!/rm!/unstage!/index-tree!; status = three-way dict diff (HEAD vs index vs worktree) with staged/unstaged/untracked. 26/26, total 132/132. Co-Authored-By: Claude Fable 5 --- lib/git/conformance.sh | 3 +- lib/git/scoreboard.json | 7 +- lib/git/scoreboard.md | 3 +- lib/git/tests/worktree.sx | 253 ++++++++++++++++++++++++++++++++++++++ lib/git/worktree.sx | 234 +++++++++++++++++++++++++++++++++++ 5 files changed, 495 insertions(+), 5 deletions(-) create mode 100644 lib/git/tests/worktree.sx create mode 100644 lib/git/worktree.sx diff --git a/lib/git/conformance.sh b/lib/git/conformance.sh index 791d710a..84772a48 100755 --- a/lib/git/conformance.sh +++ b/lib/git/conformance.sh @@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(object ref dag) +SUITES=(object ref dag worktree) OUT_JSON="lib/git/scoreboard.json" OUT_MD="lib/git/scoreboard.md" @@ -45,6 +45,7 @@ run_suite() { (load "lib/git/object.sx") (load "lib/git/ref.sx") (load "lib/git/dag.sx") +(load "lib/git/worktree.sx") (epoch 2) (eval "(define git-test-pass 0)") (eval "(define git-test-fail 0)") diff --git a/lib/git/scoreboard.json b/lib/git/scoreboard.json index 27441a5b..8317572d 100644 --- a/lib/git/scoreboard.json +++ b/lib/git/scoreboard.json @@ -2,9 +2,10 @@ "suites": { "object": {"pass": 38, "fail": 0}, "ref": {"pass": 38, "fail": 0}, - "dag": {"pass": 30, "fail": 0} + "dag": {"pass": 30, "fail": 0}, + "worktree": {"pass": 26, "fail": 0} }, - "total_pass": 106, + "total_pass": 132, "total_fail": 0, - "total": 106 + "total": 132 } diff --git a/lib/git/scoreboard.md b/lib/git/scoreboard.md index b83dc3d5..cfd7d435 100644 --- a/lib/git/scoreboard.md +++ b/lib/git/scoreboard.md @@ -7,4 +7,5 @@ _Generated by `lib/git/conformance.sh`_ | object | 38 | 0 | 38 | | ref | 38 | 0 | 38 | | dag | 30 | 0 | 30 | -| **Total** | **106** | **0** | **106** | +| worktree | 26 | 0 | 26 | +| **Total** | **132** | **0** | **132** | diff --git a/lib/git/tests/worktree.sx b/lib/git/tests/worktree.sx new file mode 100644 index 00000000..2007307a --- /dev/null +++ b/lib/git/tests/worktree.sx @@ -0,0 +1,253 @@ +; Phase 4 — worktree: tree materialization (files-dict <-> tree objects), +; index as staged-tree overlay, three-way status. + +(define gwt-db (persist/mem-backend)) +(define gwt (git/repo gwt-db)) + +(define + gwt-files + (assoc + (assoc (assoc {} "a.txt" "hello\n") "b.txt" "world\n") + "sub/c.txt" + "sub\n")) + +(define gwt-tree (git/tree-from-files gwt gwt-files)) +(define gwt-c1 (git/write gwt (git/commit gwt-tree (list) {:message "c1"}))) + +; fresh repo with the fixture committed, HEAD on main, index clean +(define + gwt-fresh! + (fn + () + (let + ((r (git/repo (persist/mem-backend)))) + (let + ((tc (git/tree-from-files r gwt-files))) + (let + ((c (git/write r (git/commit tc (list) {:message "c1"})))) + (begin + (git/branch-set! r "main" c) + (git/head-set! r "main") + (git/index-init! r c) + r)))))) + +(define gwt-clean {:untracked (list) :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}}) + +; ---- tree building + materialization ---- +(git-test + "tree-from-files writes a tree object" + (git/tree? (git/read gwt gwt-tree)) + true) +(git-test + "tree-files round-trips the files dict" + (= (git/tree-files gwt gwt-tree) gwt-files) + true) +(git-test + "tree-from-files is deterministic" + (equal? (git/tree-from-files gwt gwt-files) gwt-tree) + true) +(git-test + "matches a manually built tree" + (equal? + (git/write + gwt + (git/tree + (assoc + (assoc + (assoc + {} + "a.txt" + (git/tree-entry "blob" (git/write-blob gwt "hello\n"))) + "b.txt" + (git/tree-entry "blob" (git/write-blob gwt "world\n"))) + "sub" + (git/tree-entry + "tree" + (git/write + gwt + (git/tree + (assoc + {} + "c.txt" + (git/tree-entry "blob" (git/write-blob gwt "sub\n"))))))))) + gwt-tree) + true) +(git-test + "flatten lists nested paths" + (= + (artdag/sort-strings (keys (git/tree-flatten gwt gwt-tree))) + (list "a.txt" "b.txt" "sub/c.txt")) + true) +(git-test + "flatten maps a path to its blob cid" + (get (git/tree-flatten gwt gwt-tree) "a.txt") + (git/cid (git/blob "hello\n"))) +(git-test + "commit-files materializes through the commit" + (= (git/commit-files gwt gwt-c1) gwt-files) + true) +(git-test + "deep nesting round-trips" + (let + ((files (assoc {} "x/y/z.txt" "deep"))) + (= (git/tree-files gwt (git/tree-from-files gwt files)) files)) + true) +(git-test + "empty files dict is an empty tree" + (= (git/tree-files gwt (git/tree-from-files gwt {})) {}) + true) + +; ---- index ---- +(git-test + "default index is empty over no base" + (= (git/index-read (git/repo (persist/mem-backend))) {:base nil :staged {}}) + true) +(git-test + "index-init! bases the index on the commit tree" + (let ((r (gwt-fresh!))) (= (git/index-files r) gwt-files)) + true) +(git-test + "add! stages new content" + (let + ((r (gwt-fresh!))) + (begin + (git/add! r "new.txt" "fresh") + (get (git/index-files r) "new.txt"))) + "fresh") +(git-test + "add! overlays an existing path" + (let + ((r (gwt-fresh!))) + (begin (git/add! r "a.txt" "changed") (get (git/index-files r) "a.txt"))) + "changed") +(git-test + "rm! stages a removal" + (let + ((r (gwt-fresh!))) + (begin (git/rm! r "b.txt") (has-key? (git/index-files r) "b.txt"))) + false) +(git-test + "unstage! reverts to the base" + (let + ((r (gwt-fresh!))) + (begin + (git/add! r "a.txt" "changed") + (git/unstage! r "a.txt") + (get (git/index-files r) "a.txt"))) + "hello\n") +(git-test + "index-tree! of a clean index reproduces the commit tree cid" + (let + ((r (gwt-fresh!))) + (equal? + (git/index-tree! r) + (git/commit-tree (git/read r (git/head r))))) + true) +(git-test + "index-tree! materializes staged changes" + (let + ((r (gwt-fresh!))) + (begin + (git/add! r "a.txt" "changed") + (git/rm! r "b.txt") + (= + (git/tree-files r (git/index-tree! r)) + (assoc (assoc {} "a.txt" "changed") "sub/c.txt" "sub\n")))) + true) + +; ---- status ---- +(git-test + "clean repo, clean worktree" + (= (git/status (gwt-fresh!) gwt-files) gwt-clean) + true) +(git-test + "staged addition" + (let + ((r (gwt-fresh!))) + (begin + (git/add! r "new.txt" "fresh") + (= + (get (get (git/status r gwt-files) :staged) :added) + (list "new.txt")))) + true) +(git-test + "staged modification" + (let + ((r (gwt-fresh!))) + (begin + (git/add! r "a.txt" "changed") + (= + (get + (get (git/status r (assoc gwt-files "a.txt" "changed")) :staged) + :modified) + (list "a.txt")))) + true) +(git-test + "staged deletion" + (let + ((r (gwt-fresh!))) + (begin + (git/rm! r "b.txt") + (= + (get + (get (git/status r (dissoc gwt-files "b.txt")) :staged) + :deleted) + (list "b.txt")))) + true) +(git-test + "unstaged modification" + (let + ((r (gwt-fresh!))) + (= + (get + (get (git/status r (assoc gwt-files "a.txt" "edited")) :unstaged) + :modified) + (list "a.txt"))) + true) +(git-test + "unstaged deletion" + (let + ((r (gwt-fresh!))) + (= + (get + (get (git/status r (dissoc gwt-files "sub/c.txt")) :unstaged) + :deleted) + (list "sub/c.txt"))) + true) +(git-test + "untracked file" + (let + ((r (gwt-fresh!))) + (= + (get (git/status r (assoc gwt-files "notes.md" "hi")) :untracked) + (list "notes.md"))) + true) +(git-test + "combined status" + (let + ((r (gwt-fresh!))) + (begin + (git/add! r "staged.txt" "s") + (git/add! r "a.txt" "changed") + (git/rm! r "b.txt") + (= + (git/status + r + (assoc + (assoc + (assoc + (dissoc (dissoc gwt-files "b.txt") "sub/c.txt") + "a.txt" + "changed-again") + "staged.txt" + "s") + "wild.txt" + "w")) + {:untracked (list "wild.txt") :staged {:deleted (list "b.txt") :modified (list "a.txt") :added (list "staged.txt")} :unstaged {:deleted (list "sub/c.txt") :modified (list "a.txt")}}))) + true) +(git-test + "no HEAD, no index: everything untracked" + (let + ((r (git/repo (persist/mem-backend)))) + (= (git/status r (assoc {} "f.txt" "x")) {:untracked (list "f.txt") :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}})) + true) diff --git a/lib/git/worktree.sx b/lib/git/worktree.sx new file mode 100644 index 00000000..7a13c639 --- /dev/null +++ b/lib/git/worktree.sx @@ -0,0 +1,234 @@ +; lib/git/worktree.sx — sx-git Phase 4: tree materialization, index, status. +; The "worktree" is a VALUE: a dict of path -> file data (no filesystem). +; The index is a staged-tree overlay {:base :staged +; {path -> {:data d} | {:removed true}}} stored in kv at /index. +; status = three-way dict diff: HEAD tree vs index vs worktree. +; Requires: lib/git/object.sx, lib/git/ref.sx. + +(define + git/wt-join + (fn + (segs) + (if + (empty? segs) + "" + (reduce (fn (acc s) (str acc "/" s)) (first segs) (rest segs))))) + +; ---- tree flattening: tree-cid -> dict path -> blob cid ---- +(define + git/wt-flatten-into + (fn + (repo tree-cid prefix acc) + (let + ((tree (git/read repo tree-cid))) + (reduce + (fn + (a name) + (let + ((e (git/tree-entry-for tree name))) + (let + ((path (if (equal? prefix "") name (str prefix "/" name)))) + (if + (equal? (git/entry-kind e) "tree") + (git/wt-flatten-into repo (git/entry-cid e) path a) + (assoc a path (git/entry-cid e)))))) + acc + (git/tree-names tree))))) + +(define + git/tree-flatten + (fn (repo tree-cid) (git/wt-flatten-into repo tree-cid "" {}))) + +; ---- materialization: tree/commit -> dict path -> data ---- +(define + git/tree-files + (fn + (repo tree-cid) + (let + ((flat (git/tree-flatten repo tree-cid))) + (reduce + (fn + (a p) + (assoc a p (git/blob-data (git/read repo (get flat p))))) + {} + (keys flat))))) + +(define + git/commit-files + (fn + (repo commit-cid) + (git/tree-files repo (git/commit-tree (git/read repo commit-cid))))) + +; ---- inverse: dict path -> data => written tree, returns root tree cid ---- +(define + git/wt-group + (fn + (files) + (reduce + (fn + (acc path) + (let + ((segs (split path "/"))) + (if + (= (len segs) 1) + (assoc + acc + :files (assoc (get acc :files) path (get files path))) + (let + ((dir (first segs))) + (let + ((cur (get (get acc :dirs) dir))) + (assoc + acc + :dirs (assoc + (get acc :dirs) + dir + (assoc + (if (dict? cur) cur {}) + (git/wt-join (rest segs)) + (get files path))))))))) + {:files {} :dirs {}} + (keys files)))) + +(define + git/tree-from-files + (fn + (repo files) + (let + ((g (git/wt-group files))) + (let + ((with-blobs (reduce (fn (acc name) (assoc acc name (git/tree-entry "blob" (git/write-blob repo (get (get g :files) name))))) {} (keys (get g :files))))) + (let + ((entries (reduce (fn (acc dir) (assoc acc dir (git/tree-entry "tree" (git/tree-from-files repo (get (get g :dirs) dir))))) with-blobs (keys (get g :dirs))))) + (git/write repo (git/tree entries))))))) + +; ---- index: staged overlay over a base tree ---- +(define git/index-key (fn (repo) (str (get repo :prefix) "/index"))) + +(define + git/index-read + (fn + (repo) + (let + ((v (persist/kv-get (get repo :db) (git/index-key repo)))) + (if (dict? v) v {:base nil :staged {}})))) + +(define + git/index-write! + (fn + (repo idx) + (begin (persist/kv-put (get repo :db) (git/index-key repo) idx) idx))) + +; reset the index to a commit's tree (nil commit = empty index) +(define + git/index-init! + (fn (repo commit-cid) (git/index-write! repo {:base (if (equal? commit-cid nil) nil (git/commit-tree (git/read repo commit-cid))) :staged {}}))) + +(define + git/wt-stage! + (fn + (repo path entry) + (let + ((idx (git/index-read repo))) + (git/index-write! + repo + (assoc idx :staged (assoc (get idx :staged) path entry)))))) + +(define git/add! (fn (repo path data) (git/wt-stage! repo path {:data data}))) +(define git/rm! (fn (repo path) (git/wt-stage! repo path {:removed true}))) + +(define + git/unstage! + (fn + (repo path) + (let + ((idx (git/index-read repo))) + (git/index-write! + repo + (assoc idx :staged (dissoc (get idx :staged) path)))))) + +; apply the overlay: base entries -> overridden/removed by staged +(define + git/wt-overlay + (fn + (base staged entry-fn) + (reduce + (fn + (acc path) + (let + ((s (get staged path))) + (if + (has-key? s :removed) + (dissoc acc path) + (assoc acc path (entry-fn s))))) + base + (keys staged)))) + +; effective index as path -> blob cid +(define + git/index-cids + (fn + (repo) + (let + ((idx (git/index-read repo))) + (git/wt-overlay + (if + (equal? (get idx :base) nil) + {} + (git/tree-flatten repo (get idx :base))) + (get idx :staged) + (fn (s) (git/cid (git/blob (get s :data)))))))) + +; effective index as path -> data +(define + git/index-files + (fn + (repo) + (let + ((idx (git/index-read repo))) + (git/wt-overlay + (if + (equal? (get idx :base) nil) + {} + (git/tree-files repo (get idx :base))) + (get idx :staged) + (fn (s) (get s :data)))))) + +; write the staged state as a real tree; returns the root tree cid +(define + git/index-tree! + (fn (repo) (git/tree-from-files repo (git/index-files repo)))) + +; ---- status ---- +(define + git/files-cids + (fn + (files) + (reduce + (fn (acc p) (assoc acc p (git/cid (git/blob (get files p))))) + {} + (keys files)))) + +(define git/files-diff (fn (old new) {:deleted (artdag/sort-strings (filter (fn (p) (not (has-key? new p))) (keys old))) :modified (artdag/sort-strings (filter (fn (p) (and (has-key? old p) (not (equal? (get old p) (get new p))))) (keys new))) :added (artdag/sort-strings (filter (fn (p) (not (has-key? old p))) (keys new)))})) + +(define + git/head-tree-cids + (fn + (repo) + (let + ((h (git/head repo))) + (if + (equal? h nil) + {} + (git/tree-flatten repo (git/commit-tree (git/read repo h))))))) + +; worktree-files: dict path -> data (the caller's working copy value) +(define + git/status + (fn + (repo worktree-files) + (let + ((headc (git/head-tree-cids repo)) + (idxc (git/index-cids repo)) + (wtc (git/files-cids worktree-files))) + (let ((unstaged (git/files-diff idxc wtc))) {:untracked (get unstaged :added) :staged (git/files-diff headc idxc) :unstaged {:deleted (get unstaged :deleted) :modified (get unstaged :modified)}}))))