monads: Add 'package->cross-derivation' and #:target for 'package-file'.

* guix/monads.scm (package-file): Add #:target keyword parameter and
  honor it.
  (package->cross-derivation): New procedure.
* tests/monads.scm ("package-file + package->cross-derivation"): New test.
* doc/guix.texi (The Store Monad): Update 'package-file' documentation.
  Add 'package->cross-derivation'.
This commit is contained in:
Ludovic Courtès 2014-08-17 20:56:47 +02:00
parent 65f88b2085
commit 4231f05bbc
3 changed files with 36 additions and 8 deletions

View file

@ -2065,15 +2065,19 @@ The example below adds a file to the store, under two different names:
@end deffn @end deffn
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @ @deffn {Monadic Procedure} package-file @var{package} [@var{file}] @
[#:system (%current-system)] [#:output "out"] Return as a monadic [#:system (%current-system)] [#:target #f] @
[#:output "out"] Return as a monadic
value in the absolute file name of @var{file} within the @var{output} value in the absolute file name of @var{file} within the @var{output}
directory of @var{package}. When @var{file} is omitted, return the name directory of @var{package}. When @var{file} is omitted, return the name
of the @var{output} directory of @var{package}. of the @var{output} directory of @var{package}. When @var{target} is
true, use it as a cross-compilation target triplet.
@end deffn @end deffn
@deffn {Monadic Procedure} package->derivation @var{package} [@var{system}] @deffn {Monadic Procedure} package->derivation @var{package} [@var{system}]
Monadic version of @code{package-derivation} (@pxref{Defining @deffnx {Monadic Procedure} package->cross-derivation @var{package} @
Packages}). @var{target} [@var{system}]
Monadic version of @code{package-derivation} and
@code{package-cross-derivation} (@pxref{Defining Packages}).
@end deffn @end deffn

View file

@ -59,6 +59,7 @@ (define-module (guix monads)
package-file package-file
origin->derivation origin->derivation
package->derivation package->derivation
package->cross-derivation
built-derivations) built-derivations)
#:replace (imported-modules #:replace (imported-modules
compiled-modules)) compiled-modules))
@ -377,13 +378,22 @@ (define* (interned-file file #:optional name
(define* (package-file package (define* (package-file package
#:optional file #:optional file
#:key (system (%current-system)) (output "out")) #:key
(system (%current-system))
(output "out") target)
"Return as a monadic value the absolute file name of FILE within the "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 FILE is omitted, return the name of the
OUTPUT directory of PACKAGE." OUTPUT directory of PACKAGE. When TARGET is true, use it as a
cross-compilation target triplet."
(lambda (store) (lambda (store)
(let* ((drv (package-derivation store package system)) (define compute-derivation
(out (derivation->output-path drv output))) (if target
(cut package-cross-derivation <> <> target <>)
package-derivation))
(let* ((system (or system (%current-system)))
(drv (compute-derivation store package system))
(out (derivation->output-path drv output)))
(if file (if file
(string-append out "/" file) (string-append out "/" file)
out)))) out))))
@ -411,6 +421,9 @@ (define derivation-expression
(define package->derivation (define package->derivation
(store-lift package-derivation)) (store-lift package-derivation))
(define package->cross-derivation
(store-lift package-cross-derivation))
(define origin->derivation (define origin->derivation
(store-lift package-source-derivation)) (store-lift package-source-derivation))

View file

@ -24,6 +24,7 @@ (define-module (test-monads)
#:select (package-derivation %current-system)) #:select (package-derivation %current-system))
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module ((gnu packages base) #:select (coreutils))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -108,6 +109,16 @@ (define (g x)
guile))) guile)))
#:guile-for-build (package-derivation %store %bootstrap-guile))) #:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "package-file + package->cross-derivation"
(run-with-store %store
(mlet* %store-monad ((file (package-file coreutils "bin/ls"
#:target "foo64-gnu"))
(xcu (package->cross-derivation coreutils
"foo64-gnu")))
(let ((output (derivation->output-path xcu)))
(return (string=? file (string-append output "/bin/ls")))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "interned-file" (test-assert "interned-file"
(run-with-store %store (run-with-store %store
(mlet* %store-monad ((file -> (search-path %load-path "guix.scm")) (mlet* %store-monad ((file -> (search-path %load-path "guix.scm"))