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:
parent
8ddf20b286
commit
97abc90733
|
@ -522,24 +522,6 @@ releases are on gnu.org."
|
||||||
(not (gnome-package? package))
|
(not (gnome-package? package))
|
||||||
(gnu-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?
|
(define gnu-hosted?
|
||||||
(url-prefix-predicate "mirror://gnu/"))
|
(url-prefix-predicate "mirror://gnu/"))
|
||||||
|
|
||||||
|
|
|
@ -45,6 +45,7 @@
|
||||||
upstream-source-signature-urls
|
upstream-source-signature-urls
|
||||||
upstream-source-archive-types
|
upstream-source-archive-types
|
||||||
|
|
||||||
|
url-prefix-predicate
|
||||||
coalesce-sources
|
coalesce-sources
|
||||||
|
|
||||||
upstream-updater
|
upstream-updater
|
||||||
|
@ -81,6 +82,24 @@
|
||||||
(signature-urls upstream-source-signature-urls ;#f | list of strings
|
(signature-urls upstream-source-signature-urls ;#f | list of strings
|
||||||
(default #f)))
|
(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)
|
(define (upstream-source-archive-types release)
|
||||||
"Return the available types of archives for RELEASE---a list of strings such
|
"Return the available types of archives for RELEASE---a list of strings such
|
||||||
as \"gz\" or \"xz\"."
|
as \"gz\" or \"xz\"."
|
||||||
|
|
Loading…
Reference in New Issue