unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
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

  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

  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=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 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).