package-output
package-grafts
package-patched-vulnerabilities
+ package-with-patches
+ package-with-extra-patches
package/inherit
transitive-input-references
(let ((field (assoc field inits)))
(match field
((_ value)
- (let ((props (source-properties value)))
- (and props
+ (let ((loc (and=> (source-properties value)
+ source-properties->location)))
+ (and loc
;; Preserve the original file name, which may be a
;; relative file name.
- (let ((loc (source-properties->location props)))
- (set-field loc (location-file) file)))))
+ (set-field loc (location-file) file))))
(_
#f))))
(_
(let ((distro (resolve-interface '(gnu packages commencement))))
(module-ref distro 'guile-final)))
-(define (guile-2.0)
- "Return Guile 2.0."
- ;; FIXME: This is used as a workaround for <https://bugs.gnu.org/28211> when
+(define (guile-for-grafts)
+ "Return the Guile package used to build grafting derivations."
+ ;; Guile 2.2 would not work due to <https://bugs.gnu.org/28211> when
;; grafting packages.
(let ((distro (resolve-interface '(gnu packages guile))))
(module-ref distro 'guile-2.0)))
#:properties `((type . origin)
(patches . ,(length patches)))))))
+(define (package-with-patches original patches)
+ "Return package ORIGINAL with PATCHES applied."
+ (package (inherit original)
+ (source (origin (inherit (package-source original))
+ (patches patches)))))
+
+(define (package-with-extra-patches original patches)
+ "Return package ORIGINAL with all PATCHES appended to its list of patches."
+ (package-with-patches original
+ (append (origin-patches (package-source original))
+ patches)))
+
(define (transitive-inputs inputs)
"Return the closure of INPUTS when considering the 'propagated-inputs'
edges. Omit duplicate inputs, except for those already present in INPUTS
(define (bag-transitive-inputs bag)
"Same as 'package-transitive-inputs', but applied to a bag."
- (transitive-inputs (bag-direct-inputs bag)))
+ (parameterize ((%current-target-system #f))
+ (transitive-inputs (bag-direct-inputs bag))))
(define (bag-transitive-build-inputs bag)
"Same as 'package-transitive-native-inputs', but applied to a bag."
- (transitive-inputs (bag-build-inputs bag)))
+ (parameterize ((%current-target-system #f))
+ (transitive-inputs (bag-build-inputs bag))))
(define (bag-transitive-host-inputs bag)
"Same as 'package-transitive-target-inputs', but applied to a bag."
(define (bag-transitive-target-inputs bag)
"Return the \"target inputs\" of BAG, recursively."
- (transitive-inputs (bag-target-inputs bag)))
+ (parameterize ((%current-target-system (bag-target bag)))
+ (transitive-inputs (bag-target-inputs bag))))
(define* (package-closure packages #:key (system (%current-system)))
"Return the closure of PACKAGES on SYSTEM--i.e., PACKAGES and the list of
#:key (graft? (%graft?)))
"Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
and return it."
- (cached (=> %bag-cache)
- package (list system target graft?)
- ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
- ;; field values can refer to it.
- (parameterize ((%current-system system)
- (%current-target-system target))
- (match (if graft?
- (or (package-replacement package) package)
- package)
- ((and self
- ($ <package> name version source build-system
- args inputs propagated-inputs native-inputs
- outputs))
- ;; Even though we prefer to use "@" to separate the package
- ;; name from the package version in various user-facing parts
- ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
- ;; prohibits the use of "@", so use "-" instead.
- (or (make-bag build-system (string-append name "-" version)
- #:system system
- #:target target
- #:source source
- #:inputs (append (inputs self)
- (propagated-inputs self))
- #:outputs outputs
- #:native-inputs (native-inputs self)
- #:arguments (args self))
- (raise (if target
- (condition
- (&package-cross-build-system-error
- (package package)))
- (condition
- (&package-error
- (package package)))))))))))
+ (let ((package (or (and graft? (package-replacement package))
+ package)))
+ (cached (=> %bag-cache)
+ package (list system target)
+ ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
+ ;; field values can refer to it.
+ (parameterize ((%current-system system)
+ (%current-target-system target))
+ (match package
+ ((and self
+ ($ <package> name version source build-system
+ args inputs propagated-inputs native-inputs
+ outputs))
+ ;; Even though we prefer to use "@" to separate the package
+ ;; name from the package version in various user-facing parts
+ ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
+ ;; prohibits the use of "@", so use "-" instead.
+ (or (make-bag build-system (string-append name "-" version)
+ #:system system
+ #:target target
+ #:source source
+ #:inputs (append (inputs self)
+ (propagated-inputs self))
+ #:outputs outputs
+ #:native-inputs (native-inputs self)
+ #:arguments (args self))
+ (raise (if target
+ (condition
+ (&package-cross-build-system-error
+ (package package)))
+ (condition
+ (&package-error
+ (package package))))))))))))
(define %graft-cache
;; 'eq?' cache mapping package objects to a graft corresponding to their
(()
drv)
(grafts
- (let ((guile (package-derivation store (guile-2.0)
+ (let ((guile (package-derivation store (guile-for-grafts)
system #:graft? #f)))
;; TODO: As an optimization, we can simply graft the tip
;; of the derivation graph since 'graft-derivation'
(graft-derivation store drv grafts
#:system system
#:guile
- (package-derivation store (guile-2.0)
+ (package-derivation store (guile-for-grafts)
system #:graft? #f))))
drv))))
"Return as a monadic value the absolute file name of FILE within the
OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the
OUTPUT directory of PACKAGE. When TARGET is true, use it as a
-cross-compilation target triplet."
+cross-compilation target triplet.
+
+Note that this procedure does _not_ build PACKAGE. Thus, the result might or
+might not designate an existing file. We recommend not using this procedure
+unless you know what you are doing."
(lambda (store)
(define compute-derivation
(if target