profiles: Switch to gexps.

* guix/profiles.scm (<manifest-entry>)[path]: Rename to...
  [item]: ... this.  Update users.
  (manifest->sexp): Rename to...
  (manifest->gexp): ... this.  Return a gexp.
  (lower-input): Remove.
  (profile-derivation): Remove 'store' parameter, and turn into a
  monadic procedure.
  [inputs]: New variable.
  [builder]: Turn into a gexp.
  Replace call to 'build-expression->derivation' with call to
  'gexp->derivation'.
* guix/scripts/package.scm (link-to-empty-profile): Adjust call to
  'profile-derivation', and wrap it in 'run-with-store'.
  (show-what-to-remove/install): Rename 'path' to 'item'.  Check whether
  ITEM is a package, and return its output path if it is.
  (input->name+path): Remove.
  (options->installable): Set 'item' to P.
  (guix-package): Adjust call to 'profile-derivation'.
* tests/profiles.scm (guile-2.0.9): Change 'path' to 'item'.

2 files changed, 63 insertions, 72 deletions

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 91fc2fa435..64c69c4429 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -22,6 +22,7 @@
   #:use-module (guix records)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -39,7 +40,7 @@
             manifest-entry-name
             manifest-entry-version
             manifest-entry-output
-            manifest-entry-path
+            manifest-entry-item
             manifest-entry-dependencies
 
             manifest-pattern
@@ -84,7 +85,7 @@
   (version      manifest-entry-version)           ; string
   (output       manifest-entry-output             ; string
                 (default "out"))
