Re: All updaters are broken

[Ricardo Wurmus]

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