gnu-maintenance: Optimize `release-file'.
* guix/gnu-maintenance.scm (tarball-regexp): Remove. (%tarball-rx): New variable. (release-file): Adjust to use %TARBALL-RX.
This commit is contained in:
parent
cac137aa84
commit
d55a99fed3
|
@ -252,26 +252,25 @@ stored."
|
||||||
(_
|
(_
|
||||||
(values "ftp.gnu.org" (string-append "/gnu/" project)))))
|
(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)
|
(define (sans-extension tarball)
|
||||||
"Return TARBALL without its .tar.* extension."
|
"Return TARBALL without its .tar.* extension."
|
||||||
(let ((end (string-contains tarball ".tar")))
|
(let ((end (string-contains tarball ".tar")))
|
||||||
(substring tarball 0 end)))
|
(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)
|
(define (release-file project file)
|
||||||
"Return #f if FILE is not a release tarball of PROJECT, otherwise return
|
"Return #f if FILE is not a release tarball of PROJECT, otherwise return
|
||||||
PACKAGE-VERSION."
|
PACKAGE-VERSION."
|
||||||
(and (not (string-suffix? ".sig" file))
|
(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))
|
(not (regexp-exec %alpha-tarball-rx file))
|
||||||
(let ((s (sans-extension file)))
|
(let ((s (sans-extension file)))
|
||||||
(and (regexp-exec %package-name-rx s) s))))
|
(and (regexp-exec %package-name-rx s) s))))
|
||||||
|
|
Loading…
Reference in New Issue