import: git: Allow updating to a specific version.

* guix/import/git.scm
  (latest-tag): Add #:version argument. If version is given, try to
  find the respective version tag.
  (latest-git-tag-version): Add #:version argument and pass it on to
  called functions.
  (latest-releease) Rename to 'import-release', add #:version argument
  and pass it on to called functions.
This commit is contained in:
Hartmut Goebel 2022-06-30 11:05:13 +02:00
parent 1e39f475a2
commit 6da60453e2
No known key found for this signature in database
GPG key ID: 634A8DFFD3F631DF

View file

@ -2,6 +2,7 @@
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -146,9 +147,11 @@ (define (entry<? a b)
tags) tags)
entry<?)) entry<?))
(define* (latest-tag url #:key prefix suffix delim pre-releases?) (define* (latest-tag url
#:key prefix suffix delim pre-releases? (version #f))
"Return the latest version and corresponding tag available from the Git "Return the latest version and corresponding tag available from the Git
repository at URL." repository at URL. Optionally include a VERSION string to fetch a specific
version."
(define (pre-release? tag) (define (pre-release? tag)
(any (cut regexp-exec <> tag) (any (cut regexp-exec <> tag)
%pre-release-rx)) %pre-release-rx))
@ -169,13 +172,22 @@ (define (pre-release? tag)
((null? versions->tags) ((null? versions->tags)
(git-no-valid-tags-error)) (git-no-valid-tags-error))
(else (else
(match (last versions->tags) (let ((versions (if version
(filter (match-lambda
((candidate-version . tag)
(string=? version candidate-version)))
versions->tags)
versions->tags)))
(if (null? versions)
(values #f #f)
(match (last versions)
((version . tag) ((version . tag)
(values version tag))))))) (values version tag)))))))))
(define (latest-git-tag-version package) (define* (latest-git-tag-version package #:key (version #f))
"Given a PACKAGE, return the latest version of it and the corresponding git "Given a PACKAGE, return the latest version of it and the corresponding git
tag, or #false and #false if the latest version could not be determined." tag, or #false and #false if the latest version could not be determined.
Optionally include a VERSION string to fetch a specific version."
(guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c)) (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
(warning (or (package-field-location package 'source) (warning (or (package-field-location package 'source)
(package-location package)) (package-location package))
@ -193,6 +205,7 @@ (define (latest-git-tag-version package)
(url (git-reference-url (origin-uri source))) (url (git-reference-url (origin-uri source)))
(property (cute assq-ref (package-properties package) <>))) (property (cute assq-ref (package-properties package) <>)))
(latest-tag url (latest-tag url
#:version version
#:prefix (property 'release-tag-prefix) #:prefix (property 'release-tag-prefix)
#:suffix (property 'release-tag-suffix) #:suffix (property 'release-tag-suffix)
#:delim (property 'release-tag-version-delimiter) #:delim (property 'release-tag-version-delimiter)
@ -206,12 +219,14 @@ (define (git-package? package)
(git-reference? (origin-uri origin)))) (git-reference? (origin-uri origin))))
(_ #f))) (_ #f)))
(define (latest-git-release package) (define* (import-git-release package #:key (version #f))
"Return an <upstream-source> for the latest release of PACKAGE." "Return an <upstream-source> for the latest release of PACKAGE.
Optionally include a VERSION string to fetch a specific version."
(let* ((name (package-name package)) (let* ((name (package-name package))
(old-version (package-version package)) (old-version (package-version package))
(old-reference (origin-uri (package-source package))) (old-reference (origin-uri (package-source package)))
(new-version new-version-tag (latest-git-tag-version package))) (new-version new-version-tag
(latest-git-tag-version package #:version version)))
(and new-version new-version-tag (and new-version new-version-tag
(upstream-source (upstream-source
(package name) (package name)
@ -226,4 +241,4 @@ (define %generic-git-updater
(name 'generic-git) (name 'generic-git)
(description "Updater for packages hosted on Git repositories") (description "Updater for packages hosted on Git repositories")
(pred git-package?) (pred git-package?)
(import latest-git-release))) (import import-git-release)))