From 79ee406d51f95bc5a4b60ee4b097a9869e8dea7b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 23 Aug 2014 18:41:14 +0200
Subject: 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.
---
 guix/profiles.scm | 115 ++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 86 insertions(+), 29 deletions(-)

(limited to 'guix/profiles.scm')

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 @@ (define-module (guix profiles)
   #: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 @@ (define (package-strings name version output item)
 ;;; 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."
-- 
cgit v1.2.3