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: Tue, 03 Jan 2023 10:16:41 +0100 [thread overview]
Message-ID: <87k0243rg8.fsf@elephly.net> (raw)
In-Reply-To: <12f602da-16fb-0c19-1fe2-8e4c9a921868@crazy-compilers.com>
[-- Attachment #1: Type: text/plain, Size: 336 bytes --]
Hi Hartmut,
> Am 02.01.23 um 20:17 schrieb Ricardo Wurmus:
>
> Thanks for providing the patch. For me this looks huge and hard to
> maintain.
>
> “Hard to maintain”? How so?
>
> For me this double structure is hard to understand and thus to maintain. YMMV.
Okay. Here’s something simpler using “partition”:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: refresh-w.diff --]
[-- Type: text/x-patch, Size: 3941 bytes --]
commit 96fb123832b262a3453fe1b7646758da235a343e
Author: Ricardo Wurmus <rekado@elephly.net>
Date: Tue Jan 3 10:14:52 2023 +0100
WIP
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e0b94ce48d..bbda2df35a 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,7 +220,7 @@ (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)
@@ -244,17 +244,18 @@ (define args-packages
(some ;user-specified packages
some)))
- (define packages
+ (define packages+update-specs
(match (assoc-ref opts 'manifest)
- (#f args-packages)
+ (#f args-packages+update-specs)
((? string? file) (packages-from-manifest file))))
(if (assoc-ref opts 'recursive?)
+ (let ((packages update-specs (partition package? packages+update-specs)))
(mlet %store-monad ((edges (node-edges %bag-node-type
(all-packages))))
- (return (node-transitive-edges packages edges)))
+ (return (append (node-transitive-edges packages edges) update-specs))))
(with-monad %store-monad
- (return packages))))
+ (return packages+update-specs))))
\f
;;;
@@ -561,12 +562,13 @@ (define (options->updaters opts)
(with-error-handling
(with-store store
(run-with-store store
- (mlet %store-monad ((update-specs (options->update-specs opts)))
+ (mlet %store-monad ((packages+update-specs (options->packages+update-specs opts)))
+ (let ((packages update-specs (partition package? packages+update-specs)))
(cond
(list-dependent?
- (list-dependents (map update-spec-package update-specs)))
+ (list-dependents (append packages (map update-spec-package update-specs))))
(list-transitive?
- (list-transitive (map update-spec-package update-specs)))
+ (list-transitive (append packages (map update-spec-package update-specs))))
(update?
(parameterize ((%openpgp-key-server
(or (assoc-ref opts 'key-server)
@@ -587,9 +589,18 @@ (define (options->updaters opts)
#:key-download key-download
#:warn? warn?))
update-specs)
+ (for-each
+ (lambda (package)
+ (update-package store
+ package
+ #false
+ updaters
+ #:key-download key-download
+ #:warn? warn?))
+ packages)
(return #t)))
(else
(for-each (cut check-for-package-update <> updaters
#:warn? warn?)
- (map update-spec-package update-specs))
- (return #t)))))))))
+ (append packages (map update-spec-package update-specs)))
+ (return #t))))))))))
[-- Attachment #3: Type: text/plain, Size: 88 bytes --]
(This patch ignores white-space.)
Here’s the patch with white-space changes:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: refresh.diff --]
[-- Type: text/x-patch, Size: 6087 bytes --]
commit 96fb123832b262a3453fe1b7646758da235a343e
Author: Ricardo Wurmus <rekado@elephly.net>
Date: Tue Jan 3 10:14:52 2023 +0100
WIP
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e0b94ce48d..bbda2df35a 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,7 +220,7 @@ (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)
@@ -244,17 +244,18 @@ (define args-packages
(some ;user-specified packages
some)))
- (define packages
+ (define packages+update-specs
(match (assoc-ref opts 'manifest)
- (#f args-packages)
+ (#f args-packages+update-specs)
((? 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)))
+ (let ((packages update-specs (partition package? packages+update-specs)))
+ (mlet %store-monad ((edges (node-edges %bag-node-type
+ (all-packages))))
+ (return (append (node-transitive-edges packages edges) update-specs))))
(with-monad %store-monad
- (return packages))))
+ (return packages+update-specs))))
\f
;;;
@@ -561,35 +562,45 @@ (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)))
+ (let ((packages update-specs (partition package? packages+update-specs)))
+ (cond
+ (list-dependent?
+ (list-dependents (append packages (map update-spec-package update-specs))))
+ (list-transitive?
+ (list-transitive (append packages (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 (package)
+ (update-package store
+ package
+ #false
+ updaters
+ #:key-download key-download
+ #:warn? warn?))
+ packages)
+ (return #t)))
+ (else
+ (for-each (cut check-for-package-update <> updaters
+ #:warn? warn?)
+ (append packages (map update-spec-package update-specs)))
+ (return #t))))))))))
[-- Attachment #5: Type: text/plain, Size: 379 bytes --]
I can’t say whether this is better than your proposal as I’m biased, so
maybe let’s get someone else’s opinion on this before merging either of
them. I have a slight preference for this approach over wrapping and
unwrapping. Ideally we would avoid mixing up packages and update specs
in the first place, but that’s not easily accomplished now.
--
Ricardo
next prev parent reply other threads:[~2023-01-03 9:25 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
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 [this message]
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
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87k0243rg8.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 public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).