diff options
author | Marius Bakke <mbakke@fastmail.com> | 2018-09-15 11:53:40 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2018-09-26 00:33:00 +0200 |
commit | 280fc8351230a8fea086d9bbce919ba8395f312c (patch) | |
tree | ad9e2e059cc3990ed0595da1b12dee0374be6067 | |
parent | 88268a34bc76c88c5c5e4ecc244924f3c8503d16 (diff) | |
download | guix-280fc8351230a8fea086d9bbce919ba8395f312c.tar guix-280fc8351230a8fea086d9bbce919ba8395f312c.tar.gz |
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".
-rw-r--r-- | guix/git-download.scm | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/guix/git-download.scm b/guix/git-download.scm index 24cf11be5e..fa94fad8f8 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -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 also includes directories, not just regular files. The returned file names 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)) - (top (dirname 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)) (oid (reference-target head)) (commit (commit-lookup repository oid)) (tree (commit-tree commit)) (files (tree-list tree))) (repository-close! repository) - (if (string=? top directory) + (if (string=? workdir directory) files - (let ((relative (string-append - (string-drop directory - (+ 1 (string-length top))) - "/"))) + (let ((relative (string-drop directory (string-length workdir)))) (filter-map (lambda (file) (and (string-prefix? relative file) (string-drop file (string-length relative)))) |