From a54c94a40d3d87c80034793795bf13fd7abf7a6e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 26 Jul 2014 22:08:10 +0200 Subject: profiles: Switch to gexps. * guix/profiles.scm ()[path]: Rename to... [item]: ... this. Update users. (manifest->sexp): Rename to... (manifest->gexp): ... this. Return a gexp. (lower-input): Remove. (profile-derivation): Remove 'store' parameter, and turn into a monadic procedure. [inputs]: New variable. [builder]: Turn into a gexp. Replace call to 'build-expression->derivation' with call to 'gexp->derivation'. * guix/scripts/package.scm (link-to-empty-profile): Adjust call to 'profile-derivation', and wrap it in 'run-with-store'. (show-what-to-remove/install): Rename 'path' to 'item'. Check whether ITEM is a package, and return its output path if it is. (input->name+path): Remove. (options->installable): Set 'item' to P. (guix-package): Adjust call to 'profile-derivation'. * tests/profiles.scm (guile-2.0.9): Change 'path' to 'item'. --- guix/profiles.scm | 100 ++++++++++++++++++++++++++---------------------------- 1 file changed, 48 insertions(+), 52 deletions(-) (limited to 'guix/profiles.scm') diff --git a/guix/profiles.scm b/guix/profiles.scm index 91fc2fa435..64c69c4429 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -22,6 +22,7 @@ #:use-module (guix records) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 ftw) @@ -39,7 +40,7 @@ manifest-entry-name manifest-entry-version manifest-entry-output - manifest-entry-path + manifest-entry-item manifest-entry-dependencies manifest-pattern @@ -84,7 +85,7 @@ (version manifest-entry-version) ; string (output manifest-entry-output ; string (default "out")) - (path manifest-entry-path) ; store path + (item manifest-entry-item) ; package | store path (dependencies manifest-entry-dependencies ; list of store paths (default '())) (inputs manifest-entry-inputs ; list of inputs to build @@ -106,17 +107,20 @@ (call-with-input-file file read-manifest) (manifest '())))) -(define (manifest->sexp manifest) - "Return a representation of MANIFEST as an sexp." - (define (entry->sexp entry) +(define (manifest->gexp manifest) + "Return a representation of MANIFEST as a gexp." + (define (entry->gexp entry) (match entry - (($ name version path output (deps ...)) - (list name version path output deps)))) + (($ name version output (? string? path) (deps ...)) + #~(#$name #$version #$output #$path #$deps)) + (($ name version output (? package? package) (deps ...)) + #~(#$name #$version #$output + (ungexp package (or output "out")) #$deps)))) (match manifest (($ (entries ...)) - `(manifest (version 1) - (packages ,(map entry->sexp entries)))))) + #~(manifest (version 1) + (packages #$(map entry->gexp entries)))))) (define (sexp->manifest sexp) "Parse SEXP as a manifest." @@ -129,7 +133,7 @@ (name name) (version version) (output output) - (path path))) + (item path))) name version output path))) ;; Version 1 adds a list of propagated inputs to the @@ -142,7 +146,7 @@ (name name) (version version) (output output) - (path path) + (item path) (dependencies deps))) name version output path deps))) @@ -200,50 +204,42 @@ must be a manifest-pattern." ;;; Profiles. ;;; -(define* (lower-input store input #:optional (system (%current-system))) - "Lower INPUT so that it contains derivations instead of packages." - (match input - ((name (? package? package)) - `(,name ,(package-derivation store package system))) - ((name (? package? package) output) - `(,name ,(package-derivation store package system) - ,output)) - (_ input))) - -(define (profile-derivation store manifest) +(define (profile-derivation manifest) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST." + (define inputs + (append-map (match-lambda + (($ name version + output path deps (inputs ..1)) + inputs) + (($ name version output path deps) + ;; Assume PATH and DEPS are already valid. + `((,name ,path) ,@deps))) + (manifest-entries manifest))) + (define builder - `(begin - (use-modules (ice-9 pretty-print) - (guix build union)) - - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) - - (let ((output (assoc-ref %outputs "out")) - (inputs (map cdr %build-inputs))) - (union-build output inputs - #:log-port (%make-void-port "w")) - (call-with-output-file (string-append output "/manifest") - (lambda (p) - (pretty-print ',(manifest->sexp manifest) p)))))) - - (build-expression->derivation store "profile" builder - #:inputs - (append-map (match-lambda - (($ name version - output path deps (inputs ..1)) - (map (cute lower-input store <>) - inputs)) - (($ name version - output path deps) - ;; Assume PATH and DEPS are - ;; already valid. - `((,name ,path) ,@deps))) - (manifest-entries manifest)) - #:modules '((guix build union)) - #:local-build? #t)) + #~(begin + (use-modules (ice-9 pretty-print) + (guix build union)) + + (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-error-port) _IOLBF) + + (let ((inputs '#$(map (match-lambda + ((label thing) + thing) + ((label thing output) + `(,thing ,output))) + inputs))) + (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