02/05: upstream: Add 'url-prefix-predicate'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 97abc90733270c4be5ce1f51e5e757d43787950b
Author: Ludovic Courtès <address@hidden>
Date:   Mon Sep 25 17:34:26 2017 +0200

    upstream: Add 'url-prefix-predicate'.
    
    * guix/gnu-maintenance.scm (url-prefix-predicate): Move to...
    * guix/upstream.scm (url-prefix-predicate): ... here.
---
 guix/gnu-maintenance.scm | 18 ------------------
 guix/upstream.scm        | 19 +++++++++++++++++++
 2 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 796c2d6..cd7ffea 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -522,24 +522,6 @@ releases are on gnu.org."
        (not (gnome-package? package))
        (gnu-package? package)))
 
-(define (url-prefix-predicate prefix)
-  "Return a predicate that returns true when passed a package where one of its
-source URLs starts with PREFIX."
-  (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)))
-      (_ #f))))
-
 (define gnu-hosted?
   (url-prefix-predicate "mirror://gnu/"))
 
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 5083e6b..6ad52ac 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -45,6 +45,7 @@
             upstream-source-signature-urls
             upstream-source-archive-types
 
+            url-prefix-predicate
             coalesce-sources
 
             upstream-updater
@@ -81,6 +82,24 @@
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
                   (default #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."
+  (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)))
+      (_ #f))))
+
 (define (upstream-source-archive-types release)
   "Return the available types of archives for RELEASE---a list of strings such
 as \"gz\" or \"xz\"."