summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHolger Peters <holger.peters@posteo.de>2020-11-01 10:50:24 +0100
committerChristopher Baines <mail@cbaines.net>2020-11-14 10:27:00 +0000
commit521d33cdc6965ac5ce786cedc26e247eb8b6f4ee (patch)
tree1dca5ef9a997f525c3ac98729974fc9e4c1fed74
parent2980b726d3ec209c0cd00160588e2ea948c034ad (diff)
guix: hg-download: Add hg-predicate.
`hg-predicate' acts for mercurial repositories as `git-predicate' acts for git-repositories. * guix/hg-download.scm (hg-predicate): New procedure. Signed-off-by: Christopher Baines <mail@cbaines.net>
-rw-r--r--guix/hg-download.scm38
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