~ruther/guix-local

ac5de156ae5de8cb61870469863fb862b6a1205e — Ludovic Courtès 12 years ago e900c50
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'.
4 files changed, 50 insertions(+), 28 deletions(-)

M doc/guix.texi
M guix/scripts/build.scm
M guix/ui.scm
M tests/guix-build.sh
M doc/guix.texi => doc/guix.texi +5 -1
@@ 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

M guix/scripts/build.scm => guix/scripts/build.scm +19 -14
@@ 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))

M guix/ui.scm => guix/ui.scm +18 -13
@@ 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))

M tests/guix-build.sh => tests/guix-build.sh +8 -0
@@ 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