; lib/git/ref.sx — sx-git Phase 2: refs as name -> cid over persist kv. ; A ref value is {:cid cid} (direct) or {:symref name} (symbolic). Atomic ; update = persist/kv-cas (old-value expect); create-only = kv-put-new. ; Every direct-ref move is recorded in an append-only reflog stream ; (persist log facet), one stream per ref name. ; Requires: lib/git/object.sx (repo handle), lib/persist/kv.sx, log.sx. (define git/ref-key (fn (repo name) (str (get repo :prefix) "/ref/" name))) (define git/reflog-stream (fn (repo name) (str (get repo :prefix) "/reflog/" name))) (define git/reflog-record! (fn (repo name old new) (persist/append (get repo :db) (git/reflog-stream repo name) "ref-update" 0 {:new new :old old}))) ; ---- raw ref values ---- (define git/ref-read (fn (repo name) (persist/kv-get (get repo :db) (git/ref-key repo name)))) (define git/symref? (fn (v) (and (dict? v) (has-key? v :symref)))) ; direct cid or nil — does NOT follow symrefs (define git/ref-get (fn (repo name) (let ((v (git/ref-read repo name))) (if (dict? v) (get v :cid) nil)))) ; ---- writes ---- (define git/ref-set! (fn (repo name cid) (let ((old (git/ref-get repo name))) (begin (persist/kv-put (get repo :db) (git/ref-key repo name) {:cid cid}) (git/reflog-record! repo name old cid) cid)))) (define git/symref-set! (fn (repo name target) (begin (persist/kv-put (get repo :db) (git/ref-key repo name) {:symref target}) target))) (define git/ref-delete! (fn (repo name) (persist/kv-delete (get repo :db) (git/ref-key repo name)))) ; ---- resolution (symref chains, bounded) ---- (define git/ref-resolve-n (fn (repo name depth) (if (<= depth 0) nil (let ((v (git/ref-read repo name))) (cond ((git/symref? v) (git/ref-resolve-n repo (get v :symref) (- depth 1))) ((dict? v) (get v :cid)) (else nil)))))) (define git/ref-resolve (fn (repo name) (git/ref-resolve-n repo name 10))) ; ---- atomic update: expected old cid (nil = must not exist) ---- (define git/ref-cas! (fn (repo name expected new) (let ((res (persist/kv-cas (get repo :db) (git/ref-key repo name) (if (equal? expected nil) nil {:cid expected}) {:cid new}))) (if (and (dict? res) (has-key? res :conflict)) {:actual (if (dict? (get res :actual)) (get (get res :actual) :cid) nil) :conflict true} (begin (git/reflog-record! repo name expected new) new))))) ; ---- listing ---- (define git/ref-names (fn (repo) (let ((pfx (str (get repo :prefix) "/ref/"))) (artdag/sort-strings (map (fn (k) (substring k (string-length pfx) (string-length k))) (filter (fn (k) (starts-with? k pfx)) (persist/kv-keys (get repo :db)))))))) (define git/refs-under (fn (repo group) (map (fn (n) (substring n (string-length group) (string-length n))) (filter (fn (n) (starts-with? n group)) (git/ref-names repo))))) ; ---- branches ---- (define git/branch-ref (fn (name) (str "heads/" name))) (define git/branch-set! (fn (repo name cid) (git/ref-set! repo (git/branch-ref name) cid))) (define git/branch-get (fn (repo name) (git/ref-get repo (git/branch-ref name)))) (define git/branch-cas! (fn (repo name expected new) (git/ref-cas! repo (git/branch-ref name) expected new))) (define git/branch-delete! (fn (repo name) (git/ref-delete! repo (git/branch-ref name)))) (define git/branches (fn (repo) (git/refs-under repo "heads/"))) ; create-only: conflict if the branch already exists (define git/branch-create! (fn (repo name cid) (let ((res (persist/kv-put-new (get repo :db) (git/ref-key repo (git/branch-ref name)) {:cid cid}))) (if (and (dict? res) (has-key? res :conflict)) {:actual (get (get res :actual) :cid) :conflict true} (begin (git/reflog-record! repo (git/branch-ref name) nil cid) cid))))) ; ---- lightweight tag refs (annotated tag objects live in the object store) ---- (define git/tag-refname (fn (name) (str "tags/" name))) (define git/tag-set! (fn (repo name cid) (git/ref-set! repo (git/tag-refname name) cid))) (define git/tag-get (fn (repo name) (git/ref-get repo (git/tag-refname name)))) (define git/tag-names (fn (repo) (git/refs-under repo "tags/"))) ; ---- HEAD ---- (define git/head-set! (fn (repo branch) (git/symref-set! repo "HEAD" (git/branch-ref branch)))) (define git/head-detach! (fn (repo cid) (begin (persist/kv-put (get repo :db) (git/ref-key repo "HEAD") {:cid cid}) cid))) (define git/head (fn (repo) (git/ref-resolve repo "HEAD"))) ; branch ref name HEAD points at, or nil when detached/unset (define git/head-target (fn (repo) (let ((v (git/ref-read repo "HEAD"))) (if (git/symref? v) (get v :symref) nil)))) (define git/detached? (fn (repo) (let ((v (git/ref-read repo "HEAD"))) (and (dict? v) (has-key? v :cid))))) ; ---- reflog: oldest-first list of {:old :new} ---- (define git/reflog (fn (repo name) (map (fn (e) (persist/event-data e)) (persist/read (get repo :db) (git/reflog-stream repo name)))))