diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-07-03 22:45:21 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-07-03 23:53:31 +0200 |
commit | 00290e7365aed9b34603bfb3cd6e8a4bdc1e7259 (patch) | |
tree | 8ae5c67671bb571101eaf25c145dbe31230efed8 /guix/upstream.scm | |
parent | 37c3e0bbaf2efe137b434f866ca431803d33e0a9 (diff) | |
download | guix-patches-00290e7365aed9b34603bfb3cd6e8a4bdc1e7259.tar guix-patches-00290e7365aed9b34603bfb3cd6e8a4bdc1e7259.tar.gz |
upstream: Define 'url-predicate' and use it.
* guix/upstream.scm (url-predicate): New procedure.
(url-prefix-predicate): Define in terms of 'url-predicate'.
* guix/import/cpan.scm (cpan-package?): Use 'url-predicate'.
* guix/import/cran.scm (cran-package?)
(bioconductor-package?)
(bioconductor-data-package?)
(bioconductor-experiment-package?): Likewise.
* guix/import/crate.scm (crate-package?): Likewise.
* guix/import/elpa.scm (package-from-gnu.org?): Likewise.
* guix/import/hackage.scm (hackage-package?): Likewise.
* guix/import/pypi.scm (pypi-package?): Likewise.
* guix/import/gem.scm (gem-package?): Use 'url-prefix-predicate'.
Diffstat (limited to 'guix/upstream.scm')
-rw-r--r-- | guix/upstream.scm | 31 |
1 files changed, 18 insertions, 13 deletions
diff --git a/guix/upstream.scm b/guix/upstream.scm index 67d0eeefbb..ff33c534fe 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -51,6 +51,7 @@ upstream-source-archive-types upstream-source-input-changes + url-predicate url-prefix-predicate coalesce-sources @@ -161,24 +162,28 @@ S-expression PACKAGE-SEXP." current-propagated new-propagated)))))) (_ '()))) -(define (url-prefix-predicate prefix) - "Return a predicate that returns true when passed a package where one of its -source URLs starts with PREFIX." +(define* (url-predicate matching-url?) + "Return a predicate that returns true when passed a package whose source is +an <origin> with the URL-FETCH method, and one of its URLs passes +MATCHING-URL?." (lambda (package) - (define matching-uri? - (match-lambda - ((? string? uri) - (string-prefix? prefix uri)) - (_ - #f))) - (match (package-source package) ((? origin? origin) - (match (origin-uri origin) - ((? matching-uri?) #t) - (_ #f))) + (and (eq? (origin-method origin) url-fetch) + (match (origin-uri origin) + ((? string? url) + (matching-url? url)) + (((? string? urls) ...) + (any matching-url? urls)) + (_ + #f)))) (_ #f)))) +(define (url-prefix-predicate prefix) + "Return a predicate that returns true when passed a package where one of its +source URLs starts with PREFIX." + (url-predicate (cut string-prefix? prefix <>))) + (define (upstream-source-archive-types release) "Return the available types of archives for RELEASE---a list of strings such as \"gz\" or \"xz\"." |