rose-ash/lib/git/worktree.sx

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