Archived
1
0
Fork 0

import: github: Improve readability.

* guix/import/github.scm (latest-released-version)[release->version]: Separate
out release->version as a new function.
This commit is contained in:
Arun Isaac 2019-05-14 15:44:46 +05:30
parent 0f9bbd32c1
commit c558772b0f
No known key found for this signature in database
GPG key ID: 2E25EE8B61802BB3

View file

@ -174,6 +174,29 @@ the package e.g. 'bedtools2'. Return #f if there is no releases"
(define (pre-release? x) (define (pre-release? x)
(hash-ref x "prerelease")) (hash-ref x "prerelease"))
(define (release->version 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))))
(let* ((json (fetch-releases-or-tags url))) (let* ((json (fetch-releases-or-tags url)))
(if (eq? json #f) (if (eq? json #f)
(if (%github-token) (if (%github-token)
@ -183,32 +206,10 @@ API when using a GitHub token")
API. This may be fixed by using an access token and setting the environment API. This may be fixed by using an access token and setting the environment
variable GUIX_GITHUB_TOKEN, for instance one procured from variable GUIX_GITHUB_TOKEN, for instance one procured from
https://github.com/settings/tokens")) https://github.com/settings/tokens"))
(any (any release->version
(lambda (release) (match (remove pre-release? json)
(let ((tag (or (hash-ref release "tag_name") ;a "release" (() json) ; keep everything
(hash-ref release "name"))) ;a tag (releases releases))))))
(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) (define (latest-release pkg)
"Return an <upstream-source> for the latest release of PKG." "Return an <upstream-source> for the latest release of PKG."