gnu: ikiwiki: Add missing input.
[jackhill/guix/guix.git] / guix / packages.scm
index 1ae16b6..3fff50a 100644 (file)
             package-output
             package-grafts
             package-patched-vulnerabilities
+            package-with-patches
+            package-with-extra-patches
             package/inherit
 
             transitive-input-references
@@ -363,12 +365,12 @@ object."
                 (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))))
                (_
@@ -444,9 +446,9 @@ derivations."
   (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)))
@@ -656,6 +658,18 @@ specifies modules in scope when evaluating SNIPPET."
                         #: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
@@ -800,11 +814,13 @@ dependencies are known to build on SYSTEM."
 
 (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."
@@ -813,7 +829,8 @@ dependencies are known to build on SYSTEM."
 
 (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
@@ -1031,39 +1048,39 @@ information in exceptions."
                        #: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
@@ -1271,7 +1288,7 @@ This is an internal procedure."
                   (()
                    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'
@@ -1297,7 +1314,7 @@ system identifying string)."
                    (graft-derivation store drv grafts
                                      #:system system
                                      #:guile
-                                     (package-derivation store (guile-2.0)
+                                     (package-derivation store (guile-for-grafts)
                                                          system #:graft? #f))))
                 drv))))
 
@@ -1328,7 +1345,11 @@ code of derivations to GUILE, a package object."
   "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