guix build: '-e' can be passed a monadic thunk.

* guix/ui.scm (read/eval): New procedure.
  (read/eval-package-expression): Use it.
* guix/scripts/build.scm (derivations-from-package-expressions): Rename to...
  (derivation-from-expression): ... this.  Accept procedures, under the
  assumption that they are monadic thunk.
  (show-help): Adjust accordingly.
  (guix-build): Ditto.
* tests/guix-build.sh: Add test.
* doc/guix.texi (Invoking guix build): Augment description of '-e'.
master
Ludovic Courtès 2013-11-18 23:08:20 +01:00
parent e900c5031f
commit ac5de156ae
4 changed files with 50 additions and 28 deletions

View File

@ -1483,12 +1483,16 @@ The @var{options} may be zero or more of the following:
@item --expression=@var{expr}
@itemx -e @var{expr}
Build the package @var{expr} evaluates to.
Build the package or derivation @var{expr} evaluates to.
For example, @var{expr} may be @code{(@@ (gnu packages guile)
guile-1.8)}, which unambiguously designates this specific variant of
version 1.8 of Guile.
Alternately, @var{expr} may refer to a zero-argument monadic procedure
(@pxref{The Store Monad}). The procedure must return a derivation as a
monadic value, which is then passed through @code{run-with-store}.
@item --source
@itemx -S
Build the packages' source derivations, rather than the packages

View File

@ -23,6 +23,7 @@
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
@ -38,19 +39,23 @@
(define %store
(make-parameter #f))
(define (derivations-from-package-expressions str package-derivation
system source?)
(define (derivation-from-expression str package-derivation
system source?)
"Read/eval STR and return the corresponding derivation path for SYSTEM.
When SOURCE? is true, return the derivations of the package sources;
otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
(let ((p (read/eval-package-expression str)))
(if source?
(let ((source (package-source p)))
(if source
(package-source-derivation (%store) source)
(leave (_ "package `~a' has no source~%")
(package-name p))))
(package-derivation (%store) p system))))
When SOURCE? is true and STR evaluates to a package, return the derivation of
the package source; otherwise, use PACKAGE-DERIVATION to compute the
derivation of a package."
(match (read/eval str)
((? package? p)
(if source?
(let ((source (package-source p)))
(if source
(package-source-derivation (%store) source)
(leave (_ "package `~a' has no source~%")
(package-name p))))
(package-derivation (%store) p system)))
((? procedure? proc)
(run-with-store (%store) (proc) #:system system))))
;;;
@ -68,7 +73,7 @@ otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
(display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ "
-e, --expression=EXPR build the package EXPR evaluates to"))
-e, --expression=EXPR build the package or derivation EXPR evaluates to"))
(display (_ "
-S, --source build the packages' source derivations"))
(display (_ "
@ -255,7 +260,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(sys (assoc-ref opts 'system))
(drv (filter-map (match-lambda
(('expression . str)
(derivations-from-package-expressions
(derivation-from-expression
str package->derivation sys src?))
(('argument . (? derivation-path? drv))
(call-with-input-file drv read-derivation))

View File

@ -45,6 +45,7 @@
show-what-to-build
call-with-error-handling
with-error-handling
read/eval
read/eval-package-expression
location->string
switch-symlinks
@ -193,25 +194,29 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(leave (_ "~a~%")
(strerror (system-error-errno args)))))))
(define (read/eval-package-expression str)
"Read and evaluate STR and return the package it refers to, or exit an
error."
(define (read/eval str)
"Read and evaluate STR, raising an error if something goes wrong."
(let ((exp (catch #t
(lambda ()
(call-with-input-string str read))
(lambda args
(leave (_ "failed to read expression ~s: ~s~%")
str args)))))
(let ((p (catch #t
(lambda ()
(eval exp the-scm-module))
(lambda args
(leave (_ "failed to evaluate expression `~a': ~s~%")
exp args)))))
(if (package? p)
p
(leave (_ "expression `~s' does not evaluate to a package~%")
exp)))))
(catch #t
(lambda ()
(eval exp the-scm-module))
(lambda args
(leave (_ "failed to evaluate expression `~a': ~s~%")
exp args)))))
(define (read/eval-package-expression str)
"Read and evaluate STR and return the package it refers to, or exit an
error."
(match (read/eval str)
((? package? p) p)
(_
(leave (_ "expression ~s does not evaluate to a package~%")
str))))
(define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t))

View File

@ -72,3 +72,11 @@ if guix build -n time-3.2; # FAIL, version not found
then false; else true; fi
if guix build -n something-that-will-never-exist; # FAIL
then false; else true; fi
# Invoking a monadic procedure.
guix build -e "(begin
(use-modules (guix monads) (guix utils))
(lambda ()
(derivation-expression \"test\" (%current-system)
'(mkdir %output) '())))" \
--dry-run