guix/packages.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix packages)
  20   #:use-module (guix utils)
  21   #:use-module (guix records)
  22   #:use-module (guix store)
  23   #:use-module (guix base32)
  24   #:use-module (guix derivations)
  25   #:use-module (guix build-system)
  26   #:use-module (ice-9 match)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-9 gnu)
  29   #:use-module (srfi srfi-26)
  30   #:use-module (srfi srfi-34)
  31   #:use-module (srfi srfi-35)
  32   #:re-export (%current-system
  33                %current-target-system)
  34   #:export (origin
  35             origin?
  36             origin-uri
  37             origin-method
  38             origin-sha256
  39             origin-file-name
  40             origin-patches
  41             origin-patch-flags
  42             origin-patch-inputs
  43             origin-patch-guile
  44             origin-snippet
  45             origin-modules
  46             origin-imported-modules
  47             base32
  48
  49             <search-path-specification>
  50             search-path-specification
  51             search-path-specification?
  52             search-path-specification->sexp
  53
  54             package
  55             package?
  56             package-name
  57             package-version
  58             package-full-name
  59             package-source
  60             package-build-system
  61             package-arguments
  62             package-inputs
  63             package-native-inputs
  64             package-propagated-inputs
  65             package-outputs
  66             package-native-search-paths
  67             package-search-paths
  68             package-synopsis
  69             package-description
  70             package-license
  71             package-home-page
  72             package-platforms
  73             package-maintainers
  74             package-properties
  75             package-location
  76             package-field-location
  77
  78             package-direct-inputs
  79             package-transitive-inputs
  80             package-transitive-target-inputs
  81             package-transitive-native-inputs
  82             package-transitive-propagated-inputs
  83             package-source-derivation
  84             package-derivation
  85             package-cross-derivation
  86             package-output
  87
  88             &package-error
  89             package-error?
  90             package-error-package
  91             &package-input-error
  92             package-input-error?
  93             package-error-invalid-input
  94             &package-cross-build-system-error
  95             package-cross-build-system-error?
  96
  97             package->bag
  98             bag-transitive-inputs
  99             bag-transitive-host-inputs
 100             bag-transitive-build-inputs
 101             bag-transitive-target-inputs))
 102
 103 ;;; Commentary:
 104 ;;;
 105 ;;; This module provides a high-level mechanism to define packages in a
 106 ;;; Guix-based distribution.
 107 ;;;
 108 ;;; Code:
 109
 110 ;; The source of a package, such as a tarball URL and fetcher---called
 111 ;; "origin" to avoid name clash with `package-source', `source', etc.
 112 (define-record-type* <origin>
 113   origin make-origin
 114   origin?
 115   (uri       origin-uri)                          ; string
 116   (method    origin-method)                       ; procedure
 117   (sha256    origin-sha256)                       ; bytevector
 118   (file-name origin-file-name (default #f))       ; optional file name
 119   (patches   origin-patches (default '()))        ; list of file names
 120   (snippet   origin-snippet (default #f))         ; sexp or #f
 121   (patch-flags  origin-patch-flags                ; list of strings
 122                 (default '("-p1")))
 123
 124   ;; Patching requires Guile, GNU Patch, and a few more.  These two fields are
 125   ;; used to specify these dependencies when needed.
 126   (patch-inputs origin-patch-inputs               ; input list or #f
 127                 (default #f))
 128   (modules      origin-modules                    ; list of module names
 129                 (default '()))
 130   (imported-modules origin-imported-modules       ; list of module names
 131                     (default '()))
 132   (patch-guile origin-patch-guile                 ; package or #f
 133                (default #f)))
 134
 135 (define (print-origin origin port)
 136   "Write a concise representation of ORIGIN to PORT."
 137   (match origin
 138     (($ <origin> uri method sha256 file-name patches)
 139      (simple-format port "#<origin ~s ~a ~s ~a>"
 140                     uri (bytevector->base32-string sha256)
 141                     patches
 142                     (number->string (object-address origin) 16)))))
 143
 144 (set-record-type-printer! <origin> print-origin)
 145
 146 (define-syntax base32
 147   (lambda (s)
 148     "Return the bytevector corresponding to the given Nix-base32
 149 representation."
 150     (syntax-case s ()
 151       ((_ str)
 152        (string? (syntax->datum #'str))
 153        ;; A literal string: do the conversion at expansion time.
 154        (with-syntax ((bv (nix-base32-string->bytevector
 155                           (syntax->datum #'str))))
 156          #''bv))
 157       ((_ str)
 158        #'(nix-base32-string->bytevector str)))))
 159
 160 ;; The specification of a search path.
 161 (define-record-type* <search-path-specification>
 162   search-path-specification make-search-path-specification
 163   search-path-specification?
 164   (variable     search-path-specification-variable)
 165   (directories  search-path-specification-directories)
 166   (separator    search-path-specification-separator (default ":")))
 167
 168 (define (search-path-specification->sexp spec)
 169   "Return an sexp representing SPEC, a <search-path-specification>.  The sexp
 170 corresponds to the arguments expected by `set-path-environment-variable'."
 171   (match spec
 172     (($ <search-path-specification> variable directories separator)
 173      `(,variable ,directories ,separator))))
 174
 175 ;; A package.
 176 (define-record-type* <package>
 177   package make-package
 178   package?
 179   (name   package-name)                   ; string
 180   (version package-version)               ; string
 181   (source package-source)                 ; <origin> instance
 182   (build-system package-build-system)     ; build system
 183   (arguments package-arguments            ; arguments for the build method
 184              (default '()) (thunked))
 185
 186   (inputs package-inputs                  ; input packages or derivations
 187           (default '()) (thunked))
 188   (propagated-inputs package-propagated-inputs    ; same, but propagated
 189                      (default '()) (thunked))
 190   (native-inputs package-native-inputs    ; native input packages/derivations
 191                  (default '()) (thunked))
 192   (self-native-input? package-self-native-input?  ; whether to use itself as
 193                                                   ; a native input when cross-
 194                       (default #f))               ; compiling
 195
 196   (outputs package-outputs                ; list of strings
 197            (default '("out")))
 198
 199                                                   ; lists of
 200                                                   ; <search-path-specification>,
 201                                                   ; for native and cross
 202                                                   ; inputs
 203   (native-search-paths package-native-search-paths (default '()))
 204   (search-paths package-search-paths (default '()))
 205
 206   (synopsis package-synopsis)                    ; one-line description
 207   (description package-description)              ; one or two paragraphs
 208   (license package-license)
 209   (home-page package-home-page)
 210   (platforms package-platforms (default '()))
 211   (maintainers package-maintainers (default '()))
 212
 213   (properties package-properties (default '()))   ; alist for anything else
 214
 215   (location package-location
 216             (default (and=> (current-source-location)
 217                             source-properties->location))))
 218
 219 (set-record-type-printer! <package>
 220                           (lambda (package port)
 221                             (let ((loc    (package-location package))
 222                                   (format simple-format))
 223                               (format port "#<package ~a-~a ~a:~a ~a>"
 224                                       (package-name package)
 225                                       (package-version package)
 226                                       (location-file loc)
 227                                       (location-line loc)
 228                                       (number->string (object-address
 229                                                        package)
 230                                                       16)))))
 231
 232 (define (package-field-location package field)
 233   "Return the source code location of the definition of FIELD for PACKAGE, or
 234 #f if it could not be determined."
 235   (define (goto port line column)
 236     (unless (and (= (port-column port) (- column 1))
 237                  (= (port-line port) (- line 1)))
 238       (unless (eof-object? (read-char port))
 239         (goto port line column))))
 240
 241   (match (package-location package)
 242     (($ <location> file line column)
 243      (catch 'system
 244        (lambda ()
 245          ;; In general we want to keep relative file names for modules.
 246          (with-fluids ((%file-port-name-canonicalization 'relative))
 247            (call-with-input-file (search-path %load-path file)
 248              (lambda (port)
 249                (goto port line column)
 250                (match (read port)
 251                  (('package inits ...)
 252                   (let ((field (assoc field inits)))
 253                     (match field
 254                       ((_ value)
 255                        ;; Put the `or' here, and not in the first argument of
 256                        ;; `and=>', to work around a compiler bug in 2.0.5.
 257                        (or (and=> (source-properties value)
 258                                   source-properties->location)
 259                            (and=> (source-properties field)
 260                                   source-properties->location)))
 261                       (_
 262                        #f))))
 263                  (_
 264                   #f))))))
 265        (lambda _
 266          #f)))
 267     (_ #f)))
 268
 269
 270 ;; Error conditions.
 271
 272 (define-condition-type &package-error &error
 273   package-error?
 274   (package package-error-package))
 275
 276 (define-condition-type &package-input-error &package-error
 277   package-input-error?
 278   (input package-error-invalid-input))
 279
 280 (define-condition-type &package-cross-build-system-error &package-error
 281   package-cross-build-system-error?)
 282
 283
 284 (define (package-full-name package)
 285   "Return the full name of PACKAGE--i.e., `NAME-VERSION'."
 286   (string-append (package-name package) "-" (package-version package)))
 287
 288 (define (%standard-patch-inputs)
 289   (let ((ref (lambda (module var)
 290                (module-ref (resolve-interface module) var))))
 291     `(("tar"   ,(ref '(gnu packages base) 'tar))
 292       ("xz"    ,(ref '(gnu packages compression) 'xz))
 293       ("bzip2" ,(ref '(gnu packages compression) 'bzip2))
 294       ("gzip"  ,(ref '(gnu packages compression) 'gzip))
 295       ("lzip"  ,(ref '(gnu packages compression) 'lzip))
 296       ("patch" ,(ref '(gnu packages base) 'patch)))))
 297
 298 (define (default-guile)
 299   "Return the default Guile package for SYSTEM."
 300   (let ((distro (resolve-interface '(gnu packages commencement))))
 301     (module-ref distro 'guile-final)))
 302
 303 (define* (patch-and-repack store source patches
 304                            #:key
 305                            (inputs '())
 306                            (snippet #f)
 307                            (flags '("-p1"))
 308                            (modules '())
 309                            (imported-modules '())
 310                            (guile-for-build (%guile-for-build))
 311                            (system (%current-system)))
 312   "Unpack SOURCE (a derivation or store path), apply all of PATCHES, and
 313 repack the tarball using the tools listed in INPUTS.  When SNIPPET is true,
 314 it must be an s-expression that will run from within the directory where
 315 SOURCE was unpacked, after all of PATCHES have been applied.  MODULES and
 316 IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
 317   (define source-file-name
 318     ;; SOURCE is usually a derivation, but it could be a store file.
 319     (if (derivation? source)
 320         (derivation->output-path source)
 321         source))
 322
 323   (define decompression-type
 324     (cond ((string-suffix? "gz" source-file-name)  "gzip")
 325           ((string-suffix? "bz2" source-file-name) "bzip2")
 326           ((string-suffix? "lz" source-file-name)  "lzip")
 327           (else "xz")))
 328
 329   (define original-file-name
 330     ;; Remove the store prefix plus the slash, hash, and hyphen.
 331     (let* ((sans (string-drop source-file-name
 332                               (+ (string-length (%store-prefix)) 1)))
 333            (dash (string-index sans #\-)))
 334       (string-drop sans (+ 1 dash))))
 335
 336   (define (numeric-extension? file-name)
 337     ;; Return true if FILE-NAME ends with digits.
 338     (and=> (file-extension file-name)
 339            (cut string-every char-set:hex-digit <>)))
 340
 341   (define (tarxz-name file-name)
 342     ;; Return a '.tar.xz' file name based on FILE-NAME.
 343     (let ((base (if (numeric-extension? file-name)
 344                     original-file-name
 345                     (file-sans-extension file-name))))
 346       (string-append base
 347                      (if (equal? (file-extension base) "tar")
 348                          ".xz"
 349                          ".tar.xz"))))
 350
 351   (define patch-inputs
 352     (map (lambda (number patch)
 353            (list (string-append "patch" (number->string number))
 354                  (match patch
 355                    ((? string?)
 356                     (add-to-store store (basename patch) #t
 357                                   "sha256" patch))
 358                    ((? origin?)
 359                     (package-source-derivation store patch)))))
 360          (iota (length patches))
 361
 362          patches))
 363
 364   (define builder
 365     `(begin
 366        (use-modules (ice-9 ftw)
 367                     (srfi srfi-1)
 368                     (guix build utils))
 369
 370        (let ((out     (assoc-ref %outputs "out"))
 371              (xz      (assoc-ref %build-inputs "xz"))
 372              (decomp  (assoc-ref %build-inputs ,decompression-type))
 373              (source  (assoc-ref %build-inputs "source"))
 374              (tar     (string-append (assoc-ref %build-inputs "tar")
 375                                      "/bin/tar"))
 376              (patch   (string-append (assoc-ref %build-inputs "patch")
 377                                      "/bin/patch")))
 378          (define (apply-patch input)
 379            (let ((patch* (assoc-ref %build-inputs input)))
 380              (format (current-error-port) "applying '~a'...~%" patch*)
 381              (zero? (system* patch "--batch" ,@flags "--input" patch*))))
 382
 383          (define (first-file directory)
 384            ;; Return the name of the first file in DIRECTORY.
 385            (car (scandir directory
 386                          (lambda (name)
 387                            (not (member name '("." "..")))))))
 388
 389          (setenv "PATH" (string-append xz "/bin" ":"
 390                                        decomp "/bin"))
 391
 392          ;; SOURCE may be either a directory or a tarball.
 393          (and (if (file-is-directory? source)
 394                   (let* ((store     (or (getenv "NIX_STORE") "/gnu/store"))
 395                          (len       (+ 1 (string-length store)))
 396                          (base      (string-drop source len))
 397                          (dash      (string-index base #\-))
 398                          (directory (string-drop base (+ 1 dash))))
 399                     (mkdir directory)
 400                     (copy-recursively source directory)
 401                     #t)
 402                   (zero? (system* tar "xvf" source)))
 403               (let ((directory (first-file ".")))
 404                 (format (current-error-port)
 405                         "source is under '~a'~%" directory)
 406                 (chdir directory)
 407
 408                 (and (every apply-patch ',(map car patch-inputs))
 409
 410                      ,@(if snippet
 411                            `((let ((module (make-fresh-user-module)))
 412                                (module-use-interfaces! module
 413                                                        (map resolve-interface
 414                                                             ',modules))
 415                                (module-define! module '%build-inputs
 416                                                %build-inputs)
 417                                (module-define! module '%outputs %outputs)
 418                                ((@ (system base compile) compile)
 419                                 ',snippet
 420                                 #:to 'value
 421                                 #:opts %auto-compilation-options
 422                                 #:env module)))
 423                            '())
 424
 425                      (begin (chdir "..") #t)
 426                      (zero? (system* tar "cvfa" out directory))))))))
 427
 428
 429   (let ((name    (tarxz-name original-file-name))
 430         (inputs  (filter-map (match-lambda
 431                               ((name (? package? p))
 432                                (and (member name (cons decompression-type
 433                                                        '("tar" "xz" "patch")))
 434                                     (list name
 435                                           (package-derivation store p
 436                                                               system)))))
 437                              (or inputs (%standard-patch-inputs))))
 438         (modules (delete-duplicates (cons '(guix build utils) modules))))
 439
 440     (build-expression->derivation store name builder
 441                                  #:inputs `(("source" ,source)
 442                                             ,@inputs
 443                                             ,@patch-inputs)
 444                                  #:system system
 445                                  #:modules modules
 446                                  #:guile-for-build guile-for-build)))
 447
 448 (define* (package-source-derivation store source
 449                                     #:optional (system (%current-system)))
 450   "Return the derivation path for SOURCE, a package source, for SYSTEM."
 451   (match source
 452     (($ <origin> uri method sha256 name () #f)
 453      ;; No patches, no snippet: this is a fixed-output derivation.
 454      (method store uri 'sha256 sha256 name
 455              #:system system))
 456     (($ <origin> uri method sha256 name (patches ...) snippet
 457         (flags ...) inputs (modules ...) (imported-modules ...)
 458         guile-for-build)
 459      ;; Patches and/or a snippet.
 460      (let ((source (method store uri 'sha256 sha256 name
 461                            #:system system))
 462            (guile  (match (or guile-for-build (%guile-for-build)
 463                               (default-guile))
 464                      ((? package? p)
 465                       (package-derivation store p system))
 466                      ((? derivation? drv)
 467                       drv))))
 468        (patch-and-repack store source patches
 469                          #:inputs inputs
 470                          #:snippet snippet
 471                          #:flags flags
 472                          #:system system
 473                          #:modules modules
 474                          #:imported-modules modules
 475                          #:guile-for-build guile)))
 476     ((and (? string?) (? direct-store-path?) file)
 477      file)
 478     ((? string? file)
 479      (add-to-store store (basename file) #t "sha256" file))))
 480
 481 (define (transitive-inputs inputs)
 482   (let loop ((inputs  inputs)
 483              (result '()))
 484     (match inputs
 485       (()
 486        (delete-duplicates (reverse result)))      ; XXX: efficiency
 487       (((and i (name (? package? p) sub ...)) rest ...)
 488        (let ((t (map (match-lambda
 489                       ((dep-name derivation ...)
 490                        (cons (string-append name "/" dep-name)
 491                              derivation)))
 492                      (package-propagated-inputs p))))
 493          (loop (append t rest)
 494                (append t (cons i result)))))
 495       ((input rest ...)
 496        (loop rest (cons input result))))))
 497
 498 (define (package-direct-inputs package)
 499   "Return all the direct inputs of PACKAGE---i.e, its direct inputs along
 500 with their propagated inputs."
 501   (append (package-native-inputs package)
 502           (package-inputs package)
 503           (package-propagated-inputs package)))
 504
 505 (define (package-transitive-inputs package)
 506   "Return the transitive inputs of PACKAGE---i.e., its direct inputs along
 507 with their propagated inputs, recursively."
 508   (transitive-inputs (package-direct-inputs package)))
 509
 510 (define (package-transitive-target-inputs package)
 511   "Return the transitive target inputs of PACKAGE---i.e., its direct inputs
 512 along with their propagated inputs, recursively.  This only includes inputs
 513 for the target system, and not native inputs."
 514   (transitive-inputs (append (package-inputs package)
 515                              (package-propagated-inputs package))))
 516
 517 (define (package-transitive-native-inputs package)
 518   "Return the transitive native inputs of PACKAGE---i.e., its direct inputs
 519 along with their propagated inputs, recursively.  This only includes inputs
 520 for the host system (\"native inputs\"), and not target inputs."
 521   (transitive-inputs (package-native-inputs package)))
 522
 523 (define (package-transitive-propagated-inputs package)
 524   "Return the propagated inputs of PACKAGE, and their propagated inputs,
 525 recursively."
 526   (transitive-inputs (package-propagated-inputs package)))
 527
 528 (define (bag-transitive-inputs bag)
 529   "Same as 'package-transitive-inputs', but applied to a bag."
 530   (transitive-inputs (append (bag-build-inputs bag)
 531                              (bag-host-inputs bag)
 532                              (bag-target-inputs bag))))
 533
 534 (define (bag-transitive-build-inputs bag)
 535   "Same as 'package-transitive-native-inputs', but applied to a bag."
 536   (transitive-inputs (bag-build-inputs bag)))
 537
 538 (define (bag-transitive-host-inputs bag)
 539   "Same as 'package-transitive-target-inputs', but applied to a bag."
 540   (transitive-inputs (bag-host-inputs bag)))
 541
 542 (define (bag-transitive-target-inputs bag)
 543   "Return the \"target inputs\" of BAG, recursively."
 544   (transitive-inputs (bag-target-inputs bag)))
 545
 546 \f
 547 ;;;
 548 ;;; Package derivations.
 549 ;;;
 550
 551 (define %derivation-cache
 552   ;; Package to derivation-path mapping.
 553   (make-weak-key-hash-table 100))
 554
 555 (define (cache package system thunk)
 556   "Memoize the return values of THUNK as the derivation of PACKAGE on
 557 SYSTEM."
 558   ;; FIXME: This memoization should be associated with the open store, because
 559   ;; otherwise it breaks when switching to a different store.
 560   (let ((vals (call-with-values thunk list)))
 561     ;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
 562     ;; same value for all structs (as of Guile 2.0.6), and because pointer
 563     ;; equality is sufficient in practice.
 564     (hashq-set! %derivation-cache package `((,system ,@vals)))
 565     (apply values vals)))
 566
 567 (define-syntax-rule (cached package system body ...)
 568   "Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
 569 Return the cached result when available."
 570   (let ((thunk (lambda () body ...)))
 571     (match (hashq-ref %derivation-cache package)
 572       ((alist (... ...))
 573        (match (assoc-ref alist system)
 574          ((vals (... ...))
 575           (apply values vals))
 576          (#f
 577           (cache package system thunk))))
 578       (#f
 579        (cache package system thunk)))))
 580
 581 (define* (expand-input store package input system #:optional cross-system)
 582   "Expand INPUT, an input tuple, such that it contains only references to
 583 derivation paths or store paths.  PACKAGE is only used to provide contextual
 584 information in exceptions."
 585   (define (intern file)
 586     ;; Add FILE to the store.  Set the `recursive?' bit to #t, so that
 587     ;; file permissions are preserved.
 588     (add-to-store store (basename file) #t "sha256" file))
 589
 590   (define derivation
 591     (if cross-system
 592         (cut package-cross-derivation store <> cross-system system)
 593         (cut package-derivation store <> system)))
 594
 595   (match input
 596     (((? string? name) (? package? package))
 597      (list name (derivation package)))
 598     (((? string? name) (? package? package)
 599       (? string? sub-drv))
 600      (list name (derivation package)
 601            sub-drv))
 602     (((? string? name)
 603       (and (? string?) (? derivation-path?) drv))
 604      (list name drv))
 605     (((? string? name)
 606       (and (? string?) (? file-exists? file)))
 607      ;; Add FILE to the store.  When FILE is in the sub-directory of a
 608      ;; store path, it needs to be added anyway, so it can be used as a
 609      ;; source.
 610      (list name (intern file)))
 611     (((? string? name) (? origin? source))
 612      (list name (package-source-derivation store source system)))
 613     (x
 614      (raise (condition (&package-input-error
 615                         (package package)
 616                         (input   x)))))))
 617
 618 (define* (package->bag package #:optional
 619                        (system (%current-system))
 620                        (target (%current-target-system)))
 621   "Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
 622 and return it."
 623   ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked field
 624   ;; values can refer to it.
 625   (parameterize ((%current-system system)
 626                  (%current-target-system target))
 627     (match package
 628       (($ <package> name version source build-system
 629                     args inputs propagated-inputs native-inputs self-native-input?
 630                     outputs)
 631        (or (make-bag build-system (package-full-name package)
 632                      #:target target
 633                      #:source source
 634                      #:inputs (append (inputs)
 635                                       (propagated-inputs))
 636                      #:outputs outputs
 637                      #:native-inputs `(,@(if (and target self-native-input?)
 638                                              `(("self" ,package))
 639                                              '())
 640                                        ,@(native-inputs))
 641                      #:arguments (args))
 642            (raise (if target
 643                       (condition
 644                        (&package-cross-build-system-error
 645                         (package package)))
 646                       (condition
 647                        (&package-error
 648                         (package package))))))))))
 649
 650 (define* (package-derivation store package
 651                              #:optional (system (%current-system)))
 652   "Return the <derivation> object of PACKAGE for SYSTEM."
 653
 654   ;; Compute the derivation and cache the result.  Caching is important
 655   ;; because some derivations, such as the implicit inputs of the GNU build
 656   ;; system, will be queried many, many times in a row.
 657   (cached package system
 658           (let* ((bag        (package->bag package system #f))
 659                  (inputs     (bag-transitive-inputs bag))
 660                  (input-drvs (map (cut expand-input
 661                                        store package <> system)
 662                                   inputs))
 663                  (paths      (delete-duplicates
 664                               (append-map (match-lambda
 665                                            ((_ (? package? p) _ ...)
 666                                             (package-native-search-paths
 667                                              p))
 668                                            (_ '()))
 669                                           inputs))))
 670
 671             (apply (bag-build bag)
 672                    store (bag-name bag)
 673                    input-drvs
 674                    #:search-paths paths
 675                    #:outputs (bag-outputs bag) #:system system
 676                    (bag-arguments bag)))))
 677
 678 (define* (package-cross-derivation store package target
 679                                    #:optional (system (%current-system)))
 680   "Cross-build PACKAGE for TARGET (a GNU triplet) from host SYSTEM (a Guix
 681 system identifying string)."
 682   (cached package (cons system target)
 683           (let* ((bag         (package->bag package system target))
 684                  (host        (bag-transitive-host-inputs bag))
 685                  (host-drvs   (map (cut expand-input
 686                                         store package <>
 687                                         system target)
 688                                    host))
 689                  (target*     (bag-transitive-target-inputs bag))
 690                  (target-drvs (map (cut expand-input
 691                                         store package <> system)
 692                                    target*))
 693                  (build       (bag-transitive-build-inputs bag))
 694                  (build-drvs  (map (cut expand-input
 695                                         store package <> system)
 696                                    build))
 697                  (all         (append build target* host))
 698                  (paths       (delete-duplicates
 699                                (append-map (match-lambda
 700                                             ((_ (? package? p) _ ...)
 701                                              (package-search-paths p))
 702                                             (_ '()))
 703                                            all)))
 704                  (npaths      (delete-duplicates
 705                                (append-map (match-lambda
 706                                             ((_ (? package? p) _ ...)
 707                                              (package-native-search-paths
 708                                               p))
 709                                             (_ '()))
 710                                            all))))
 711
 712             (apply (bag-build bag)
 713                    store (bag-name bag)
 714                    #:native-drvs build-drvs
 715                    #:target-drvs (append host-drvs target-drvs)
 716                    #:search-paths paths
 717                    #:native-search-paths npaths
 718                    #:outputs (bag-outputs bag)
 719                    #:system system #:target target
 720                    (bag-arguments bag)))))
 721
 722 (define* (package-output store package
 723                          #:optional (output "out") (system (%current-system)))
 724   "Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the
 725 symbolic output name, such as \"out\".  Note that this procedure calls
 726 `package-derivation', which is costly."
 727   (let ((drv (package-derivation store package system)))
 728     (derivation->output-path drv output)))