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'.

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\"."