profiles: Store search paths in manifests.

Discussed in <http://bugs.gnu.org/20255>.

* guix/packages.scm (sexp->search-path-specification): New variable.
* guix/profiles.scm (<manifest-entry>)[search-paths]: New field.
  (package->manifest-entry): Initialize it.
  (manifest->gexp): Match it.  Wrap #$deps in (propagated-inputs ...).
  Emit (search-paths ...).  Increment version.
  (find-package): New procedure.
  (sexp->manifest)[infer-search-paths]: New procedure.
  Use it to initialize the 'search-paths' field for versions 0 and 1.
  Add case for version 2.
* guix/scripts/package.scm (search-path-environment-variables)[manifest-entry->package]:
  Remove.
  Use 'manifest-entry-search-paths' instead of 'manifest-entry->package'
  plus 'package-native-search-paths'.
* tests/profiles.scm ("profile-manifest, search-paths"): New test.
This commit is contained in:
Ludovic Courtès 2015-05-02 23:55:24 +02:00
parent b9212a5455
commit dedb17ad01
4 changed files with 106 additions and 29 deletions

View File

@ -56,6 +56,7 @@
search-path-specification
search-path-specification?
search-path-specification->sexp
sexp->search-path-specification
package
package?
@ -202,10 +203,24 @@ representation."
(define (search-path-specification->sexp spec)
"Return an sexp representing SPEC, a <search-path-specification>. The sexp
corresponds to the arguments expected by `set-path-environment-variable'."
;; Note that this sexp format is used both by build systems and in
;; (guix profiles), so think twice before you change it.
(match spec
(($ <search-path-specification> variable files separator type pattern)
`(,variable ,files ,separator ,type ,pattern))))
(define (sexp->search-path-specification sexp)
"Convert SEXP, which is as returned by 'search-path-specification->sexp', to
a <search-path-specification> object."
(match sexp
((variable files separator type pattern)
(search-path-specification
(variable variable)
(files files)
(separator separator)
(file-type type)
(file-pattern pattern)))))
(define %supported-systems
;; This is the list of system types that are supported. By default, we
;; expect all packages to build successfully here.

View File

@ -59,6 +59,7 @@
manifest-entry-output
manifest-entry-item
manifest-entry-dependencies
manifest-entry-search-paths
manifest-pattern
manifest-pattern?
@ -133,6 +134,8 @@
(default "out"))
(item manifest-entry-item) ; package | store path
(dependencies manifest-entry-dependencies ; (store path | package)*
(default '()))
(search-paths manifest-entry-search-paths ; search-path-specification*
(default '())))
(define-record-type* <manifest-pattern> manifest-pattern
@ -165,25 +168,60 @@ omitted or #f, use the first output of PACKAGE."
(version (package-version package))
(output (or output (car (package-outputs package))))
(item package)
(dependencies (delete-duplicates deps)))))
(dependencies (delete-duplicates deps))
(search-paths (package-native-search-paths package)))))
(define (manifest->gexp manifest)
"Return a representation of MANIFEST as a gexp."
(define (entry->gexp entry)
(match entry
(($ <manifest-entry> name version output (? string? path) (deps ...))
#~(#$name #$version #$output #$path #$deps))
(($ <manifest-entry> name version output (? package? package) (deps ...))
(($ <manifest-entry> name version output (? string? path)
(deps ...) (search-paths ...))
#~(#$name #$version #$output #$path
(propagated-inputs #$deps)
(search-paths #$(map search-path-specification->sexp
search-paths))))
(($ <manifest-entry> name version output (? package? package)
(deps ...) (search-paths ...))
#~(#$name #$version #$output
(ungexp package (or output "out")) #$deps))))
(ungexp package (or output "out"))
(propagated-inputs #$deps)
(search-paths #$(map search-path-specification->sexp
search-paths))))))
(match manifest
(($ <manifest> (entries ...))
#~(manifest (version 1)
#~(manifest (version 2)
(packages #$(map entry->gexp entries))))))
(define (find-package name version)
"Return a package from the distro matching NAME and possibly VERSION. This
procedure is here for backward-compatibility and will eventually vanish."
(define find-best-packages-by-name ;break abstractions
(module-ref (resolve-interface '(gnu packages))
'find-best-packages-by-name))
;; Use 'find-best-packages-by-name' and not 'find-packages-by-name'; the
;; former traverses the module tree only once and then allows for efficient
;; access via a vhash.
(match (find-best-packages-by-name name version)
((p _ ...) p)
(_
(match (find-best-packages-by-name name #f)
((p _ ...) p)
(_ #f)))))
(define (sexp->manifest sexp)
"Parse SEXP as a manifest."
(define (infer-search-paths name version)
;; Infer the search path specifications for NAME-VERSION by looking up a
;; same-named package in the distro. Useful for the old manifest formats
;; that did not store search path info.
(let ((package (find-package name version)))
(if package
(package-native-search-paths package)
'())))
(match sexp
(('manifest ('version 0)
('packages ((name version output path) ...)))
@ -193,7 +231,8 @@ omitted or #f, use the first output of PACKAGE."
(name name)
(version version)
(output output)
(item path)))
(item path)
(search-paths (infer-search-paths name version))))
name version output path)))
;; Version 1 adds a list of propagated inputs to the
@ -215,11 +254,30 @@ omitted or #f, use the first output of PACKAGE."
(version version)
(output output)
(item path)
(dependencies deps))))
(dependencies deps)
(search-paths (infer-search-paths name version)))))
name version output path deps)))
;; Version 2 adds search paths and is slightly more verbose.
(('manifest ('version 2 minor-version ...)
('packages ((name version output path
('propagated-inputs deps)
('search-paths search-paths)
extra-stuff ...)
...)))
(manifest
(map (lambda (name version output path deps search-paths)
(manifest-entry
(name name)
(version version)
(output output)
(item path)
(dependencies deps)
(search-paths (map sexp->search-path-specification
search-paths))))
name version output path deps search-paths)))
(_
(error "unsupported manifest format" manifest))))
(error "unsupported manifest format" sexp))))
(define (read-manifest port)
"Return the packages listed in MANIFEST."

View File

@ -384,22 +384,6 @@ current settings and report only settings not already effective."
%user-profile-directory
profile)))
;; The search path info is not stored in the manifest. Thus, we infer the
;; search paths from same-named packages found in the distro.
(define manifest-entry->package
(match-lambda
(($ <manifest-entry> name version)
;; Use 'find-best-packages-by-name' and not 'find-packages-by-name';
;; the former traverses the module tree only once and then allows for
;; efficient access via a vhash.
(match (find-best-packages-by-name name version)
((p _ ...) p)
(_
(match (find-best-packages-by-name name #f)
((p _ ...) p)
(_ #f)))))))
(define search-path-definition
(match-lambda
(($ <search-path-specification> variable files separator
@ -426,10 +410,8 @@ current settings and report only settings not already effective."
variable
(string-join path separator)))))))
(let* ((packages (filter-map manifest-entry->package entries))
(search-paths (delete-duplicates
(append-map package-native-search-paths
packages))))
(let ((search-paths (delete-duplicates
(append-map manifest-entry-search-paths entries))))
(filter-map search-path-definition search-paths))))
(define (display-search-paths entries profile)

View File

@ -26,6 +26,7 @@
#:use-module (guix derivations)
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages base) #:prefix packages:)
#:use-module ((gnu packages guile) #:prefix packages:)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-11)
@ -198,6 +199,27 @@
#:hooks '())))
(return (derivation-inputs drv))))
(test-assertm "profile-manifest, search-paths"
(mlet* %store-monad
((guile -> (package
(inherit %bootstrap-guile)
(native-search-paths
(package-native-search-paths packages:guile-2.0))))
(entry -> (package->manifest-entry guile))
(drv (profile-derivation (manifest (list entry))
#:hooks '()))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
;; Read the manifest back and make sure search paths are preserved.
(let ((manifest (profile-manifest profile)))
(match (manifest-entries manifest)
((result)
(return (equal? (manifest-entry-search-paths result)
(manifest-entry-search-paths entry)
(package-native-search-paths
packages:guile-2.0)))))))))
(test-end "profiles")