profiles: Produce a top-level Info 'dir' file.

Fixes <http://bugs.gnu.org/18305>.
Reported by Brandon Invergo <brandon@gnu.org>.

* guix/profiles.scm (manifest-inputs, info-dir-file): New procedures.
  (profile-derivation): Use them.  Add #:info-dir? parameter and honor
  it.
* guix/scripts/package.scm (guix-package): Call 'profile-derivation'
  with #:info-dir? #f when the 'bootstrap? option is set.
* tests/profiles.scm ("profile-derivation"): Pass #:info-dir? #f.

3 files changed, 92 insertions, 31 deletions

diff --git a/guix/profiles.scm b/guix/profiles.scm
index d2d9b9e9f7..bf86624e43 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -25,6 +25,7 @@
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix gexp)
+  #:use-module (guix monads)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -353,36 +354,92 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
 ;;; Profiles.
 ;;;
 
-(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 (? package? package) deps)
-                  `((,package ,output) ,@deps))
-                 (($ <manifest-entry> name version output path deps)
-                  ;; Assume PATH and DEPS are already valid.
-                  `(,path ,@deps)))
-                (manifest-entries manifest)))
-
-  (define builder
+(define (manifest-inputs manifest)
+  "Return the list of inputs for MANIFEST.  Each input has one of the
+following forms:
+
+  (PACKAGE OUTPUT-NAME)
+
+or
+
+  STORE-PATH
+"
+  (append-map (match-lambda
+               (($ <manifest-entry> name version
+                                    output (? package? package) deps)
+                `((,package ,output) ,@deps))
+               (($ <manifest-entry> name version output path deps)
+                ;; Assume PATH and DEPS are already valid.
+                `(,path ,@deps)))
+              (manifest-entries manifest)))
+
+(define (info-dir-file manifest)
+  "Return a derivation that builds the 'dir' file for all the entries of
+MANIFEST."
+  (define texinfo
+    ;; Lazy reference.
+    (module-ref (resolve-interface '(gnu packages texinfo))
+                'texinfo))
+  (define build
     #~(begin
-        (use-modules (ice-9 pretty-print)
-                     (guix build union))
-
-        (setvbuf (current-output-port) _IOLBF)
-        (setvbuf (current-error-port) _IOLBF)
-
-        (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))
+        (use-modules (guix build utils)
+                     (srfi srfi-1) (srfi srfi-26)
+                     (ice-9 ftw))
+
+        (define (info-file? file)
+          (or (string-suffix? ".info" file)
+              (string-suffix? ".info.gz" file)))
+
+        (define (info-files top)
+          (let ((infodir (string-append top "/share/info")))
+            (map (cut string-append infodir "/" <>)
+                 (scandir infodir info-file?))))
+
+        (define (install-info info)
+          (zero?
+           (system* (string-append #+texinfo "/bin/install-info")
+                    info (string-append #$output "/share/info/dir"))))
+
+        (mkdir-p (string-append #$output "/share/info"))
+        (every install-info
+               (append-map info-files
+                           '#$(manifest-inputs manifest)))))
+
+  ;; Don't depend on Texinfo when there's nothing to do.
+  (if (null? (manifest-entries manifest))
+      (gexp->derivation "info-dir" #~(mkdir #$output))
+      (gexp->derivation "info-dir" build
+                        #:modules '((guix build utils)))))
+
+(define* (profile-derivation manifest #:key (info-dir? #t))
+  "Return a derivation that builds a profile (aka. 'user environment') with
+the given MANIFEST.  The profile includes a top-level Info 'dir' file, unless
+INFO-DIR? is #f."
+  (mlet %store-monad ((info-dir (if info-dir?
+                                    (info-dir-file manifest)
+                                    (return #f))))
+    (define inputs
+      (if info-dir
+          (cons info-dir (manifest-inputs manifest))
+          (manifest-inputs manifest)))
+
+    (define builder
+      #~(begin
+          (use-modules (ice-9 pretty-print)
+                       (guix build union))
+
+          (setvbuf (current-output-port) _IOLBF)
+          (setvbuf (current-error-port) _IOLBF)
+
+          (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 c33fd7b605..fb285c5e67 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -744,6 +744,7 @@ more information.~%"))
            (let* ((manifest    (profile-manifest profile))
                   (install     (options->installable opts manifest))
                   (remove      (options->removable opts manifest))
+                  (bootstrap?  (assoc-ref opts 'bootstrap?))
                   (transaction (manifest-transaction (install install)
                                                      (remove remove)))
                   (new         (manifest-perform-transaction
@@ -754,7 +755,9 @@ more information.~%"))
 
              (unless (and (null? install) (null? remove))
                (let* ((prof-drv (run-with-store (%store)
-                                                (profile-derivation new)))
+                                  (profile-derivation
+                                   new
+                                   #:info-dir? (not bootstrap?))))
                       (prof     (derivation->output-path prof-drv)))
                  (manifest-show-transaction (%store) manifest transaction
                                             #:dry-run? dry-run?)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index e1f1eefee7..8f14bf0d6f 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -147,7 +147,8 @@
     (mlet* %store-monad
         ((entry ->   (package->manifest-entry %bootstrap-guile))
          (guile      (package->derivation %bootstrap-guile))
-         (drv        (profile-derivation (manifest (list entry))))
+         (drv        (profile-derivation (manifest (list entry))
+                                         #:info-dir? #f))
          (profile -> (derivation->output-path drv))
          (bindir ->  (string-append profile "/bin"))
          (_          (built-derivations (list drv))))