import: github: Get /tags when /releases returns the empty list.

This allows "guix refresh" to work for many packages where it would
previously fail with "no updater for PACKAGE".

* guix/import/github.scm (fetch-releases-or-tags): New procedure.
(latest-released-version): Use it instead of calling 'json-fetch'.
Adjust 'hash-ref' call.
This commit is contained in:
Ludovic Courtès 2018-08-20 15:29:43 +02:00
parent 2766282f5a
commit 45c01189cc
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 43 additions and 16 deletions

View File

@ -120,26 +120,52 @@ repository separated by a forward slash, from a string URL of the form
;; limit, or #f. ;; limit, or #f.
(make-parameter (getenv "GUIX_GITHUB_TOKEN"))) (make-parameter (getenv "GUIX_GITHUB_TOKEN")))
(define (fetch-releases-or-tags url)
"Fetch the list of \"releases\" or, if it's empty, the list of tags for the
repository at URL. Return the corresponding JSON dictionaries (hash tables),
or #f if the information could not be retrieved.
We look at both /releases and /tags because the \"release\" feature of GitHub
is little used; often, people simply provide a tag. What's confusing is that
tags show up in the \"Releases\" tab of the web UI. For instance,
'https://github.com/aconchillo/guile-json/releases' shows a number of
\"releases\" (really: tags), whereas
'https://api.github.com/repos/aconchillo/guile-json/releases' returns the
empty list."
(define release-url
(string-append "https://api.github.com/repos/"
(github-user-slash-repository url)
"/releases"))
(define tag-url
(string-append "https://api.github.com/repos/"
(github-user-slash-repository url)
"/tags"))
(define headers
;; Ask for version 3 of the API as suggested at
;; <https://developer.github.com/v3/>.
`((Accept . "application/vnd.github.v3+json")
(user-agent . "GNU Guile")))
(define (decorate url)
(if (%github-token)
(string-append url "?access_token=" (%github-token))
url))
(match (json-fetch (decorate release-url) #:headers headers)
(()
;; We got the empty list, presumably because the user didn't use GitHub's
;; "release" mechanism, but hopefully they did use Git tags.
(json-fetch (decorate tag-url) #:headers headers))
(x x)))
(define (latest-released-version url package-name) (define (latest-released-version url package-name)
"Return a string of the newest released version name given a string URL like "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 '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" the package e.g. 'bedtools2'. Return #f if there is no releases"
(let* ((token (%github-token)) (let* ((json (fetch-releases-or-tags url)))
(api-url (string-append
"https://api.github.com/repos/"
(github-user-slash-repository url)
"/releases"))
(json (json-fetch
(if token
(string-append api-url "?access_token=" token)
api-url)
#:headers
;; Ask for version 3 of the API as suggested at
;; <https://developer.github.com/v3/>.
`((Accept . "application/vnd.github.v3+json")
(user-agent . "GNU Guile")))))
(if (eq? json #f) (if (eq? json #f)
(if token (if (%github-token)
(error "Error downloading release information through the GitHub (error "Error downloading release information through the GitHub
API when using a GitHub token") API when using a GitHub token")
(error "Error downloading release information through the GitHub (error "Error downloading release information through the GitHub
@ -159,7 +185,8 @@ https://github.com/settings/tokens"))
(() ;empty release list (() ;empty release list
#f) #f)
((release . rest) ;one or more releases ((release . rest) ;one or more releases
(let ((tag (hash-ref release "tag_name")) (let ((tag (or (hash-ref release "tag_name") ;a "release"
(hash-ref release "name"))) ;a tag
(name-length (string-length package-name))) (name-length (string-length package-name)))
;; some tags include the name of the package e.g. "fdupes-1.51" ;; some tags include the name of the package e.g. "fdupes-1.51"
;; so remove these ;; so remove these