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.master
parent
63e5ef402b
commit
ad54a73bb8
|
@ -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)))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Reference in New Issue