guix/guix
3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

import: github: Allow updating to a specific version.

Browse source 
* guix/import/github.scm (latest-released-version): Add #:version argument.
  If version is given, try to find the respective release.
  (latest-releease) Rename to 'import-release', add #:version argument
  and pass it on to 'latest-released-version'.
This commit is contained in:
Hartmut Goebel 2022-06-29 14:13:55 +02:00
parent 6da60453e2
commit be3f48bff0
No known key found for this signature in database
GPG key ID: 634A8DFFD3F631DF
1 changed files with 24 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
guix/import/github.scm
View file

@ -249,11 +249,13 @@ Alternatively, you can wait until your rate limit is reset, or use the
#:headers headers))) #:headers headers)))
(x x))))))))) (x x)))))))))
(define (latest-released-version url package-name) (define* (latest-released-version url package-name #:key (version #f))
"Return the newest released version and its tag given a string URL like "Return the newest released version and its tag 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 (two values) if there are no the package e.g. 'bedtools2'. Return #f (two values) if there are no
releases." releases.
Optionally include a VERSION string to fetch a specific version."
(define (pre-release? x) (define (pre-release? x)
(assoc-ref x "prerelease")) (assoc-ref x "prerelease"))
@ -290,16 +292,25 @@ releases."
(match (and=> (fetch-releases-or-tags url) vector->list) (match (and=> (fetch-releases-or-tags url) vector->list)
(#f (values #f #f)) (#f (values #f #f))
(json (json
(match (sort (filter-map release->version (let ((releases (filter-map release->version
(match (remove pre-release? json) (match (remove pre-release? json)
(() json) ; keep everything (() json) ; keep everything
(releases releases))) (releases releases)))))
(lambda (x y) (version>? (car x) (car y)))) (match (if version
;; Find matching release version.
(filter (match-lambda
((candidate-version . tag)
(string=? version candidate-version)))
releases)
;; Sort releases descending.
(sort releases
(lambda (x y) (version>? (car x) (car y)))))
(((latest-version . tag) . _) (values latest-version tag)) (((latest-version . tag) . _) (values latest-version tag))
(() (values #f #f)))))) (() (values #f #f)))))))
(define (latest-release pkg) (define* (import-release pkg #:key (version #f))
"Return an <upstream-source> for the latest release of PKG." "Return an <upstream-source> for the latest release of PKG.
Optionally include a VERSION string to fetch a specific version."
(define (github-uri uri) (define (github-uri uri)
(match uri (match uri
((? string? url) ((? string? url)
@ -313,7 +324,8 @@ releases."
(source-uri (github-uri original-uri)) (source-uri (github-uri original-uri))
(name (package-name pkg)) (name (package-name pkg))
(newest-version version-tag (newest-version version-tag
(latest-released-version source-uri name))) (latest-released-version source-uri name
#:version version)))
(if newest-version (if newest-version
(upstream-source (upstream-source
(package name) (package name)
@ -330,6 +342,6 @@ releases."
(name 'github) (name 'github)
(description "Updater for GitHub packages") (description "Updater for GitHub packages")
(pred github-package?) (pred github-package?)
(import latest-release))) (import import-release)))