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'.
This commit is contained in:
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} @item --expression=@var{expr}
@itemx -e @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) For example, @var{expr} may be @code{(@@ (gnu packages guile)
guile-1.8)}, which unambiguously designates this specific variant of guile-1.8)}, which unambiguously designates this specific variant of
version 1.8 of Guile. 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 @item --source
@itemx -S @itemx -S
Build the packages' source derivations, rather than the packages Build the packages' source derivations, rather than the packages

View file

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

View file

@ -45,6 +45,7 @@ (define-module (guix ui)
show-what-to-build show-what-to-build
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
read/eval
read/eval-package-expression read/eval-package-expression
location->string location->string
switch-symlinks switch-symlinks
@ -193,25 +194,29 @@ (define (call-with-error-handling thunk)
(leave (_ "~a~%") (leave (_ "~a~%")
(strerror (system-error-errno args))))))) (strerror (system-error-errno args)))))))
(define (read/eval-package-expression str) (define (read/eval str)
"Read and evaluate STR and return the package it refers to, or exit an "Read and evaluate STR, raising an error if something goes wrong."
error."
(let ((exp (catch #t (let ((exp (catch #t
(lambda () (lambda ()
(call-with-input-string str read)) (call-with-input-string str read))
(lambda args (lambda args
(leave (_ "failed to read expression ~s: ~s~%") (leave (_ "failed to read expression ~s: ~s~%")
str args))))) str args)))))
(let ((p (catch #t (catch #t
(lambda () (lambda ()
(eval exp the-scm-module)) (eval exp the-scm-module))
(lambda args (lambda args
(leave (_ "failed to evaluate expression `~a': ~s~%") (leave (_ "failed to evaluate expression `~a': ~s~%")
exp args))))) exp args)))))
(if (package? p)
p (define (read/eval-package-expression str)
(leave (_ "expression `~s' does not evaluate to a package~%") "Read and evaluate STR and return the package it refers to, or exit an
exp))))) 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 (define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t)) #: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 then false; else true; fi
if guix build -n something-that-will-never-exist; # FAIL if guix build -n something-that-will-never-exist; # FAIL
then false; else true; fi 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