From d55a99fed30b2ee47725f07bf26208fb4b13a110 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 24 Apr 2013 23:37:14 +0200 Subject: gnu-maintenance: Optimize `release-file'. * guix/gnu-maintenance.scm (tarball-regexp): Remove. (%tarball-rx): New variable. (release-file): Adjust to use %TARBALL-RX. --- guix/gnu-maintenance.scm | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 49b10565db..30c45ec0c6 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -252,26 +252,25 @@ stored." (_ (values "ftp.gnu.org" (string-append "/gnu/" project))))) -(define tarball-regexp - (memoize - (lambda (project) - "Return a regexp matching tarball names for PROJECT." - (make-regexp (string-append "^" project - "-([0-9]|[^-])*(-src)?\\.tar\\."))))) - -(define %alpha-tarball-rx - (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\.")) - (define (sans-extension tarball) "Return TARBALL without its .tar.* extension." (let ((end (string-contains tarball ".tar"))) (substring tarball 0 end))) +(define %tarball-rx + (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.tar\\.")) + +(define %alpha-tarball-rx + (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\.")) + (define (release-file project file) "Return #f if FILE is not a release tarball of PROJECT, otherwise return PACKAGE-VERSION." (and (not (string-suffix? ".sig" file)) - (regexp-exec (tarball-regexp project) file) + (and=> (regexp-exec %tarball-rx file) + (lambda (match) + ;; Filter out unrelated files, like `guile-www-1.1.1'. + (equal? project (match:substring match 1)))) (not (regexp-exec %alpha-tarball-rx file)) (let ((s (sans-extension file))) (and (regexp-exec %package-name-rx s) s)))) -- cgit v1.2.3