nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

git-download: Don't assume the working directory is the parent of ".git". 

This makes it do the right thing w.r.t. git worktrees.

* guix/git-download.scm (git-file-list): Use REPOSITORY-WORKING-DIRECTORY to
locate checkout.  Rename from "top" to "workdir".
master
Marius Bakke 2018-09-15 11:53:40 +02:00
parent 88268a34bc
commit 280fc83512
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
guix/git-download.scm
View File

@ -156,22 +156,23 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
The result is similar to that of the 'git ls-files' command, except that it The result is similar to that of the 'git ls-files' command, except that it
also includes directories, not just regular files. The returned file names also includes directories, not just regular files. The returned file names
are relative to DIRECTORY, which is not necessarily the root of the checkout." are relative to DIRECTORY, which is not necessarily the root of the checkout."
(let* ((directory (canonicalize-path directory)) (let* (;; 'repository-working-directory' always returns a trailing "/",
;; so add one here to ease the comparisons below.
(directory (string-append (canonicalize-path directory) "/"))
(dot-git (repository-discover directory)) (dot-git (repository-discover directory))
(top (dirname dot-git))
(repository (repository-open dot-git)) (repository (repository-open dot-git))
;; XXX: This procedure is mistakenly private in Guile-Git 0.1.0.
(workdir ((@@ (git repository) repository-working-directory)
repository))
(head (repository-head repository)) (head (repository-head repository))
(oid (reference-target head)) (oid (reference-target head))
(commit (commit-lookup repository oid)) (commit (commit-lookup repository oid))
(tree (commit-tree commit)) (tree (commit-tree commit))
(files (tree-list tree))) (files (tree-list tree)))
(repository-close! repository) (repository-close! repository)
(if (string=? top directory) (if (string=? workdir directory)
files files
(let ((relative (string-append (let ((relative (string-drop directory (string-length workdir))))
(string-drop directory
(+ 1 (string-length top)))
"/")))
(filter-map (lambda (file) (filter-map (lambda (file)
(and (string-prefix? relative file) (and (string-prefix? relative file)
(string-drop file (string-length relative)))) (string-drop file (string-length relative))))