From 7d3f267503a5891a438b00815059cfa4c8f27a77 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 12:25:26 +0000 Subject: [PATCH] =?UTF-8?q?sx-git=20Phase=207:=20porcelain=20=E2=80=94=20i?= =?UTF-8?q?nit/add/commit/branch/checkout/tag/reset/merge/log/diff=20(TDD)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit End-to-end topology story: fork, diverge, real merge commit (parents in order), fast-forward + up-to-date, annotated + lightweight tags, soft/mixed reset, detached HEAD commits, staged/unstaged unified diffs. Conflicted merges park MERGE_HEAD + stage the marker tree; git/merge-commit! concludes with two parents after resolution. Extensible commit meta flows through porcelain (agentic-sx shape verified). 40/40 — ROADMAP COMPLETE 227/227. Co-Authored-By: Claude Fable 5 --- lib/git/conformance.sh | 3 +- lib/git/porcelain.sx | 241 ++++++++++++++++++++++++++++++++++ lib/git/scoreboard.json | 7 +- lib/git/scoreboard.md | 3 +- lib/git/tests/porcelain.sx | 261 +++++++++++++++++++++++++++++++++++++ 5 files changed, 510 insertions(+), 5 deletions(-) create mode 100644 lib/git/porcelain.sx create mode 100644 lib/git/tests/porcelain.sx diff --git a/lib/git/conformance.sh b/lib/git/conformance.sh index 89a22eab..3a382afb 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 worktree diff merge) +SUITES=(object ref dag worktree diff merge porcelain) OUT_JSON="lib/git/scoreboard.json" OUT_MD="lib/git/scoreboard.md" @@ -48,6 +48,7 @@ run_suite() { (load "lib/git/worktree.sx") (load "lib/git/diff.sx") (load "lib/git/merge.sx") +(load "lib/git/porcelain.sx") (epoch 2) (eval "(define git-test-pass 0)") (eval "(define git-test-fail 0)") diff --git a/lib/git/porcelain.sx b/lib/git/porcelain.sx new file mode 100644 index 00000000..acb90b2f --- /dev/null +++ b/lib/git/porcelain.sx @@ -0,0 +1,241 @@ +; lib/git/porcelain.sx — sx-git Phase 7: the user-facing verbs. +; init/add/commit/branch/checkout/tag/reset/merge/log/diff composed from +; object+ref+dag+worktree+diff+merge. Branch advances go through ref CAS. +; A conflicted merge parks the other head in /MERGE_HEAD (like git's +; MERGE_HEAD) and stages the marker tree; resolve with git/add! then +; git/merge-commit!, which writes the two-parent commit and clears it. +; Requires: all previous lib/git modules. + +(define + git/init! + (fn + (db name) + (let + ((repo (git/repo-named db name))) + (begin (git/head-set! repo "main") (git/index-init! repo nil) repo)))) + +; advance whatever HEAD points at: the branch via CAS, or the detached pin +(define + git/porc-advance! + (fn + (repo old new) + (let + ((target (git/head-target repo))) + (if + (equal? target nil) + (git/head-detach! repo new) + (git/ref-cas! repo target old new))))) + +; commit the index; parent = current HEAD (none on an unborn branch) +(define + git/commit! + (fn + (repo meta) + (let + ((tree (git/index-tree! repo))) + (let + ((parent (git/head repo))) + (let + ((cid (git/write repo (git/commit tree (if (equal? parent nil) (list) (list parent)) meta)))) + (begin + (git/porc-advance! repo parent cid) + (git/index-write! repo {:base tree :staged {}}) + cid)))))) + +; branch at HEAD (create-only) +(define + git/branch! + (fn (repo name) (git/branch-create! repo name (git/head repo)))) + +; switch HEAD + index to a branch; returns the materialized files dict +(define + git/checkout! + (fn + (repo branch) + (let + ((cid (git/branch-get repo branch))) + (begin + (git/head-set! repo branch) + (git/index-init! repo cid) + (if (equal? cid nil) {} (git/commit-files repo cid)))))) + +(define + git/checkout-detached! + (fn + (repo cid) + (begin + (git/head-detach! repo cid) + (git/index-init! repo cid) + (git/commit-files repo cid)))) + +; annotated tag: tag OBJECT at HEAD, ref points at the tag object +(define + git/tag! + (fn + (repo name meta) + (let + ((cid (git/write repo (git/tag (git/head repo) name meta)))) + (begin (git/tag-set! repo name cid) cid)))) + +(define + git/tag-lightweight! + (fn + (repo name) + (begin (git/tag-set! repo name (git/head repo)) (git/head repo)))) + +; reset current branch to cid; "soft" keeps the index, "mixed" resets it +(define + git/reset! + (fn + (repo cid mode) + (begin + (git/porc-advance! repo (git/head repo) cid) + (when (equal? mode "mixed") (git/index-init! repo cid)) + cid))) + +; ---- merge a branch into HEAD ---- +(define + git/merge-head-key + (fn (repo) (str (get repo :prefix) "/MERGE_HEAD"))) +(define + git/merge-in-progress? + (fn + (repo) + (not + (equal? (persist/kv-get (get repo :db) (git/merge-head-key repo)) nil)))) + +(define + git/merge! + (fn + (repo branch meta) + (let + ((ours (git/head repo)) (theirs (git/branch-get repo branch))) + (let + ((m (git/merge-commits repo ours theirs))) + (cond + ((equal? (get m :result) "up-to-date") m) + ((equal? (get m :result) "fast-forward") + (begin + (git/porc-advance! repo ours theirs) + (git/index-init! repo theirs) + m)) + ((equal? (get m :result) "merged") + (let + ((cid (git/write repo (git/commit (get m :tree) (list ours theirs) meta)))) + (begin + (git/porc-advance! repo ours cid) + (git/index-write! repo {:base (get m :tree) :staged {}}) + {:conflicts (list) :cid cid :result "merged"}))) + (else + (begin + (persist/kv-put + (get repo :db) + (git/merge-head-key repo) + theirs) + (git/index-write! repo {:base (get m :tree) :staged {}}) + m))))))) + +; conclude a conflicted merge: commit the (resolved) index with two parents +(define + git/merge-commit! + (fn + (repo meta) + (let + ((theirs (persist/kv-get (get repo :db) (git/merge-head-key repo)))) + (if + (equal? theirs nil) + {:error "no merge in progress"} + (let + ((tree (git/index-tree! repo))) + (let + ((parent (git/head repo))) + (let + ((cid (git/write repo (git/commit tree (list parent theirs) meta)))) + (begin + (git/porc-advance! repo parent cid) + (git/index-write! repo {:base tree :staged {}}) + (persist/kv-delete (get repo :db) (git/merge-head-key repo)) + cid)))))))) + +; ---- porcelain diff/log ---- +(define + git/log-branch + (fn (repo branch) (git/log repo (git/branch-get repo branch)))) + +; unified diff across two path->data dicts (added, deleted, then modified) +(define + git/diff-files-unified + (fn + (fa fb) + (let + ((d (git/files-diff (git/files-cids fa) (git/files-cids fb)))) + (str + (reduce + (fn + (acc p) + (str + acc + "diff --sx a/" + p + " b/" + p + "\n--- /dev/null\n+++ b/" + p + "\n" + (git/diff-unified "" (get fb p)))) + "" + (get d :added)) + (reduce + (fn + (acc p) + (str + acc + "diff --sx a/" + p + " b/" + p + "\n--- a/" + p + "\n+++ /dev/null\n" + (git/diff-unified (get fa p) ""))) + "" + (get d :deleted)) + (reduce + (fn + (acc p) + (str + acc + "diff --sx a/" + p + " b/" + p + "\n--- a/" + p + "\n+++ b/" + p + "\n" + (git/diff-unified (get fa p) (get fb p)))) + "" + (get d :modified)))))) + +(define + git/porc-head-files + (fn + (repo) + (let + ((h (git/head repo))) + (if (equal? h nil) {} (git/commit-files repo h))))) + +; staged: HEAD vs index; unstaged: index vs the caller's worktree value +(define + git/diff-staged + (fn + (repo) + (git/diff-files-unified + (git/porc-head-files repo) + (git/index-files repo)))) +(define + git/diff-unstaged + (fn + (repo worktree-files) + (git/diff-files-unified (git/index-files repo) worktree-files))) diff --git a/lib/git/scoreboard.json b/lib/git/scoreboard.json index 18b8adc7..e88a6853 100644 --- a/lib/git/scoreboard.json +++ b/lib/git/scoreboard.json @@ -5,9 +5,10 @@ "dag": {"pass": 30, "fail": 0}, "worktree": {"pass": 26, "fail": 0}, "diff": {"pass": 27, "fail": 0}, - "merge": {"pass": 28, "fail": 0} + "merge": {"pass": 28, "fail": 0}, + "porcelain": {"pass": 40, "fail": 0} }, - "total_pass": 187, + "total_pass": 227, "total_fail": 0, - "total": 187 + "total": 227 } diff --git a/lib/git/scoreboard.md b/lib/git/scoreboard.md index d906fabd..4eb78db4 100644 --- a/lib/git/scoreboard.md +++ b/lib/git/scoreboard.md @@ -10,4 +10,5 @@ _Generated by `lib/git/conformance.sh`_ | worktree | 26 | 0 | 26 | | diff | 27 | 0 | 27 | | merge | 28 | 0 | 28 | -| **Total** | **187** | **0** | **187** | +| porcelain | 40 | 0 | 40 | +| **Total** | **227** | **0** | **227** | diff --git a/lib/git/tests/porcelain.sx b/lib/git/tests/porcelain.sx new file mode 100644 index 00000000..4ab18ba9 --- /dev/null +++ b/lib/git/tests/porcelain.sx @@ -0,0 +1,261 @@ +; Phase 7 — porcelain: init/add/commit/branch/checkout/tag/reset/merge/log/diff +; as one end-to-end topology story, plus the conflicted-merge flow. + +(define gpc-db (persist/mem-backend)) +(define gpc (git/init! gpc-db "proj")) + +; ---- init ---- +(git-test + "init points HEAD at an unborn main" + (git/head-target gpc) + "heads/main") +(git-test "init has no commits yet" (git/head gpc) nil) +(git-test + "init status is clean and empty" + (= (git/status gpc {}) {:untracked (list) :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}}) + true) + +; ---- first commit on main ---- +(git-test + "staged files show before the first commit" + (begin + (git/add! gpc "README.md" "hello\n") + (git/add! gpc "src/main.sx" "(main)\n") + (= + (get (get (git/status gpc {}) :staged) :added) + (list "README.md" "src/main.sx"))) + true) + +(define gpc-c1 (git/commit! gpc {:message "c1" :author "ada"})) + +(git-test "commit! advances HEAD through main" (git/head gpc) gpc-c1) +(git-test "commit! moved the branch ref" (git/branch-get gpc "main") gpc-c1) +(git-test + "the commit carries the author" + (git/commit-author (git/read gpc gpc-c1)) + "ada") +(git-test + "first commit has no parents" + (= (git/commit-parents (git/read gpc gpc-c1)) (list)) + true) +(git-test + "commit materializes the staged files" + (= + (git/commit-files gpc gpc-c1) + (assoc (assoc {} "README.md" "hello\n") "src/main.sx" "(main)\n")) + true) +(git-test "after commit! the index is clean" (git/diff-staged gpc) "") +(git-test + "extensible meta flows through porcelain" + (let + ((r (git/init! (persist/mem-backend) "x"))) + (begin + (git/add! r "f" "1\n") + (get (git/read r (git/commit! r {:message "m" :agent "claude-fable"})) :agent))) + "claude-fable") + +; ---- branch + checkout ---- +(git-test "branch! forks at HEAD" (git/branch! gpc "feature") gpc-c1) +(git-test + "checkout! returns the materialized worktree" + (= (git/checkout! gpc "feature") (git/commit-files gpc gpc-c1)) + true) +(git-test "checkout! retargets HEAD" (git/head-target gpc) "heads/feature") + +(define + gpc-c2 + (begin + (git/add! gpc "src/feature.sx" "(feature)\n") + (git/commit! gpc {:message "c2" :author "ada"}))) + +(git-test + "feature moved, main did not" + (= + (list (git/branch-get gpc "feature") (git/branch-get gpc "main")) + (list gpc-c2 gpc-c1)) + true) +(git-test + "checkout back to main drops the feature file" + (has-key? (git/checkout! gpc "main") "src/feature.sx") + false) + +(define + gpc-c3 + (begin + (git/add! gpc "README.md" "hello\nworld\n") + (git/commit! gpc {:message "c3" :author "ada"}))) + +; ---- real merge ---- +(define gpc-m (git/merge! gpc "feature" {:message "merge feature" :author "ada"})) + +(git-test + "diverged branches produce a merge commit" + (get gpc-m :result) + "merged") +(git-test + "merge commit has both parents in order" + (= + (git/commit-parents (git/read gpc (get gpc-m :cid))) + (list gpc-c3 gpc-c2)) + true) +(git-test + "merge result is where HEAD is now" + (git/head gpc) + (get gpc-m :cid)) +(git-test + "merged tree unions both changes" + (= + (git/commit-files gpc (git/head gpc)) + (assoc + (assoc + (assoc {} "README.md" "hello\nworld\n") + "src/main.sx" + "(main)\n") + "src/feature.sx" + "(feature)\n")) + true) +(git-test "no merge left in progress" (git/merge-in-progress? gpc) false) +(git-test + "log walks the merged topology newest-first" + (= + (git/log-messages gpc (git/head gpc)) + (list "merge feature" "c2" "c3" "c1")) + true) +(git-test + "merge-base of the two legs is the fork point" + (git/merge-base gpc gpc-c2 gpc-c3) + gpc-c1) + +; ---- fast-forward + up-to-date ---- +(define gpc-c4 (get gpc-m :cid)) +(define + gpc-c5 + (begin + (git/branch! gpc "hotfix") + (git/checkout! gpc "hotfix") + (git/add! gpc "fix.txt" "patched\n") + (git/commit! gpc {:message "c5" :author "ada"}))) + +(git-test + "merging a descendant fast-forwards" + (begin + (git/checkout! gpc "main") + (get (git/merge! gpc "hotfix" {:message "unused"}) :result)) + "fast-forward") +(git-test + "fast-forward moved main to the hotfix tip" + (git/branch-get gpc "main") + gpc-c5) +(git-test + "merging it again is up-to-date" + (get (git/merge! gpc "hotfix" {:message "unused"}) :result) + "up-to-date") + +; ---- tags ---- +(git-test + "tag! writes an annotated tag object at HEAD" + (begin + (git/tag! gpc "v1" {:tagger "ada"}) + (git/tag-target (git/read gpc (git/tag-get gpc "v1")))) + gpc-c5) +(git-test + "lightweight tag points straight at the commit" + (begin (git/tag-lightweight! gpc "tip") (git/tag-get gpc "tip")) + gpc-c5) + +; ---- reset ---- +(git-test + "soft reset moves the branch but keeps the index" + (begin + (git/reset! gpc gpc-c4 "soft") + (list (git/head gpc) (contains? (git/diff-staged gpc) "+patched"))) + (list gpc-c4 true)) +(git-test + "mixed reset also resets the index" + (begin + (git/reset! gpc gpc-c5 "mixed") + (list (git/head gpc) (git/diff-staged gpc))) + (list gpc-c5 "")) + +; ---- detached HEAD ---- +(git-test + "detached checkout pins the cid" + (begin + (git/checkout-detached! gpc gpc-c1) + (list (git/detached? gpc) (git/head gpc))) + (list true gpc-c1)) +(git-test + "committing while detached moves only the pin" + (let + ((c6 (begin (git/add! gpc "scratch.txt" "s\n") (git/commit! gpc {:message "c6"})))) + (list (git/head gpc) (git/branch-get gpc "main"))) + (list (git/head gpc) gpc-c5)) +(git-test + "checkout! reattaches to a branch" + (begin (git/checkout! gpc "main") (git/head-target gpc)) + "heads/main") + +; ---- unstaged diff ---- +(git-test + "diff-unstaged renders worktree edits" + (contains? + (git/diff-unstaged + gpc + (assoc (git/commit-files gpc (git/head gpc)) "fix.txt" "patched\nedit\n")) + "+edit") + true) + +; ---- conflicted merge flow ---- +(define gcf (git/init! (persist/mem-backend) "cf")) +(define + gcf-c1 + (begin (git/add! gcf "f.txt" "a\nb\nc\n") (git/commit! gcf {:message "base"}))) +(define + gcf-c2 + (begin + (git/branch! gcf "left") + (git/add! gcf "f.txt" "a\nX\nc\n") + (git/commit! gcf {:message "ours"}))) +(define + gcf-c3 + (begin + (git/checkout! gcf "left") + (git/add! gcf "f.txt" "a\nY\nc\n") + (git/commit! gcf {:message "theirs"}))) +(define + gcf-m + (begin (git/checkout! gcf "main") (git/merge! gcf "left" {:message "m"}))) + +(git-test + "conflicting merge reports the paths" + (= + (list (get gcf-m :result) (get gcf-m :conflicts)) + (list "conflicts" (list "f.txt"))) + true) +(git-test + "a conflicted merge is in progress" + (git/merge-in-progress? gcf) + true) +(git-test + "the conflicted file is staged with markers" + (contains? (get (git/index-files gcf) "f.txt") "<<<<<<< ours") + true) +(git-test "HEAD did not move on conflict" (git/head gcf) gcf-c2) +(git-test + "merge-commit! concludes with two parents" + (begin + (git/add! gcf "f.txt" "a\nXY\nc\n") + (let + ((mc (git/merge-commit! gcf {:message "resolved"}))) + (= + (list + (git/head gcf) + (git/commit-parents (git/read gcf mc)) + (get (git/commit-files gcf mc) "f.txt") + (git/merge-in-progress? gcf)) + (list mc (list gcf-c2 gcf-c3) "a\nXY\nc\n" false)))) + true) +(git-test + "merge-commit! without a merge in progress errors" + (get (git/merge-commit! gcf {:message "x"}) :error) + "no merge in progress")