guix build: Record package transformations in manifest entries.

With this change, package transformation options used while building a
manifest are saved in the metadata of the manifest entries.

* guix/scripts/build.scm (transformation-procedure): New procedure.
(options->transformation)[applicable]: Use it.  Change to a list of
key/value/proc tuples instead of key/proc pairs.
[package-with-transformation-properties, tagged-object]: New
procedures.  Use them.
(package-transformations, manifest-entry-with-transformations): New
procedures.
* guix/scripts/pack.scm (guix-pack)[with-transformations]: New
procedure.
Use it.
* guix/scripts/package.scm (process-actions)[transform-entry]: Use it.
* tests/guix-package-aliases.sh: Add test.
This commit is contained in:
Ludovic Courtès 2020-09-24 22:13:06 +02:00
parent 63e5ef402b
commit ad54a73bb8
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 93 additions and 35 deletions

View File

@ -63,6 +63,7 @@
%transformation-options
options->transformation
manifest-entry-with-transformations
show-transformation-options-help
guix-build
@ -427,6 +428,14 @@ a checkout of the Git repository at the given URL."
(with-git-url . ,transform-package-source-git-url)
(without-tests . ,transform-package-tests)))
(define (transformation-procedure key)
"Return the transformation procedure associated with KEY, a symbol such as
'with-source', or #f if there is none."
(any (match-lambda
((k . proc)
(and (eq? k key) proc)))
%transformations))
(define %transformation-options
;; The command-line interface to the above transformations.
(let ((parser (lambda (symbol)
@ -481,32 +490,69 @@ derivation, etc.), applies the transformations specified by OPTS."
;; order in which they appear on the command line.
(filter-map (match-lambda
((key . value)
(match (any (match-lambda
((k . proc)
(and (eq? k key) proc)))
%transformations)
(match (transformation-procedure key)
(#f
#f)
(transform
;; XXX: We used to pass TRANSFORM a list of several
;; arguments, but we now pass only one, assuming that
;; transform composes well.
(cons key (transform (list value)))))))
(list key value (transform (list value)))))))
(reverse opts)))
(define (package-with-transformation-properties p)
(package/inherit p
(properties `((transformations
. ,(map (match-lambda
((key value _)
(cons key value)))
applicable))
,@(package-properties p)))))
(lambda (store obj)
(fold (match-lambda*
(((name . transform) obj)
(let ((new (transform store obj)))
(when (eq? new obj)
(warning (G_ "transformation '~a' had no effect on ~a~%")
name
(if (package? obj)
(package-full-name obj)
obj)))
new)))
obj
applicable)))
(define (tagged-object new)
(if (and (not (eq? obj new))
(package? new) (not (null? applicable)))
(package-with-transformation-properties new)
new))
(tagged-object
(fold (match-lambda*
(((name value transform) obj)
(let ((new (transform store obj)))
(when (eq? new obj)
(warning (G_ "transformation '~a' had no effect on ~a~%")
name
(if (package? obj)
(package-full-name obj)
obj)))
new)))
obj
applicable))))
(define (package-transformations package)
"Return the transformations applied to PACKAGE according to its properties."
(match (assq-ref (package-properties package) 'transformations)
(#f '())
(transformations transformations)))
(define (manifest-entry-with-transformations entry)
"Return ENTRY with an additional 'transformations' property if it's not
already there."
(let ((properties (manifest-entry-properties entry)))
(if (assq 'transformations properties)
entry
(let ((item (manifest-entry-item entry)))
(manifest-entry
(inherit entry)
(properties
(match (and (package? item)
(package-transformations item))
((or #f '())
properties)
(transformations
`((transformations . ,transformations)
,@properties)))))))))
;;;

View File

@ -1140,19 +1140,24 @@ Create a bundle of PACKAGE.\n"))
manifest))
identity))
(define (with-transformations manifest)
(map-manifest-entries manifest-entry-with-transformations
manifest))
(with-provenance
(cond
((and (not (null? manifests)) (not (null? packages)))
(leave (G_ "both a manifest and a package list were given~%")))
((not (null? manifests))
(concatenate-manifests
(map (lambda (file)
(let ((user-module (make-user-module
'((guix profiles) (gnu)))))
(load* file user-module)))
manifests)))
(else
(packages->manifest packages))))))
(with-transformations
(cond
((and (not (null? manifests)) (not (null? packages)))
(leave (G_ "both a manifest and a package list were given~%")))
((not (null? manifests))
(concatenate-manifests
(map (lambda (file)
(let ((user-module (make-user-module
'((guix profiles) (gnu)))))
(load* file user-module)))
manifests)))
(else
(packages->manifest packages)))))))
(with-error-handling
(with-store store

View File

@ -864,12 +864,13 @@ processed, #f otherwise."
(define (transform-entry entry)
(let ((item (transform store (manifest-entry-item entry))))
(manifest-entry
(inherit entry)
(item item)
(version (if (package? item)
(package-version item)
(manifest-entry-version entry))))))
(manifest-entry-with-transformations
(manifest-entry
(inherit entry)
(item item)
(version (if (package? item)
(package-version item)
(manifest-entry-version entry)))))))
(when (equal? profile %current-profile)
;; Normally the daemon created %CURRENT-PROFILE when we connected, unless

View File

@ -39,6 +39,12 @@ test -x "$profile/bin/guile"
! guix install -r guile-bootstrap -p "$profile" --bootstrap
test -x "$profile/bin/guile"
# Use a package transformation option and make sure it's recorded.
guix install --bootstrap guile-bootstrap -p "$profile" \
--with-input=libreoffice=inkscape
test -x "$profile/bin/guile"
grep "libreoffice=inkscape" "$profile/manifest"
guix upgrade --version
guix upgrade -n
guix upgrade gui.e -n