-  (path         manifest-entry-path)              ; store path
+  (item         manifest-entry-item)              ; package | store path
   (dependencies manifest-entry-dependencies       ; list of store paths
                 (default '()))
   (inputs       manifest-entry-inputs             ; list of inputs to build
@@ -106,17 +107,20 @@
         (call-with-input-file file read-manifest)
         (manifest '()))))
 
-(define (manifest->sexp manifest)
-  "Return a representation of MANIFEST as an sexp."
-  (define (entry->sexp entry)
+(define (manifest->gexp manifest)
+  "Return a representation of MANIFEST as a gexp."
+  (define (entry->gexp entry)
     (match entry
-      (($ <manifest-entry> name version path output (deps ...))
-       (list name version path output deps))))
+      (($ <manifest-entry> name version output (? string? path) (deps ...))
+       #~(#$name #$version #$output #$path #$deps))
+      (($ <manifest-entry> name version output (? package? package) (deps ...))
+       #~(#$name #$version #$output
+                 (ungexp package (or output "out")) #$deps))))
 
   (match manifest
     (($ <manifest> (entries ...))
-     `(manifest (version 1)
-                (packages ,(map entry->sexp entries))))))
+     #~(manifest (version 1)
+                 (packages #$(map entry->gexp entries))))))
 
 (define (sexp->manifest sexp)
   "Parse SEXP as a manifest."
@@ -129,7 +133,7 @@
               (name name)
               (version version)
               (output output)
-              (path path)))
+              (item path)))
            name version output path)))
 
     ;; Version 1 adds a list of propagated inputs to the
@@ -142,7 +146,7 @@
               (name name)
               (version version)
               (output output)
-              (path path)
+              (item path)
               (dependencies deps)))
            name version output path deps)))
 
@@ -200,50 +204,42 @@ must be a manifest-pattern."
 ;;; Profiles.
 ;;;
 
-(define* (lower-input store input #:optional (system (%current-system)))
-  "Lower INPUT so that it contains derivations instead of packages."
-  (match input
-    ((name (? package? package))
-     `(,name ,(package-derivation store package system)))
-    ((name (? package? package) output)
-     `(,name ,(package-derivation store package system)
-             ,output))
-    (_ input)))
-
-(define (profile-derivation store manifest)
+(define (profile-derivation manifest)
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST."
+  (define inputs
+    (append-map (match-lambda
+                 (($ <manifest-entry> name version
+                                      output path deps (inputs ..1))
+                  inputs)
+                 (($ <manifest-entry> name version output path deps)
+                  ;; Assume PATH and DEPS are already valid.
+                  `((,name ,path) ,@deps)))
+                (manifest-entries manifest)))
+
   (define builder
-    `(begin
-       (use-modules (ice-9 pretty-print)
-                    (guix build union))
-
-       (setvbuf (current-output-port) _IOLBF)
-       (setvbuf (current-error-port) _IOLBF)
-
-       (let ((output (assoc-ref %outputs "out"))
-             (inputs (map cdr %build-inputs)))
-         (union-build output inputs
-                      #:log-port (%make-void-port "w"))
-         (call-with-output-file (string-append output "/manifest")
-           (lambda (p)
-             (pretty-print ',(manifest->sexp manifest) p))))))
-
-  (build-expression->derivation store "profile" builder
-                                #:inputs
-                                (append-map (match-lambda
-                                             (($ <manifest-entry> name version
-                                                 output path deps (inputs ..1))
-                                              (map (cute lower-input store <>)
-                                                   inputs))
-                                             (($ <manifest-entry> name version
-                                                 output path deps)
-                                              ;; Assume PATH and DEPS are
-                                              ;; already valid.
-                                              `((,name ,path) ,@deps)))
-                                            (manifest-entries manifest))
-                                #:modules '((guix build union))
-                                #:local-build? #t))
+    #~(begin
+        (use-modules (ice-9 pretty-print)
+                     (guix build union))
+
+        (setvbuf (current-output-port) _IOLBF)
+        (setvbuf (current-error-port) _IOLBF)
+
+        (let ((inputs '#$(map (match-lambda
+                               ((label thing)
+                                thing)
+                               ((label thing output)
+                                `(,thing ,output)))
+                              inputs)))
+          (union-build #$output inputs
+                       #:log-port (%make-void-port "w"))
+          (call-with-output-file (string-append #$output "/manifest")
+            (lambda (p)
+              (pretty-print '#$(manifest->gexp manifest) p))))))
+
+  (gexp->derivation "profile" builder
+                    #:modules '((guix build union))
+                    #:local-build? #t))
 
 (define (profile-regexp profile)
   "Return a regular expression that matches PROFILE's name and number."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 36e025d479..bc2c854853 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -24,6 +24,7 @@
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix profiles)
+  #:use-module (guix monads)
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix scripts build)
@@ -82,7 +83,8 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
 
 (define (link-to-empty-profile generation)
   "Link GENERATION, a string, to the empty profile."
-  (let* ((drv  (profile-derivation (%store) (manifest '())))
+  (let* ((drv  (run-with-store (%store)
+                 (profile-derivation (manifest '()))))
          (prof (derivation->output-path drv "out")))
     (when (not (build-derivations (%store) (list drv)))
           (leave (_ "failed to build the empty profile~%")))
@@ -205,10 +207,14 @@ packages that will/would be installed and removed."
                    remove))))
     (_ #f))
   (match install
-    ((($ <manifest-entry> name version output path _) ..1)
+    ((($ <manifest-entry> name version output item _) ..1)
      (let ((len     (length name))
-           (install (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
-                         name version output path)))
+           (install (map (lambda (name version output item)
+                           (format #f "   ~a-~a\t~a\t~a" name version output
+                                   (if (package? item)
+                                       (package-output (%store) item output)
+                                       item)))
+                         name version output item)))
        (if dry-run?
            (format (current-error-port)
                    (N_ "The following package would be installed:~%~{~a~%~}~%"
@@ -253,17 +259,6 @@ RX."
                 (package-name p2))))
    same-location?))
 
-(define (input->name+path input)
-  "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
-  (let loop ((input input))
-    (match input
-      ((name (? package? package))
-       (loop `(,name ,package "out")))
-      ((name (? package? package) sub-drv)
-       `(,name ,(package-output (%store) package sub-drv)))
-      (_
-       input))))
-
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
   (make-prompt-tag "interruptible"))
@@ -652,14 +647,13 @@ return the new list of manifest entries."
     ;; When given a package via `-e', install the first of its
     ;; outputs (XXX).
     (let* ((output (or output (car (package-outputs p))))
-           (path   (package-output (%store) p output))
            (deps   (deduplicate (package-transitive-propagated-inputs p))))
       (manifest-entry
        (name (package-name p))
        (version (package-version p))
        (output output)
-       (path path)
-       (dependencies (map input->name+path deps))
+       (item p)
+       (dependencies deps)
        (inputs (cons (list (package-name p) p output)
                      deps)))))
 
@@ -723,7 +717,7 @@ return the new list of manifest entries."
                              (name name)
                              (version version)
                              (output #f)
-                             (path path))))
+                             (item path))))
                          (_ #f))
                         opts)))
 
@@ -932,7 +926,8 @@ more information.~%"))
                (ensure-default-profile))
 
              (unless (and (null? install) (null? remove))
-               (let* ((prof-drv (profile-derivation (%store) new))
+               (let* ((prof-drv (run-with-store (%store)
+                                  (profile-derivation new)))
                       (prof     (derivation->output-path prof-drv))
                       (remove   (manifest-matching-entries manifest remove)))
                  (show-what-to-remove/install remove install dry-run?)