coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sx-git Phase 4: worktree — tree materialization, index overlay, status (TDD)

Browse Source 
Worktree is a value (path->data dict). tree-from-files/tree-files round-trip
through real tree objects (cid-identical to hand-built trees); index =
{:base tree-cid :staged overlay} in kv with add!/rm!/unstage!/index-tree!;
status = three-way dict diff (HEAD vs index vs worktree) with
staged/unstaged/untracked. 26/26, total 132/132.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 12:11:04 +00:00
parent eda6806989
commit 125d9f1398
5 changed files with 495 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

234
lib/git/worktree.sx Normal file
View File

@@ -0,0 +1,234 @@
; lib/git/worktree.sx — sx-git Phase 4: tree materialization, index, status.
; The "worktree" is a VALUE: a dict of path -> file data (no filesystem).
; The index is a staged-tree overlay {:base <tree-cid|nil> :staged
; {path -> {:data d} | {:removed true}}} stored in kv at <prefix>/index.
; status = three-way dict diff: HEAD tree vs index vs worktree.
; Requires: lib/git/object.sx, lib/git/ref.sx.
(define
git/wt-join
(fn
(segs)
(if
(empty? segs)
""
(reduce (fn (acc s) (str acc "/" s)) (first segs) (rest segs)))))
; ---- tree flattening: tree-cid -> dict path -> blob cid ----
(define
git/wt-flatten-into
(fn
(repo tree-cid prefix acc)
(let
((tree (git/read repo tree-cid)))
(reduce
(fn
(a name)
(let
((e (git/tree-entry-for tree name)))
(let
((path (if (equal? prefix "") name (str prefix "/" name))))
(if
(equal? (git/entry-kind e) "tree")
(git/wt-flatten-into repo (git/entry-cid e) path a)
(assoc a path (git/entry-cid e))))))
acc
(git/tree-names tree)))))
(define
git/tree-flatten
(fn (repo tree-cid) (git/wt-flatten-into repo tree-cid "" {})))
; ---- materialization: tree/commit -> dict path -> data ----
(define
git/tree-files
(fn
(repo tree-cid)
(let
((flat (git/tree-flatten repo tree-cid)))
(reduce
(fn
(a p)
(assoc a p (git/blob-data (git/read repo (get flat p)))))
{}
(keys flat)))))
(define
git/commit-files
(fn
(repo commit-cid)
(git/tree-files repo (git/commit-tree (git/read repo commit-cid)))))
; ---- inverse: dict path -> data => written tree, returns root tree cid ----
(define
git/wt-group
(fn
(files)
(reduce
(fn
(acc path)
(let
((segs (split path "/")))
(if
(= (len segs) 1)
(assoc
acc
:files (assoc (get acc :files) path (get files path)))
(let
((dir (first segs)))
(let
((cur (get (get acc :dirs) dir)))
(assoc
acc
:dirs (assoc
(get acc :dirs)
dir
(assoc
(if (dict? cur) cur {})
(git/wt-join (rest segs))
(get files path)))))))))
{:files {} :dirs {}}
(keys files))))
(define
git/tree-from-files
(fn
(repo files)
(let
((g (git/wt-group files)))
(let
((with-blobs (reduce (fn (acc name) (assoc acc name (git/tree-entry "blob" (git/write-blob repo (get (get g :files) name))))) {} (keys (get g :files)))))
(let
((entries (reduce (fn (acc dir) (assoc acc dir (git/tree-entry "tree" (git/tree-from-files repo (get (get g :dirs) dir))))) with-blobs (keys (get g :dirs)))))
(git/write repo (git/tree entries)))))))
; ---- index: staged overlay over a base tree ----
(define git/index-key (fn (repo) (str (get repo :prefix) "/index")))
(define
git/index-read
(fn
(repo)
(let
((v (persist/kv-get (get repo :db) (git/index-key repo))))
(if (dict? v) v {:base nil :staged {}}))))
(define
git/index-write!
(fn
(repo idx)
(begin (persist/kv-put (get repo :db) (git/index-key repo) idx) idx)))
; reset the index to a commit's tree (nil commit = empty index)
(define
git/index-init!
(fn (repo commit-cid) (git/index-write! repo {:base (if (equal? commit-cid nil) nil (git/commit-tree (git/read repo commit-cid))) :staged {}})))
(define
git/wt-stage!
(fn
(repo path entry)
(let
((idx (git/index-read repo)))
(git/index-write!
repo
(assoc idx :staged (assoc (get idx :staged) path entry))))))
(define git/add! (fn (repo path data) (git/wt-stage! repo path {:data data})))
(define git/rm! (fn (repo path) (git/wt-stage! repo path {:removed true})))
(define
git/unstage!
(fn
(repo path)
(let
((idx (git/index-read repo)))
(git/index-write!
repo
(assoc idx :staged (dissoc (get idx :staged) path))))))
; apply the overlay: base entries -> overridden/removed by staged
(define
git/wt-overlay
(fn
(base staged entry-fn)
(reduce
(fn
(acc path)
(let
((s (get staged path)))
(if
(has-key? s :removed)
(dissoc acc path)
(assoc acc path (entry-fn s)))))
base
(keys staged))))
; effective index as path -> blob cid
(define
git/index-cids
(fn
(repo)
(let
((idx (git/index-read repo)))
(git/wt-overlay
(if
(equal? (get idx :base) nil)
{}
(git/tree-flatten repo (get idx :base)))
(get idx :staged)
(fn (s) (git/cid (git/blob (get s :data))))))))
; effective index as path -> data
(define
git/index-files
(fn
(repo)
(let
((idx (git/index-read repo)))
(git/wt-overlay
(if
(equal? (get idx :base) nil)
{}
(git/tree-files repo (get idx :base)))
(get idx :staged)
(fn (s) (get s :data))))))
; write the staged state as a real tree; returns the root tree cid
(define
git/index-tree!
(fn (repo) (git/tree-from-files repo (git/index-files repo))))
; ---- status ----
(define
git/files-cids
(fn
(files)
(reduce
(fn (acc p) (assoc acc p (git/cid (git/blob (get files p)))))
{}
(keys files))))
(define git/files-diff (fn (old new) {:deleted (artdag/sort-strings (filter (fn (p) (not (has-key? new p))) (keys old))) :modified (artdag/sort-strings (filter (fn (p) (and (has-key? old p) (not (equal? (get old p) (get new p))))) (keys new))) :added (artdag/sort-strings (filter (fn (p) (not (has-key? old p))) (keys new)))}))
(define
git/head-tree-cids
(fn
(repo)
(let
((h (git/head repo)))
(if
(equal? h nil)
{}
(git/tree-flatten repo (git/commit-tree (git/read repo h)))))))
; worktree-files: dict path -> data (the caller's working copy value)
(define
git/status
(fn
(repo worktree-files)
(let
((headc (git/head-tree-cids repo))
(idxc (git/index-cids repo))
(wtc (git/files-cids worktree-files)))
(let ((unstaged (git/files-diff idxc wtc))) {:untracked (get unstaged :added) :staged (git/files-diff headc idxc) :unstaged {:deleted (get unstaged :deleted) :modified (get unstaged :modified)}}))))