[bug#58032] [PATCH] transformations: '--with-source' now operates in depth.

[Maxim Cournoyer]

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> From: Ludovic Courtès <ludovic.courtes@inria.fr>
>
> The '--with-source' option is the first one that was implemented, and
> it's the only one that would operate only on leaf packages rather than
> traversing the dependency graph.  This change makes it consistent with
> the rest of the transformation options.

Good idea!  I needed to workaround the lack of recursion at least once.

[...]

> diff --git a/guix/transformations.scm b/guix/transformations.scm
> index 411c4014cb..be2d31b8c7 100644
> --- a/guix/transformations.scm
> +++ b/guix/transformations.scm
> @@ -129,42 +129,46 @@ (define* (package-with-source p uri #:optional version)
>  ;;; Transformations.
>  ;;;
>  
> -(define (transform-package-source sources)
> +(define (evaluate-source-replacement-specs specs)
> +  "Parse SPECS, a list of strings like \"guile=/tmp/guile-4.2.tar.gz\" or 
> just
> +\"/tmp/guile-4.2.tar.gz\" and return a list of package spec/procedure pairs 
> as
> +expected by 'package-input-rewriting/spec'.  Raise an error if an element of
> +SPECS uses invalid syntax."
> +  (define not-equal
> +    (char-set-complement (char-set #\=)))
> +
> +  (map (lambda (spec)
> +         (match (string-tokenize spec not-equal)
> +           ((uri)
> +            (let* ((base (tarball-base-name (basename uri)))

Unrelated, but 'tarball-base-name' is a bit of a misnomer since the file
could be a single, non-tarball archive (or plain file).

> +                   (name (hyphen-package-name->name+version base)))
> +              (cons name
> +                    (lambda (old)
> +                      (package-with-source old uri)))))
> +           ((spec uri)
> +            (let-values (((name version)
> +                          (package-name->name+version spec)))

You usually recommend (srfi srfi-71) when using multiple values; why not
use it here?  I don't have a preference myself (I find srfi-71
surprising for the non-initiated (I was), although I like its simple
interface! :-)).
> +              ;; Note: Here VERSION is used as the version string of the new
> +              ;; package rather than as part of the spec of the package being
> +              ;; targeted.
> +              (cons name
> +                    (lambda (old)
> +                      (package-with-source old uri version)))))
> +           (_
> +            (raise (formatted-message
> +                    (G_ "invalid source replacement specification: ~s")
> +                    spec)))))
> +       specs))
> +
> +(define (transform-package-source replacement-specs)
>    "Return a transformation procedure that replaces package sources with the
> -matching URIs given in SOURCES."
> -  (define new-sources
> -    (map (lambda (uri)
> -           (match (string-index uri #\=)
> -             (#f
> -              ;; Determine the package name and version from URI.
> -              (call-with-values
> -                  (lambda ()
> -                    (hyphen-package-name->name+version
> -                     (tarball-base-name (basename uri))))
> -                (lambda (name version)
> -                  (list name version uri))))
> -             (index
> -              ;; What's before INDEX is a "PKG@VER" or "PKG" spec.
> -              (call-with-values
> -                  (lambda ()
> -                    (package-name->name+version (string-take uri index)))
> -                (lambda (name version)
> -                  (list name version
> -                        (string-drop uri (+ 1 index))))))))
> -         sources))
> -
> -  (lambda (obj)
> -    (let loop ((sources  new-sources)
> -               (result   '()))
> -      (match obj
> -        ((? package? p)
> -         (match (assoc-ref sources (package-name p))
> -           ((version source)
> -            (package-with-source p source version))
> -           (#f
> -            p)))
> -        (_
> -         obj)))))
> +matching URIs given in REPLACEMENT-SPECS."
> +  (let* ((replacements (evaluate-source-replacement-specs replacement-specs))
> +         (rewrite      (package-input-rewriting/spec replacements)))
> +    (lambda (obj)
> +      (if (package? obj)
> +          (rewrite obj)
> +          obj))))
>  
>  (define (evaluate-replacement-specs specs proc)
>    "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
> diff --git a/tests/transformations.scm b/tests/transformations.scm
> index dbfe523518..47b1fc650d 100644
> --- a/tests/transformations.scm
> +++ b/tests/transformations.scm
> @@ -103,16 +103,11 @@ (define-module (test-transformations)
>                                            "sha256" f))))))))))
>  
>  (test-assert "options->transformation, with-source, no matches"
> -  ;; When a transformation in not applicable, a warning must be raised.
>    (let* ((p (dummy-package "foobar"))
>           (s (search-path %load-path "guix.scm"))
>           (t (options->transformation `((with-source . ,s)))))
> -    (let* ((port (open-output-string))
> -           (new  (parameterize ((guix-warning-port port))
> -                   (t p))))
> -      (and (eq? new p)
> -           (string-contains (get-output-string port)
> -                            "had no effect")))))
> +    (eq? (package-source (t p))
> +         (package-source p))))

I'd personally find it a better interface if it failed noisily when
--with-source doesn't have any effect.  The warning was of little use
because it got lost in the other outputs; now it would be totally
silent, right?

>  (test-assert "options->transformation, with-source, PKG=URI"
>    (let* ((p (dummy-package "foo"))
> @@ -147,6 +142,29 @@ (define-module (test-transformations)
>                         (add-to-store store (basename s) #t
>                                       "sha256" s)))))))
>  
> +(test-assert "options->transformation, with-source, in depth"
> +  (let* ((p0 (dummy-package "foo" (version "0.0")))
> +         (s  (search-path %load-path "guix.scm"))
> +         (f  (string-append "foo@42.0=" s))
> +         (t  (options->transformation `((with-source . ,f))))
> +         (p1 (dummy-package "bar" (inputs (list p0))))
> +         (p2 (dummy-package "baz" (inputs (list p1)))))
> +    (with-store store
> +      (let ((new (t p2)))
> +        (and (not (eq? new p2))
> +             (match (package-inputs new)
> +               ((("bar" p1*))
> +                (match (package-inputs p1*)
> +                  ((("foo" p0*))
> +                   (and (not (eq? p0* p0))
> +                        (string=? (package-name p0*) (package-name p0))
> +                        (string=? (package-version p0*) "42.0")
> +                        (string=? (add-to-store store (basename s) #t
> +                                                "sha256" s)
> +                                  (run-with-store store
> +                                    (lower-object
> +                                     (package-source p0*))))))))))))))
> +

The recursive? option should probably be #f in the add-store above,
since the "dummy" source is a single file.  It may be better to create
the dummy file ourselves instead of relying on the existence of a
'guix.scm' one (it'd help clarify the test too, that bit was a bit
mysterious at first).

Other than that, LGTM!

Thanks,

Maxim