diff mbox series

[bug#65062,v2,core-updates,2/2] packages: Lookup inputs by specification.

Message ID dac85ddb4c5637ab522b4b37f926f00af567cc33.1696323536.git.hako@ultrarare.space
State New
Headers show
Series packages: Lookup inputs by specification. | expand

Commit Message

Hilton Chain Oct. 3, 2023, 9:17 a.m. UTC 
* guix/packages.scm (specification->inputs): New procedure.
(lookup-input,replace-input): Use it.
(delete-input): New procedure.
(modify-inputs)[delete]: Use it.
---
 guix/packages.scm | 72 +++++++++++++++++++++++++++++++++++++----------
 1 file changed, 57 insertions(+), 15 deletions(-)

Comments

Ludovic Courtès Dec. 20, 2023, 9:26 p.m. UTC | #1 
Hi,

Hilton Chain <hako@ultrarare.space> skribis:

> * guix/packages.scm (specification->inputs): New procedure.
> (lookup-input,replace-input): Use it.
> (delete-input): New procedure.
> (modify-inputs)[delete]: Use it.

I’ve been thinking about this change lately.

The problem we have now is that it looks like input labels are gone, but
they’re not; in particular ‘modify-inputs’ preserves labels, which is a
source of confusion.  For instance, if you do:

  (modify-inputs x
    (replace "openmpi" mpich))

then ‘mpich’ remains associated with the “openmpi” label.  Ugh.

So I sympathize with the goal.  I think we can do something simpler
though:

>  (define (lookup-input inputs name)
>    "Lookup NAME among INPUTS, an input list."
>    ;; Note: Currently INPUTS is assumed to be an input list that contains input
>    ;; labels.  In the future, input labels will be gone and this procedure will
>    ;; check package names.
> -  (match (assoc-ref inputs name)
> -    ((obj) obj)
> -    ((obj _) obj)
> -    (#f #f)))
> +  (let ((candidates (specification->inputs name inputs)))
> +    (and (not (null? candidates))
> +         (second (first candidates)))))

How about:

  (find (match-lambda
          ((_ (? package? package) . _)
           (string=? (package-name package) name))
          (_ #f))
        inputs)

?

That way, ‘lookup-input’ would honor package names and ignore labels.

> +(define (delete-input name inputs)
> +  "Delete input NAME within INPUTS."
> +  (let ((to-delete (specification->inputs name inputs)))
> +    (lset-difference equal? inputs to-delete)))

And we do something similar here.

Thus, no need to fiddle with specifications.

How does that sound?

Now, I think this is the way forward, but I also think it’s going to
break many packages and workflows (‘--with-input’…).  So it should go
hand in hand with an effort to fully remove labels in Guix.

Thanks,
Ludo’.
diff mbox series

Patch

diff --git a/guix/packages.scm b/guix/packages.scm
index b004882cc6..45552bfb7f 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1173,15 +1173,49 @@  (define (transitive-inputs inputs)
       ((input rest ...)
        (loop rest (cons input result) propagated first? seen)))))
 
+(define (specification->inputs spec inputs)
+  "Lookup inputs specified by SPEC among INPUTS, an input list.  Return an input
+list consists of all matching inputs, or '().  SPEC may be a package name,
+optionally containing a version number or an output name, as in these examples:
+
+  guile
+  guile@2.0.9
+  guile:debug
+  guile@2.0.9:debug
+
+If SPEC does not specify a version number, all versions are matched; if SPEC
+does not specify an output, all outputs are matched.
+
+SPEC can be an input label as well."
+  (let ((name version sub-drv
+              (package-specification->name+version+output spec #f)))
+    (filter-map
+     (lambda (input)
+       (match input
+         (((? string? label) (? package? package) . outputs)
+          (and (or (and (string=? name (package-name package))
+                        (when version
+                          (string-prefix? version (package-version package)))
+                        (when sub-drv
+                          (and (not (null? outputs))
+                               (string=? sub-drv (first outputs)))))
+                   ;; fallback to input label
+                   (string=? label spec))
+               input))
+         ;; not a package
+         (((? string? label) _ . _)
+          (and (string=? label spec)
+               input))))
+     inputs)))
+
 (define (lookup-input inputs name)
   "Lookup NAME among INPUTS, an input list."
   ;; Note: Currently INPUTS is assumed to be an input list that contains input
   ;; labels.  In the future, input labels will be gone and this procedure will
   ;; check package names.
-  (match (assoc-ref inputs name)
-    ((obj) obj)
-    ((obj _) obj)
-    (#f #f)))
+  (let ((candidates (specification->inputs name inputs)))
+    (and (not (null? candidates))
+         (second (first candidates)))))
 
 (define (lookup-package-input package name)
   "Look up NAME among PACKAGE's inputs.  Return it if found, #f otherwise."
@@ -1202,17 +1236,25 @@  (define (lookup-package-direct-input package name)
 otherwise."
   (lookup-input (package-direct-inputs package) name))
 
+(define (delete-input name inputs)
+  "Delete input NAME within INPUTS."
+  (let ((to-delete (specification->inputs name inputs)))
+    (lset-difference equal? inputs to-delete)))
+
 (define (replace-input name replacement inputs)
   "Replace input NAME by REPLACEMENT within INPUTS."
-  (map (lambda (input)
-         (match input
-           (((? string? label) _ . outputs)
-            (if (string=? label name)
-                (match replacement        ;does REPLACEMENT specify an output?
-                  ((_ _) (cons label replacement))
-                  (_     (cons* label replacement outputs)))
-                input))))
-       inputs))
+  (let ((to-replace (specification->inputs name inputs)))
+    (append
+     (lset-difference equal? inputs to-replace)
+     (if (null? to-replace)
+         '()
+         (map (lambda (input)
+                (match input
+                  ((label _ . outputs)
+                   (match replacement   ;does REPLACEMENT specify an output?
+                     ((_ _) (cons label replacement))
+                     (_     (cons* label replacement outputs))))))
+              to-replace)))))
 
 (define-syntax prepend
   (lambda (s)
@@ -1244,10 +1286,10 @@  (define-syntax modify-inputs
     ;; 'package-inputs' & co., is actually an alist with labels.  Eventually,
     ;; it will operate on list of inputs without labels.
     ((_ inputs (delete name) clauses ...)
-     (modify-inputs (alist-delete name inputs)
+     (modify-inputs (delete-input name inputs)
                     clauses ...))
     ((_ inputs (delete names ...) clauses ...)
-     (modify-inputs (fold alist-delete inputs (list names ...))
+     (modify-inputs (fold delete-input inputs (list names ...))
                     clauses ...))
     ((_ inputs (prepend lst ...) clauses ...)
      (modify-inputs (append (map add-input-label (list lst ...)) inputs)