From ac5de156ae5de8cb61870469863fb862b6a1205e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 18 Nov 2013 23:08:20 +0100 Subject: [PATCH] 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'. --- doc/guix.texi | 6 +++++- guix/scripts/build.scm | 33 +++++++++++++++++++-------------- guix/ui.scm | 31 ++++++++++++++++++------------- tests/guix-build.sh | 8 ++++++++ 4 files changed, 50 insertions(+), 28 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index cfa5aac326..847c73ab8c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index f63736c09c..dd9a9b8127 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -23,6 +23,7 @@ (define-module (guix scripts build) #: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-module (guix scripts build) (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 @@ (define (show-help) (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 @@ (define package->derivation (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)) diff --git a/guix/ui.scm b/guix/ui.scm index 8a28574c3c..f15419f7a8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -45,6 +45,7 @@ (define-module (guix ui) 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 @@ (define (call-with-error-handling thunk) (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)) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index e228b38616..391e7b9da3 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -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