upstream: Add 'url-prefix-predicate'.

* guix/gnu-maintenance.scm (url-prefix-predicate): Move to...
* guix/upstream.scm (url-prefix-predicate): ... here.
This commit is contained in:
Ludovic Courtès 2017-09-25 17:34:26 +02:00
parent 8ddf20b286
commit 97abc90733
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 19 additions and 18 deletions

View File

@ -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/"))

View File

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