rose-ash/lib/git/tests/worktree.sx

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