summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-01-03 12:00:16 +0100
committerLudovic Courtès <ludo@gnu.org>2023-01-03 12:25:48 +0100
commit473692b812b4ab4267d9bddad0fb27787d2112ff (patch)
treec87ccb76f48920934cbcacf90e57352e3012d0c8 /guix/scripts
parent11235dd85a791ca7c88d964fb1f47ec876b43b4e (diff)
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.scm87
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))))
;;;