summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-09-25 17:34:26 +0200
committerLudovic Courtès <ludo@gnu.org>2017-09-26 00:35:06 +0200
commit97abc90733270c4be5ce1f51e5e757d43787950b (patch)
treef2878291f71835a31350250e5c19797e5c377971
parent8ddf20b286226e0e777c95046d824b1e586277c9 (diff)
upstream: Add 'url-prefix-predicate'.
* guix/gnu-maintenance.scm (url-prefix-predicate): Move to... * guix/upstream.scm (url-prefix-predicate): ... here.
-rw-r--r--guix/gnu-maintenance.scm18
-rw-r--r--guix/upstream.scm19
2 files changed, 19 insertions, 18 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 796c2d6569..cd7ffeaefd 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 5083e6b805..6ad52ac960 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\"."