Re: All updaters are broken

["Ludovic Courtès" <ludo@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 2201 bytes --]

Hello!

Ricardo Wurmus <rekado@elephly.net> skribis:

> Okay.  Here’s something simpler using “partition”:
>
> 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))))

I tried something different and perhaps simpler: making sure
‘options->update-specs’ always returns a list of <update-spec>, as the
name implies, and does the right thing with manifests, -r, and -e.
(Part of the patch moves the <update-spec> definition before its first
use.)

WDYT?

This is on top of <https://issues.guix.gnu.org/60368>, which also
clarified a couple of things.

After that I’d like to thing about tests for the CLI.

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4772 bytes --]

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 65c3ce9c16..9438df870d 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -183,9 +183,31 @@ (define (show-help)
   (newline)
   (show-bug-report-information))
 
+\f
+;;;
+;;; Utilities.
+;;;
+
+(define-record-type <update-spec>
+  (%update-spec package version)
+  update?
+  (package update-spec-package)
+  (version update-spec-version))
+
+(define* (update-spec package #:optional version)
+  (%update-spec package version))
+
+(define (update-specification->update-spec spec)
+  "Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update>
+record with two fields: the package to upgrade, and the target version."
+  (match (string-rindex spec #\=)
+    (#f  (update-spec (specification->package spec) #f))
+    (idx (update-spec (specification->package (substring spec 0 idx))
+                      (substring spec (1+ idx))))))
+
 (define (options->update-specs opts)
-  "Return the list of packages requested by OPTS, honoring options like
-'--recursive'."
+  "Return the list of <update-spec> records requested by OPTS, honoring
+options like '--recursive'."
   (define core-package?
     (let* ((input->package (match-lambda
                              ((name (? package? package) _ ...) package)
@@ -220,60 +242,43 @@ (define (keep-newest package lst)
         (_
          (cons package lst)))))
 
-  (define args-packages
-    ;; Packages explicitly passed as command-line arguments.
-    (match (filter-map (match-lambda
+  (define update-specs
+    ;; Update specs explicitly passed as command-line arguments.
+    (match (append-map (match-lambda
                          (('argument . spec)
                           ;; Take either the specified version or the
                           ;; latest one.
-                          (update-specification->update-spec spec))
+                          (list (update-specification->update-spec spec)))
                          (('expression . exp)
-                          (read/eval-package-expression exp))
-                         (_ #f))
+                          (list (update-spec (read/eval-package-expression exp))))
+                         (('manifest . manifest)
+                          (map update-spec (packages-from-manifest manifest)))
+                         (_
+                          '()))
                        opts)
       (()                                         ;default to all packages
        (let ((select? (match (assoc-ref opts 'select)
                         ('core core-package?)
                         ('non-core (negate core-package?))
                         (_ (const #t)))))
-         (fold-packages (lambda (package result)
-                          (if (select? package)
-                              (keep-newest package result)
-                              result))
-                        '())))
+         (map update-spec
+              (fold-packages (lambda (package result)
+                               (if (select? package)
+                                   (keep-newest package result)
+                                   result))
+                             '()))))
       (some                                       ;user-specified packages
        some)))
 
-  (define packages
-    (match (assoc-ref opts 'manifest)
-      (#f args-packages)
-      ((? 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)))
+      (mlet* %store-monad ((edges (node-edges %bag-node-type (all-packages)))
+                           (packages -> (node-transitive-edges
+                                         (map update-spec-package update-specs)
+                                         edges)))
+        ;; FIXME: We're losing the 'version' field of each update spec.
+        (return (map update-spec packages)))
       (with-monad %store-monad
-        (return packages))))
-
-\f
-;;;
-;;; Utilities.
-;;;
-
-(define-record-type <update-spec>
-  (update-spec package version)
-  update?
-  (package update-spec-package)
-  (version update-spec-version))
-
-(define (update-specification->update-spec spec)
-  "Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update>
-record with two fields: the package to upgrade, and the target version."
-  (match (string-rindex spec #\=)
-    (#f  (update-spec (specification->package spec) #f))
-    (idx (update-spec (specification->package (substring spec 0 idx))
-                      (substring spec (1+ idx))))))
+        (return update-specs))))
 
 \f
 ;;;