rose-ash/lib/git/porcelain.sx

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