diff options
| -rw-r--r-- | guix/profiles.scm | 115 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 5 | ||||
| -rw-r--r-- | tests/profiles.scm | 3 |
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)))) |