summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-08-23 18:41:14 +0200
committerLudovic Courtès <ludo@gnu.org>2014-08-23 22:33:03 +0200
commit79ee406d51f95bc5a4b60ee4b097a9869e8dea7b (patch)
tree511986b759c419057171013283693450dfc3df57
parent6b74bb0ae3423d5150b765ac81cc1c2a48d4807e (diff)
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.
-rw-r--r--guix/profiles.scm115
-rw-r--r--guix/scripts/package.scm5
-rw-r--r--tests/profiles.scm3
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))))