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.
This commit is contained in:
Ludovic Courtès 2014-08-23 18:41:14 +02:00
parent 6b74bb0ae3
commit 79ee406d51
3 changed files with 88 additions and 27 deletions

View file

@ -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 (manifest-inputs manifest)
"Return the list of inputs for MANIFEST. Each input has one of the
following forms:
(define builder
(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))
(use-modules (guix build utils)
(srfi srfi-1) (srfi srfi-26)
(ice-9 ftw))
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(define (info-file? file)
(or (string-suffix? ".info" file)
(string-suffix? ".info.gz" file)))
(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)))))
(define (info-files top)
(let ((infodir (string-append top "/share/info")))
(map (cut string-append infodir "/" <>)
(scandir infodir info-file?))))
(gexp->derivation "profile" builder
#:modules '((guix build union))
#:local-build? #t))
(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."

View file

@ -744,6 +744,7 @@ (define (delete-generation number)
(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 @@ (define (delete-generation number)
(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?)

View file

@ -147,7 +147,8 @@ (define guile-2.0.9:debug
(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))))