mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
parent
e900c5031f
commit
ac5de156ae
4 changed files with 50 additions and 28 deletions
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
31
guix/ui.scm
31
guix/ui.scm
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue