; 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)))