summaryrefslogtreecommitdiff
path: root/guix/import/github.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/import/github.scm')
-rw-r--r--guix/import/github.scm67
1 files changed, 32 insertions, 35 deletions
diff --git a/guix/import/github.scm b/guix/import/github.scm
index b287313d98..4d12339204 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -98,7 +98,9 @@ false if none is recognized"
(updated-url source-uri))
((source-uri ...)
(find updated-url source-uri))))
- ((eq? fetch-method download:git-fetch)
+ ((and (eq? fetch-method download:git-fetch)
+ (string-prefix? "https://github.com/"
+ (download:git-reference-url source-uri)))
(download:git-reference-url source-uri))
(else #f))))
@@ -169,6 +171,9 @@ empty list."
"Return a string of the newest released version name given a string URL like
'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
the package e.g. 'bedtools2'. Return #f if there is no releases"
+ (define (pre-release? x)
+ (hash-ref x "prerelease"))
+
(let* ((json (fetch-releases-or-tags url)))
(if (eq? json #f)
(if (%github-token)
@@ -178,40 +183,32 @@ API when using a GitHub token")
API. This may be fixed by using an access token and setting the environment
variable GUIX_GITHUB_TOKEN, for instance one procured from
https://github.com/settings/tokens"))
- (let loop ((releases
- (filter
- (lambda (x)
- ;; example pre-release:
- ;; https://github.com/wwood/OrfM/releases/tag/v0.5.1
- ;; or an all-prerelease set
- ;; https://github.com/powertab/powertabeditor/releases
- (not (hash-ref x "prerelease")))
- json)))
- (match releases
- (() ;empty release list
- #f)
- ((release . rest) ;one or more releases
- (let ((tag (or (hash-ref release "tag_name") ;a "release"
- (hash-ref release "name"))) ;a tag
- (name-length (string-length package-name)))
- ;; some tags include the name of the package e.g. "fdupes-1.51"
- ;; so remove these
- (if (and (< name-length (string-length tag))
- (string=? (string-append package-name "-")
- (substring tag 0 (+ name-length 1))))
- (substring tag (+ name-length 1))
- ;; some tags start with a "v" e.g. "v0.25.0"
- ;; where some are just the version number
- (if (string-prefix? "v" tag)
- (substring tag 1)
-
- ;; Finally, reject tags that don't start with a digit:
- ;; they may not represent a release.
- (if (and (not (string-null? tag))
- (char-set-contains? char-set:digit
- (string-ref tag 0)))
- tag
- (loop rest)))))))))))
+ (any
+ (lambda (release)
+ (let ((tag (or (hash-ref release "tag_name") ;a "release"
+ (hash-ref release "name"))) ;a tag
+ (name-length (string-length package-name)))
+ (cond
+ ;; some tags include the name of the package e.g. "fdupes-1.51"
+ ;; so remove these
+ ((and (< name-length (string-length tag))
+ (string=? (string-append package-name "-")
+ (substring tag 0 (+ name-length 1))))
+ (substring tag (+ name-length 1)))
+ ;; some tags start with a "v" e.g. "v0.25.0"
+ ;; where some are just the version number
+ ((string-prefix? "v" tag)
+ (substring tag 1))
+ ;; Finally, reject tags that don't start with a digit:
+ ;; they may not represent a release.
+ ((and (not (string-null? tag))
+ (char-set-contains? char-set:digit
+ (string-ref tag 0)))
+ tag)
+ (else #f))))
+ (match (remove pre-release? json)
+ (() json) ; keep everything
+ (releases releases))))))
(define (latest-release pkg)
"Return an <upstream-source> for the latest release of PKG."