amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

refresh: Add support for partial target versions.

Browse source 
* guix/import/utils.scm (find-version): New procedure.
* guix/scripts/refresh.scm (<update-spec>) [partial?]: New field.
(update-spec-partial?): New accessor.
(update-spec): Add a PARTIAL? optional argument.
(update-specification->update-spec) <update-spec>: Call with its new PARTIAL?
optional argument when FALLBACK-VERSION is provided, i.e. when
'--target-version' was used.
(update-package): Remove the PACKAGE and VERSION positional arguments, and
replace them with UPDATE-SPEC.  Update doc.  Call `package-update' with its
new #:partial-version? argument.
(check-for-package-update) <package-latest-release>: Pass the new
 #:partial-version? argument to it.
(guix-refresh) <update-package>: Adjust call accordingly.
(show-help): Udate doc.
* guix/upstream.scm (package-latest-release): Add #:partial-version? argument,
and apply it to the importer call.
(package-update): Add #:partial-version?> argument.  Update doc.  Pass it to
the `package-latest-release' call.
* guix/gnu-maintenance.scm (rewrite-url): Add #:partial-version? argument.
Update doc.  Crawl URL for newer compatible versions when provided.
(import-html-release): Add #:partial-version? argument, and pass it to the
`rewrite-url' call.  Use `find-version' to find the best version.
(import-release, import-ftp-release, import-gnu-release)
(import-release*): Add #:partial-version? argument and honor it.
(import-html-updatable-release): Add #:partial-version? argument, and pass it
to the `import-html-release' call.
* guix/import/gnome.scm (import-gnome-release)
<#:partial-version?>: Add new argument and honor it.
* guix/import/texlive.scm (latest-texlive-tag): Rename to...
(texlive-tags): ... this, and have it return all tags.
(texlive->guix-package): Adjust accordingly.
(latest-release): Add a #:partial-version? argument.  Update doc.
* guix/import/stackage.scm (latest-lts-release): New #:partial-version?
argument.
* guix/import/pypi.scm (import-release): New #:partial-version? argument; pass
it to `pypi-package->upstream-source'.
* guix/import/opam.scm (latest-release): New #:partial-version? argument.
* guix/import/minetest.scm (latest-minetest-release): New #:partial-version?
argument.
(pypi-package->upstream-source): New #:partial-version? argument.  Update doc.
* guix/import/launchpad.scm (latest-released-version): Rename to...
(release-versions): ... this, making it return all versions.
(import-release) <#:partial-version?>: New argument.
* guix/import/kde.scm (import-kde-release)
<#:partial-version?>: New argument.  Update doc.  Refactor to honor argument.
* guix/import/hexpm.scm (lookup-hexpm): Update doc.
(hexpm-latest-release): Rename to...
(hexpm-releases): ... this; return all release strings.
(hexpm->guix-package): Adjust accordingly.
(import-release): Add and honor a #:partial-version? argument.  Update doc.
* guix/import/hackage.scm (import-release): New #:partial-version? argument.
* guix/import/cpan.scm (latest-release): New #:partial-version? argument.
* guix/import/crate.scm (max-crate-version-of-semver): Improve doc.
(import-release): Add a #:partial-version? argument and honor it.
* guix/import/egg.scm (find-latest-version): Rename to...
(get-versions): ... this, returning all versions.
(egg-metadata): Adjust accordingly.
(egg->guix-package): Likewise.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/elpa.scm (latest-release):  New #:partial-version? argument.
* guix/import/gem.scm (get-versions): New procedure.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/git.scm (version-mapping): Update doc; streamline a bit.
(latest-tag): Rename to...
(get-tags): ... this, dropping the #:version keyword and returning the complete
tags alist.  Update doc.
(latest-git-tag-version): Rename to...
(get-package-tags): ... this, returning the complete tags alist of the
package.  Update doc.
(import-git-release): Add a new #:partial-version? argument and honor it.
Update doc.
* guix/import/github.scm (latest-released-version): Rename to...
(get-package-tags): ... this, returning all tags.  Update doc.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/cran.scm (latest-cran-release)
(latest-bioconductor-release): Add #:partial-version? argument.
* guix/import/composer.scm (latest-version): Delete procedure.
(composer-fetch): Add #:partial-version? keyword and honor it.  Update doc.
(import-release): Likewise.
* guix/import/test.scm (import-release): Add #:partial-version? argument.
* tests/guix-refresh.sh: Add test.
* tests/gem.scm (test-foo-versions-json): New variable.
(package-latest-release): Mock new URL.
* tests/import-git.scm (latest-git-tag-version): New procedure.
* tests/gnu-maintenance.scm (libuv-dist-html)
(libuv-dist-1.46.0-html, libuv-dist-1.44.2-html)
(libuv-html-data): New variables.
(mock-http-fetch/cached): New procedure.
("rewrite-url, without to-version"): Rewrite using the above.
("rewrite-url, partial to-version"): New test.
* doc/guix.texi <"Invoking guix refresh">: Update doc.

Series-to: 75871@debbugs.gnu.org
Change-Id: I092a58b57ac42e54a2fa55e7761e8c6993af8ad4
This commit is contained in:
Maxim Cournoyer 2024-11-13 14:21:16 +09:00
parent 79a46d6537
commit f13f076968
No known key found for this signature in database
GPG key ID: 1260E46482E63562
29 changed files with 627 additions and 500 deletions
Download patch file Download diff file Expand all files Collapse all files

