diff options
author | Hartmut Goebel <h.goebel@crazy-compilers.com> | 2022-06-24 20:40:57 +0200 |
---|---|---|
committer | Hartmut Goebel <h.goebel@crazy-compilers.com> | 2022-12-26 17:38:07 +0100 |
commit | 8aeccc6240ec45f0bc7bed655e0c8149ae4253eb (patch) | |
tree | 5040f89a2a39ecbc1a9bc8c1d8691879de0400b5 /guix/scripts | |
parent | b82eb8d67add518c39af39227397b78285f89a50 (diff) |
refresh: Allow updating to a specific version.
* guix/scripts/refresh.scm (options->packages)[args-packages]: Handle version
specification in package name arguments.
(update-package): Add #:version argument and pass it on to called functions.
(guix-refresh): When updating, pass the specified version (if any) to
update-package.
[package-list-without-versions, package-list-with-versions]: New functions.
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/refresh.scm | 49 |
1 files changed, 37 insertions, 12 deletions
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 14329751f8..e0b94ce48d 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> +;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -46,6 +47,7 @@ #:use-module (ice-9 vlist) #:use-module (ice-9 format) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (srfi srfi-71) @@ -181,7 +183,7 @@ specified with `--select'.\n")) (newline) (show-bug-report-information)) -(define (options->packages opts) +(define (options->update-specs opts) "Return the list of packages requested by OPTS, honoring options like '--recursive'." (define core-package? @@ -224,7 +226,7 @@ update would trigger a complete rebuild." (('argument . spec) ;; Take either the specified version or the ;; latest one. - (specification->package spec)) + (update-specification->update-spec spec)) (('expression . exp) (read/eval-package-expression exp)) (_ #f)) @@ -256,6 +258,25 @@ update would trigger a complete rebuild." ;;; +;;; Utilities. +;;; + +(define-record-type <update-spec> + (update-spec package version) + update? + (package update-spec-package) + (version update-spec-version)) + +(define (update-specification->update-spec spec) + "Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update> +record with two fields: the package to upgrade, and the target version." + (match (string-rindex spec #\=) + (#f (update-spec (specification->package spec) #f)) + (idx (update-spec (specification->package (substring spec 0 idx)) + (substring spec (1+ idx)))))) + + +;;; ;;; Updates. ;;; @@ -298,7 +319,7 @@ update would trigger a complete rebuild." (G_ "no updater for ~a~%") (package-name package))) -(define* (update-package store package updaters +(define* (update-package store package version updaters #:key (key-download 'interactive) warn?) "Update the source file that defines PACKAGE with the new version. KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed @@ -307,7 +328,7 @@ warn about packages that have no matching updater." (if (lookup-updater package updaters) (let ((version output source (package-update store package updaters - #:key-download key-download)) + #:key-download key-download #:version version)) (loc (or (package-field-location package 'version) (package-location package)))) (when version @@ -540,12 +561,12 @@ all are dependent packages: ~{~a~^ ~}~%") (with-error-handling (with-store store (run-with-store store - (mlet %store-monad ((packages (options->packages opts))) + (mlet %store-monad ((update-specs (options->update-specs opts))) (cond (list-dependent? - (list-dependents packages)) + (list-dependents (map update-spec-package update-specs))) (list-transitive? - (list-transitive packages)) + (list-transitive (map update-spec-package update-specs))) (update? (parameterize ((%openpgp-key-server (or (assoc-ref opts 'key-server) @@ -558,13 +579,17 @@ all are dependent packages: ~{~a~^ ~}~%") (string-append (config-directory) "/upstream/trustedkeys.kbx")))) (for-each - (cut update-package store <> updaters - #:key-download key-download - #:warn? warn?) - packages) + (lambda (update) + (update-package store + (update-spec-package update) + (update-spec-version update) + updaters + #:key-download key-download + #:warn? warn?)) + update-specs) (return #t))) (else (for-each (cut check-for-package-update <> updaters #:warn? warn?) - packages) + (map update-spec-package update-specs)) (return #t))))))))) |