[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: All updaters are broken
From: |
Ricardo Wurmus |
Subject: |
Re: All updaters are broken |
Date: |
Mon, 02 Jan 2023 14:16:05 +0100 |
User-agent: |
mu4e 1.8.13; emacs 28.2 |
Ricardo Wurmus <rekado@elephly.net> writes:
> It’s a bit messy because options->update-specs is poorly typed now. We
> could also have it return a compound value (or a union type) with a list
> of <update-spec> values and a list of <package> values, and process the
> components separately.
Attached is a crude implementation of that. I just consed the lists
together instead of returning multiple values, because the compound
value is to be used inside the store monad where we can’t easily access
multiple values.
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e0b94ce48d..b2e9e81299 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -183,9 +183,9 @@ (define (show-help)
(newline)
(show-bug-report-information))
-(define (options->update-specs opts)
- "Return the list of packages requested by OPTS, honoring options like
-'--recursive'."
+(define (options->packages+update-specs opts)
+ "Return the list of packages and update specs requested by OPTS, honoring
+options like '--recursive'."
(define core-package?
(let* ((input->package (match-lambda
((name (? package? package) _ ...) package)
@@ -220,15 +220,15 @@ (define (keep-newest package lst)
(_
(cons package lst)))))
- (define args-packages
+ (define args-packages+update-specs
;; Packages explicitly passed as command-line arguments.
(match (filter-map (match-lambda
(('argument . spec)
;; Take either the specified version or the
;; latest one.
- (update-specification->update-spec spec))
+ (cons '() (update-specification->update-spec spec)))
(('expression . exp)
- (read/eval-package-expression exp))
+ (cons (read/eval-package-expression exp) '()))
(_ #f))
opts)
(() ;default to all packages
@@ -236,25 +236,29 @@ (define args-packages
('core core-package?)
('non-core (negate core-package?))
(_ (const #t)))))
- (fold-packages (lambda (package result)
- (if (select? package)
- (keep-newest package result)
- result))
- '())))
+ (cons (fold-packages (lambda (package result)
+ (if (select? package)
+ (keep-newest package result)
+ result))
+ '())
+ '())))
(some ;user-specified packages
some)))
- (define packages
+ (define packages+update-specs
(match (assoc-ref opts 'manifest)
- (#f args-packages)
- ((? string? file) (packages-from-manifest file))))
+ (#f args-packages+update-specs)
+ ((? string? file) (cons (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)))
+ (match packages+update-specs
+ ((packages . update-specs)
+ (mlet %store-monad ((edges (node-edges %bag-node-type
+ (all-packages))))
+ (return (values (node-transitive-edges packages edges)
+ update-specs)))))
(with-monad %store-monad
- (return packages))))
+ (return packages+update-specs))))
;;;
@@ -561,35 +565,47 @@ (define (options->updaters opts)
(with-error-handling
(with-store store
(run-with-store store
- (mlet %store-monad ((update-specs (options->update-specs opts)))
- (cond
- (list-dependent?
- (list-dependents (map update-spec-package update-specs)))
- (list-transitive?
- (list-transitive (map update-spec-package update-specs)))
- (update?
- (parameterize ((%openpgp-key-server
- (or (assoc-ref opts 'key-server)
- (%openpgp-key-server)))
- (%gpg-command
- (or (assoc-ref opts 'gpg-command)
- (%gpg-command)))
- (current-keyring
- (or (assoc-ref opts 'keyring)
- (string-append (config-directory)
-
"/upstream/trustedkeys.kbx"))))
- (for-each
- (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?)
- (map update-spec-package update-specs))
- (return #t)))))))))
+ (mlet %store-monad ((packages+update-specs
(options->packages+update-specs opts)))
+ (match packages+update-specs
+ ((pkgs . update-specs)
+ (pk 'pkgs (length pkgs) 'specs (length update-specs))
+ (cond
+ (list-dependent?
+ (list-dependents (append pkgs (map update-spec-package
update-specs))))
+ (list-transitive?
+ (list-transitive (append pkgs (map update-spec-package
update-specs))))
+ (update?
+ (parameterize ((%openpgp-key-server
+ (or (assoc-ref opts 'key-server)
+ (%openpgp-key-server)))
+ (%gpg-command
+ (or (assoc-ref opts 'gpg-command)
+ (%gpg-command)))
+ (current-keyring
+ (or (assoc-ref opts 'keyring)
+ (string-append (config-directory)
+
"/upstream/trustedkeys.kbx"))))
+ (for-each
+ (lambda (update)
+ (update-package store
+ (update-spec-package update)
+ (update-spec-version update)
+ updaters
+ #:key-download key-download
+ #:warn? warn?))
+ update-specs)
+ (for-each
+ (lambda (pkg)
+ (update-package store
+ pkg
+ #false
+ updaters
+ #:key-download key-download
+ #:warn? warn?))
+ pkgs)
+ (return #t)))
+ (else
+ (for-each (cut check-for-package-update <> updaters
+ #:warn? warn?)
+ (map update-spec-package update-specs))
+ (return #t)))))))))))
--
Ricardo
- Re: All updaters are broken, Hartmut Goebel, 2023/01/01
- Re: All updaters are broken, Hartmut Goebel, 2023/01/01
- Re: All updaters are broken, Ricardo Wurmus, 2023/01/02
- Re: All updaters are broken,
Ricardo Wurmus <=
- Re: All updaters are broken, Hartmut Goebel, 2023/01/02
- Re: All updaters are broken, Ricardo Wurmus, 2023/01/02
- Re: All updaters are broken, Hartmut Goebel, 2023/01/02
- Re: All updaters are broken, Ricardo Wurmus, 2023/01/03
- Re: All updaters are broken, Ludovic Courtès, 2023/01/03
- Re: All updaters are broken, Hartmut Goebel, 2023/01/03
- Re: All updaters are broken, Ludovic Courtès, 2023/01/03