114
guix/import/github.scm
View file

@ -7,6 +7,7 @@
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -30,7 +31,8 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-71)
#:use-module (guix utils)
#:use-module ((guix import utils) #:select (find-version))
#:use-module ((guix utils) #:select (string-replace-substring))
#:use-module (guix i18n)
#:use-module (guix diagnostics)
#:use-module ((guix ui) #:select (display-hint))
@ -246,40 +248,49 @@ Alternatively, you can wait until your rate limit is reset, or use the
#:headers headers))))
(match result
(#()
;; We got the empty list, presumably because the user didn't use GitHub's
;; "release" mechanism, but hopefully they did use Git tags.
;; We got the empty list, presumably because the user
;; didn't use GitHub's "release" mechanism, but hopefully
;; they did use Git tags.
(json->scm (http-fetch tag-url
#:port connection
#:keep-alive? #t
#:headers headers)))
(x x)))))))))
(define* (latest-released-version url package-name #:key (version #f))
"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
the package e.g. 'bedtools2'. Return #f (two values) if there are no
releases.
(define* (get-package-tags package)
"Return an alist of tags keyed by their version for PACKAGE, a <package>
object."
(define (github-uri uri)
(match uri
((? string? url)
url) ;surely a github.com URL
((? download:git-reference? ref)
(download:git-reference-url ref))
((urls ...)
(find (cut string-contains <> "github.com") urls))))
Optionally include a VERSION string to fetch a specific version."
(define (pre-release? x)
(assoc-ref x "prerelease"))
(define source-uri
(github-uri (origin-uri (package-source package))))
;; This procedure returns (version . tag) pair, or #f
;; if RELEASE doesn't seyem to correspond to a version.
(define (release->version release)
(let ((tag (or (assoc-ref release "tag_name") ;a "release"
(assoc-ref release "name"))) ;a tag
(name-length (string-length package-name)))
(let* ((tag (or (assoc-ref release "tag_name") ;a "release"
(assoc-ref release "name"))) ;a tag
(name (package-upstream-name package))
(name-length (string-length name)))
(cond
;; some tags include the name of the package e.g. "fdupes-1.51"
;; so remove these
;; Some tags include the name of the package e.g. "fdupes-1.51"; remove
;; these.
((and (< name-length (string-length tag))
(string=? (string-append package-name "-")
(string=? (string-append name "-")
(substring tag 0 (+ name-length 1))))
(cons (substring tag (+ name-length 1)) tag))
;; some tags start with a "v" e.g. "v0.25.0"
;; or with the word "version" e.g. "version.2.1"
;; where some are just the version number
;; Some tags start with a "v" e.g. "v0.25.0" or with the word "version"
;; e.g. "version.2.1" where some are just the version number.
((string-prefix? "version" tag)
(cons (if (char-set-contains? char-set:digit (string-ref tag 7))
(substring tag 7)
@ -294,53 +305,32 @@ Optionally include a VERSION string to fetch a specific version."
(cons tag tag))
(else #f))))
(match (and=> (fetch-releases-or-tags url) vector->list)
(#f (values #f #f))
(match (and=> (fetch-releases-or-tags source-uri) vector->list)
(#f '())
(json
(let ((releases (filter-map release->version
(match (remove pre-release? json)
(() json) ; keep everything
(releases releases)))))
(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))
(() (values #f #f)))))))
(filter-map release->version
(match (remove pre-release? json)
(() json) ;keep everything
(releases releases))))))
(define* (import-release pkg #:key (version #f))
(define* (import-release pkg #:key version partial-version?)
"Return an <upstream-source> for the latest release of PKG.
Optionally include a VERSION string to fetch a specific version."
(define (github-uri uri)
(match uri
((? string? url)
url) ;surely a github.com URL
((? download:git-reference? ref)
(download:git-reference-url ref))
((urls ...)
(find (cut string-contains <> "github.com") urls))))
Optionally include a VERSION string to fetch a specific version, which may be
a partial version prefix if PARTIAL-VERSION? is #t."
(let* ((original-uri (origin-uri (package-source pkg)))
(source-uri (github-uri original-uri))
(name (package-upstream-name pkg))
(newest-version version-tag
(latest-released-version source-uri name
#:version version)))
(if newest-version
(upstream-source
(package name)
(version newest-version)
(urls (if (download:git-reference? original-uri)
(download:git-reference
(inherit original-uri)
(commit version-tag))
(list (updated-github-url pkg newest-version)))))
#f))) ; On GitHub but no proper releases
(tags (get-package-tags pkg))
(versions (map car tags))
(version (find-version versions version partial-version?))
(tag (assoc-ref tags version)))
(and version
(upstream-source
(package (package-upstream-name pkg))
(version version)
(urls (if (download:git-reference? original-uri)
(download:git-reference
(inherit original-uri)
(commit tag))
(list (updated-github-url pkg version))))))))
(define %github-updater
(upstream-updater
@ -348,5 +338,3 @@ Optionally include a VERSION string to fetch a specific version."
(description "Updater for GitHub packages")
(pred github-package?)
(import import-release)))