~ruther/guix-local

97abc90733270c4be5ce1f51e5e757d43787950b — Ludovic Courtès 8 years ago 8ddf20b
upstream: Add 'url-prefix-predicate'.

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

M guix/gnu-maintenance.scm
M guix/upstream.scm
M guix/gnu-maintenance.scm => guix/gnu-maintenance.scm +0 -18
@@ 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/"))


M guix/upstream.scm => guix/upstream.scm +19 -0
@@ 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\"."