[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/04: guix build: Record package transformations in manifest entries.
From: |
guix-commits |
Subject: |
01/04: guix build: Record package transformations in manifest entries. |
Date: |
Fri, 2 Oct 2020 17:29:27 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit ad54a73bb820a685f242976a86be63931789fa97
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Sep 24 22:13:06 2020 +0200
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.
---
guix/scripts/build.scm | 80 ++++++++++++++++++++++++++++++++++---------
guix/scripts/pack.scm | 29 +++++++++-------
guix/scripts/package.scm | 13 +++----
tests/guix-package-aliases.sh | 6 ++++
4 files changed, 93 insertions(+), 35 deletions(-)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 476e556..72a5d46 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -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)))))))))
;;;
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index bab3a3e..0b66da0 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -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
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7e7c37e..83f8c12 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -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
diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh
index e4ddace..311838b 100644
--- a/tests/guix-package-aliases.sh
+++ b/tests/guix-package-aliases.sh
@@ -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