profiles: Add 'package->manifest-entry'.

Suggested by Alex Kost <alezost@gmail.com>.

* guix/scripts/package.scm (options->installable)[package->manifest-entry]:
  Move to (guix profiles).
  [package->manifest-entry*]: New procedure.
  Use it.
* guix/profiles.scm (package->manifest-entry): New procedure.
* tests/profiles.scm (guile-for-build): New variable.
  Call '%guile-for-build'.
  ("profile-derivation"): New test.

3 files changed, 49 insertions, 18 deletions

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 96c8ca0514..5e69e012f9 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -51,6 +51,7 @@
             manifest-matching-entries
 
             profile-manifest
+            package->manifest-entry
             profile-derivation
             generation-number
             generation-numbers
@@ -105,6 +106,22 @@
         (call-with-input-file file read-manifest)
         (manifest '()))))
 
+(define* (package->manifest-entry package #:optional output)
+  "Return a manifest entry for the OUTPUT of package PACKAGE.  When OUTPUT is
+omitted or #f, use the first output of PACKAGE."
+  (let ((deps (map (match-lambda
+                    ((label package)
+                     `(,package "out"))
+                    ((label package output)
+                     `(,package ,output)))
+                   (package-transitive-propagated-inputs package))))
+    (manifest-entry
+     (name (package-name package))
+     (version (package-version package))
+     (output (or output (car (package-outputs package))))
+     (item package)
+     (dependencies (delete-duplicates deps)))))
+
 (define (manifest->gexp manifest)
   "Return a representation of MANIFEST as a gexp."
   (define (entry->gexp entry)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 3fe7385bc2..31da773a53 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -641,24 +641,11 @@ return the new list of manifest entries."
 
     (delete-duplicates deps same?))
 
-  (define (package->manifest-entry p output)
-    ;; Return a manifest entry for the OUTPUT of package P.
-    (check-package-freshness p)
+  (define (package->manifest-entry* package output)
+    (check-package-freshness package)
     ;; When given a package via `-e', install the first of its
     ;; outputs (XXX).
-    (let* ((output (or output (car (package-outputs p))))
-           (deps   (map (match-lambda
-                         ((label package)
-                          `(,package "out"))
-                         ((label package output)
-                          `(,package ,output)))
-                        (package-transitive-propagated-inputs p))))
-      (manifest-entry
-       (name (package-name p))
-       (version (package-version p))
-       (output output)
-       (item p)
-       (dependencies (delete-duplicates deps)))))
+    (package->manifest-entry package output))
 
   (define upgrade-regexps
     (filter-map (match-lambda
@@ -689,7 +676,7 @@ return the new list of manifest entries."
   (define to-upgrade
     (map (match-lambda
           ((package output)
-           (package->manifest-entry package output)))
+           (package->manifest-entry* package output)))
          packages-to-upgrade))
 
   (define packages-to-install
@@ -707,7 +694,7 @@ return the new list of manifest entries."
   (define to-install
     (append (map (match-lambda
                   ((package output)
-                   (package->manifest-entry package output)))
+                   (package->manifest-entry* package output)))
                  packages-to-install)
             (filter-map (match-lambda
                          (('install . (? package?))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index e6fcaad7cf..d405f6453e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -18,11 +18,25 @@
 
 (define-module (test-profiles)
   #:use-module (guix profiles)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-64))
 
 ;; Test the (guix profile) module.
 
+(define %store
+  (open-connection))
+
+(define guile-for-build
+  (package-derivation %store %bootstrap-guile))
+
+;; Make it the default.
+(%guile-for-build guile-for-build)
+
 
 ;; Example manifest entries.
 
@@ -87,6 +101,19 @@
             (null? (manifest-entries m3))
             (null? (manifest-entries m4)))))))
 
+(test-assert "profile-derivation"
+  (run-with-store %store
+    (mlet* %store-monad
+        ((entry ->   (package->manifest-entry %bootstrap-guile))
+         (guile      (package->derivation %bootstrap-guile))
+         (drv        (profile-derivation (manifest (list entry))))
+         (profile -> (derivation->output-path drv))
+         (bindir ->  (string-append profile "/bin"))
+         (_          (built-derivations (list drv))))
+      (return (and (file-exists? (string-append bindir "/guile"))
+                   (string=? (dirname (readlink bindir))
+                             (derivation->output-path guile)))))))
+
 (test-end "profiles")