mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 23:06:59 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: github: Improve readability.

Browse source 
* 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
1 changed files with 27 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
guix/import/github.scm
View file

@ -174,6 +174,29 @@ (define (latest-released-version url package-name)
(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 @@ (define (pre-release? x)
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."