From: Ricardo Wurmus <rekado@elephly.net>
To: Hartmut Goebel <h.goebel@crazy-compilers.com>
Cc: guix-devel@gnu.org
Subject: Re: All updaters are broken
Date: Mon, 02 Jan 2023 14:16:05 +0100 [thread overview]
Message-ID: <871qod5b4v.fsf@elephly.net> (raw)
In-Reply-To: <875ydp5ctv.fsf@elephly.net>
[-- Attachment #1: Type: text/plain, Size: 539 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: refresh.diff --]
[-- Type: text/x-patch, Size: 7356 bytes --]
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))))
\f
;;;
@@ -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)))))))))))
[-- Attachment #3: Type: text/plain, Size: 13 bytes --]
--
Ricardo
next prev parent reply other threads:[~2023-01-02 13:19 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-12-31 14:27 All updaters are broken Ricardo Wurmus
2022-12-31 14:36 ` Ricardo Wurmus
2023-01-01 17:54 ` Hartmut Goebel
2023-01-01 23:24 ` Hartmut Goebel
2023-01-02 12:32 ` Ricardo Wurmus
2023-01-02 13:16 ` Ricardo Wurmus [this message]
2023-01-02 16:17 ` Hartmut Goebel
2023-01-02 19:17 ` Ricardo Wurmus
2023-01-02 19:41 ` Hartmut Goebel
2023-01-03 9:16 ` Ricardo Wurmus
2023-01-03 9:49 ` Ludovic Courtès
2023-01-03 18:29 ` Hartmut Goebel
2023-01-03 21:07 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=871qod5b4v.fsf@elephly.net \
--to=rekado@elephly.net \
--cc=guix-devel@gnu.org \
--cc=h.goebel@crazy-compilers.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.