guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

guix: hg-download: Add hg-predicate.

Browse source 
`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>
This commit is contained in:
Holger Peters 2020-11-01 10:50:24 +01:00 committed by Christopher Baines
parent 2980b726d3
commit 521d33cdc6
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
1 changed files with 37 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
guix/hg-download.scm
View file

@ -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