; Phase 4 — worktree: tree materialization (files-dict <-> tree objects), ; index as staged-tree overlay, three-way status. (define gwt-db (persist/mem-backend)) (define gwt (git/repo gwt-db)) (define gwt-files (assoc (assoc (assoc {} "a.txt" "hello\n") "b.txt" "world\n") "sub/c.txt" "sub\n")) (define gwt-tree (git/tree-from-files gwt gwt-files)) (define gwt-c1 (git/write gwt (git/commit gwt-tree (list) {:message "c1"}))) ; fresh repo with the fixture committed, HEAD on main, index clean (define gwt-fresh! (fn () (let ((r (git/repo (persist/mem-backend)))) (let ((tc (git/tree-from-files r gwt-files))) (let ((c (git/write r (git/commit tc (list) {:message "c1"})))) (begin (git/branch-set! r "main" c) (git/head-set! r "main") (git/index-init! r c) r)))))) (define gwt-clean {:untracked (list) :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}}) ; ---- tree building + materialization ---- (git-test "tree-from-files writes a tree object" (git/tree? (git/read gwt gwt-tree)) true) (git-test "tree-files round-trips the files dict" (= (git/tree-files gwt gwt-tree) gwt-files) true) (git-test "tree-from-files is deterministic" (equal? (git/tree-from-files gwt gwt-files) gwt-tree) true) (git-test "matches a manually built tree" (equal? (git/write gwt (git/tree (assoc (assoc (assoc {} "a.txt" (git/tree-entry "blob" (git/write-blob gwt "hello\n"))) "b.txt" (git/tree-entry "blob" (git/write-blob gwt "world\n"))) "sub" (git/tree-entry "tree" (git/write gwt (git/tree (assoc {} "c.txt" (git/tree-entry "blob" (git/write-blob gwt "sub\n"))))))))) gwt-tree) true) (git-test "flatten lists nested paths" (= (artdag/sort-strings (keys (git/tree-flatten gwt gwt-tree))) (list "a.txt" "b.txt" "sub/c.txt")) true) (git-test "flatten maps a path to its blob cid" (get (git/tree-flatten gwt gwt-tree) "a.txt") (git/cid (git/blob "hello\n"))) (git-test "commit-files materializes through the commit" (= (git/commit-files gwt gwt-c1) gwt-files) true) (git-test "deep nesting round-trips" (let ((files (assoc {} "x/y/z.txt" "deep"))) (= (git/tree-files gwt (git/tree-from-files gwt files)) files)) true) (git-test "empty files dict is an empty tree" (= (git/tree-files gwt (git/tree-from-files gwt {})) {}) true) ; ---- index ---- (git-test "default index is empty over no base" (= (git/index-read (git/repo (persist/mem-backend))) {:base nil :staged {}}) true) (git-test "index-init! bases the index on the commit tree" (let ((r (gwt-fresh!))) (= (git/index-files r) gwt-files)) true) (git-test "add! stages new content" (let ((r (gwt-fresh!))) (begin (git/add! r "new.txt" "fresh") (get (git/index-files r) "new.txt"))) "fresh") (git-test "add! overlays an existing path" (let ((r (gwt-fresh!))) (begin (git/add! r "a.txt" "changed") (get (git/index-files r) "a.txt"))) "changed") (git-test "rm! stages a removal" (let ((r (gwt-fresh!))) (begin (git/rm! r "b.txt") (has-key? (git/index-files r) "b.txt"))) false) (git-test "unstage! reverts to the base" (let ((r (gwt-fresh!))) (begin (git/add! r "a.txt" "changed") (git/unstage! r "a.txt") (get (git/index-files r) "a.txt"))) "hello\n") (git-test "index-tree! of a clean index reproduces the commit tree cid" (let ((r (gwt-fresh!))) (equal? (git/index-tree! r) (git/commit-tree (git/read r (git/head r))))) true) (git-test "index-tree! materializes staged changes" (let ((r (gwt-fresh!))) (begin (git/add! r "a.txt" "changed") (git/rm! r "b.txt") (= (git/tree-files r (git/index-tree! r)) (assoc (assoc {} "a.txt" "changed") "sub/c.txt" "sub\n")))) true) ; ---- status ---- (git-test "clean repo, clean worktree" (= (git/status (gwt-fresh!) gwt-files) gwt-clean) true) (git-test "staged addition" (let ((r (gwt-fresh!))) (begin (git/add! r "new.txt" "fresh") (= (get (get (git/status r gwt-files) :staged) :added) (list "new.txt")))) true) (git-test "staged modification" (let ((r (gwt-fresh!))) (begin (git/add! r "a.txt" "changed") (= (get (get (git/status r (assoc gwt-files "a.txt" "changed")) :staged) :modified) (list "a.txt")))) true) (git-test "staged deletion" (let ((r (gwt-fresh!))) (begin (git/rm! r "b.txt") (= (get (get (git/status r (dissoc gwt-files "b.txt")) :staged) :deleted) (list "b.txt")))) true) (git-test "unstaged modification" (let ((r (gwt-fresh!))) (= (get (get (git/status r (assoc gwt-files "a.txt" "edited")) :unstaged) :modified) (list "a.txt"))) true) (git-test "unstaged deletion" (let ((r (gwt-fresh!))) (= (get (get (git/status r (dissoc gwt-files "sub/c.txt")) :unstaged) :deleted) (list "sub/c.txt"))) true) (git-test "untracked file" (let ((r (gwt-fresh!))) (= (get (git/status r (assoc gwt-files "notes.md" "hi")) :untracked) (list "notes.md"))) true) (git-test "combined status" (let ((r (gwt-fresh!))) (begin (git/add! r "staged.txt" "s") (git/add! r "a.txt" "changed") (git/rm! r "b.txt") (= (git/status r (assoc (assoc (assoc (dissoc (dissoc gwt-files "b.txt") "sub/c.txt") "a.txt" "changed-again") "staged.txt" "s") "wild.txt" "w")) {:untracked (list "wild.txt") :staged {:deleted (list "b.txt") :modified (list "a.txt") :added (list "staged.txt")} :unstaged {:deleted (list "sub/c.txt") :modified (list "a.txt")}}))) true) (git-test "no HEAD, no index: everything untracked" (let ((r (git/repo (persist/mem-backend)))) (= (git/status r (assoc {} "f.txt" "x")) {:untracked (list "f.txt") :staged {:deleted (list) :modified (list) :added (list)} :unstaged {:deleted (list) :modified (list)}})) true)