diff options
author | Ludovic Courtès <ludo@gnu.org> | 2023-01-03 12:00:16 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2023-01-03 12:25:48 +0100 |
commit | 473692b812b4ab4267d9bddad0fb27787d2112ff (patch) | |
tree | c87ccb76f48920934cbcacf90e57352e3012d0c8 /guix/scripts | |
parent | 11235dd85a791ca7c88d964fb1f47ec876b43b4e (diff) | |
download | guix-patches-473692b812b4ab4267d9bddad0fb27787d2112ff.tar guix-patches-473692b812b4ab4267d9bddad0fb27787d2112ff.tar.gz |
refresh: Always return an <update-spec> for each command-line option.
This fixes a regression introduced in
8aeccc6240ec45f0bc7bed655e0c8149ae4253eb whereby packages specified via
-e, -r, or -m, as well as packages *not* specified on the command line,
would all lead to a wrong-type error.
Reported by Ricardo Wurmus <rekado@elephly.net> at
<https://lists.gnu.org/archive/html/guix-devel/2022-12/msg00311.html>.
* guix/scripts/refresh.scm (<update-spec>): Move above. Rename
constructor to '%update-spec' and add separate 'update-spec' procedure
with optional #:version parameter.
(options->update-specs): Always return a list of <update-spec> and
update docstring accordingly. Rename 'args-packages' to 'update-specs'
and ensure it's a list of <update-spec>; handle 'manifest' arguments
here.
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/refresh.scm | 87 |
1 files changed, 46 insertions, 41 deletions
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 65c3ce9c16..6498d73c2b 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -183,9 +183,31 @@ specified with `--select'.\n")) (newline) (show-bug-report-information)) + +;;; +;;; Utilities. +;;; + +(define-record-type <update-spec> + (%update-spec package version) + update? + (package update-spec-package) + (version update-spec-version)) + +(define* (update-spec package #:optional version) + (%update-spec package 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)))))) + (define (options->update-specs opts) - "Return the list of packages requested by OPTS, honoring options like -'--recursive'." + "Return the list of <update-spec> records requested by OPTS, honoring +options like '--recursive'." (define core-package? (let* ((input->package (match-lambda ((name (? package? package) _ ...) package) @@ -220,60 +242,43 @@ update would trigger a complete rebuild." (_ (cons package lst))))) - (define args-packages - ;; Packages explicitly passed as command-line arguments. - (match (filter-map (match-lambda + (define update-specs + ;; Update specs explicitly passed as command-line arguments. + (match (append-map (match-lambda (('argument . spec) ;; Take either the specified version or the ;; latest one. - (update-specification->update-spec spec)) + (list (update-specification->update-spec spec))) (('expression . exp) - (read/eval-package-expression exp)) - (_ #f)) + (list (update-spec (read/eval-package-expression exp)))) + (('manifest . manifest) + (map update-spec (packages-from-manifest manifest))) + (_ + '())) opts) (() ;default to all packages (let ((select? (match (assoc-ref opts 'select) ('core core-package?) ('non-core (negate core-package?)) (_ (const #t))))) - (fold-packages (lambda (package result) - (if (select? package) - (keep-newest package result) - result)) - '()))) + (map update-spec + (fold-packages (lambda (package result) + (if (select? package) + (keep-newest package result) + result)) + '())))) (some ;user-specified packages some))) - (define packages - (match (assoc-ref opts 'manifest) - (#f args-packages) - ((? string? file) (packages-from-manifest file)))) - (if (assoc-ref opts 'recursive?) - (mlet %store-monad ((edges (node-edges %bag-node-type - (all-packages)))) - (return (node-transitive-edges packages edges))) + (mlet* %store-monad ((edges (node-edges %bag-node-type (all-packages))) + (packages -> (node-transitive-edges + (map update-spec-package update-specs) + edges))) + ;; FIXME: The 'version' field of each update spec is lost. + (return (map update-spec packages))) (with-monad %store-monad - (return packages)))) - - -;;; -;;; 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)))))) + (return update-specs)))) ;;; |