rose-ash/lib/git/ref.sx

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