From 97abc90733270c4be5ce1f51e5e757d43787950b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 25 Sep 2017 17:34:26 +0200 Subject: [PATCH] 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 796c2d65699abe088a5663d64573a1f0ab855e57..cd7ffeaefd0485655b2968fd67fd1e5dbdc01ced 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 5083e6b80548f0015409665a24b9dd95d3f6c4a8..6ad52ac960349ee5e3d35c0695364d339c09fd00 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\"."