From 257b93412ad52dc26b53e0dae71a79b9b51ab33f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 13 Mar 2014 19:21:49 +0100
Subject: [PATCH] guix build: Support '--with-source' along with '-e'.

* guix/scripts/build.scm (derivation-from-expression): Remove.
  (options->derivations): Handle pairs of the form
  "('argument . (? derivation?))".
  (options/resolve-packages): Add 'store' parameter; update caller.  Add
  'system' variable.  Add case for 'expression pairs.
* guix/scripts/archive.scm (derivation-from-expression): New procedure.
---
 guix/scripts/archive.scm | 19 +++++++++++++++++++
 guix/scripts/build.scm   | 41 +++++++++++++++-------------------------
 2 files changed, 34 insertions(+), 26 deletions(-)

diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 8280a821c5..0ab7686585 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -23,6 +23,7 @@ (define-module (guix scripts archive)
   #:use-module (guix store)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (guix monads)
   #:use-module (guix ui)
   #:use-module (guix pki)
   #:use-module (guix pk-crypto)
@@ -143,6 +144,24 @@ (define %options
 
          %standard-build-options))
 
+(define (derivation-from-expression store str package-derivation
+                                    system source?)
+  "Read/eval STR and return the corresponding derivation path for 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))))
+
 (define (options->derivations+files store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
 build and a list of store files to transfer."
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 8f6ba192c2..35b10a0ec2 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -34,32 +34,12 @@ (define-module (guix scripts build)
   #:use-module (srfi srfi-37)
   #:autoload   (gnu packages) (find-best-packages-by-name)
   #:autoload   (guix download) (download-to-store)
-  #:export (derivation-from-expression
-
-            %standard-build-options
+  #:export (%standard-build-options
             set-build-options-from-command-line
             show-build-options-help
 
             guix-build))
 
-(define (derivation-from-expression store str package-derivation
-                                    system source?)
-  "Read/eval STR and return the corresponding derivation path for 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))))
-
 (define (specification->package spec)
   "Return a package matching SPEC.  SPEC may be a package name, or a package
 name followed by a hyphen and a version number.  If the version number is not
@@ -322,16 +302,15 @@ (define src? (assoc-ref opts 'source?))
   (define sys  (assoc-ref opts 'system))
 
   (let ((opts (options/with-source store
-                                   (options/resolve-packages opts))))
+                                   (options/resolve-packages store opts))))
     (filter-map (match-lambda
-                 (('expression . str)
-                  (derivation-from-expression store str package->derivation
-                                              sys src?))
                  (('argument . (? package? p))
                   (if src?
                       (let ((s (package-source p)))
                         (package-source-derivation store s))
                       (package->derivation store p sys)))
+                 (('argument . (? derivation? drv))
+                  drv)
                  (('argument . (? derivation-path? drv))
                   (call-with-input-file drv read-derivation))
                  (('argument . (? store-path?))
@@ -340,14 +319,24 @@ (define sys  (assoc-ref opts 'system))
                  (_ #f))
                 opts)))
 
-(define (options/resolve-packages opts)
+(define (options/resolve-packages store opts)
   "Return OPTS with package specification strings replaced by actual
 packages."
+  (define system
+    (or (assoc-ref opts 'system) (%current-system)))
+
   (map (match-lambda
         (('argument . (? string? spec))
          (if (store-path? spec)
              `(argument . ,spec)
              `(argument . ,(specification->package spec))))
+        (('expression . str)
+         (match (read/eval str)
+           ((? package? p)
+            `(argument . ,p))
+           ((? procedure? proc)
+            (let ((drv (run-with-store store (proc) #:system system)))
+              `(argument . ,drv)))))
         (opt opt))
        opts))