me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
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".
This commit is contained in:
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
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))))