diff options
author | Christopher Baines <mail@cbaines.net> | 2020-11-29 14:19:55 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2020-11-29 17:34:18 +0000 |
commit | ff01206345e2306cc633db48e0b29eab9077091a (patch) | |
tree | 25c7ee17005dadc9bf4fae3f0873e03a4704f782 /guix/hg-download.scm | |
parent | ed2545f0fa0e2ad99d5a0c45f532c539b299b9fb (diff) | |
parent | 7c2e67400ffaef8eb6f30ef7126c976ee3d7e36c (diff) | |
download | guix-patches-ff01206345e2306cc633db48e0b29eab9077091a.tar guix-patches-ff01206345e2306cc633db48e0b29eab9077091a.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'guix/hg-download.scm')
-rw-r--r-- | guix/hg-download.scm | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 694105ceba..bd55946523 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -26,12 +26,14 @@ #:use-module (guix packages) #:autoload (guix build-system gnu) (standard-packages) #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) #:export (hg-reference hg-reference? hg-reference-url hg-reference-changeset hg-reference-recursive? - + hg-predicate hg-fetch)) ;;; Commentary: @@ -93,4 +95,38 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." #:recursive? #t #:guile-for-build guile))) +(define (hg-file-list directory) + "Evaluates to a list of files contained in the repository at path + @var{directory}" + (let* ((port (open-input-pipe (format #f "hg files --repository ~s" directory))) + (files (let loop ((files '())) + (let ((line (read-line port))) + (cond + ((eof-object? line) files) + (else + (loop (cons line files)))))))) + (close-pipe port) + (map canonicalize-path files))) + +(define (should-select? path-list candidate) + "Returns #t in case that @var{candidate} is a file that is part of the given +@var{path-list}." + (let ((canon-candidate (canonicalize-path candidate))) + (let loop ((xs path-list)) + (cond + ((null? xs) + ;; Directories are not part of `hg files', but `local-file' will not + ;; recurse if we don't return #t for directories. + (equal? (array-ref (lstat candidate) 13) 'directory)) + ((string-contains candidate (car xs)) #t) + (else (loop (cdr xs))))))) + +(define (hg-predicate directory) + "This procedure evaluates to a predicate that reports back whether a given +@var{file} - @var{stat} combination is part of the files tracked by +Mercurial." + (let ((files (hg-file-list directory))) + (lambda (file stat) + (should-select? files file)))) + ;;; hg-download.scm ends here |