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:
parent
b9212a5455
commit
dedb17ad01
|
@ -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.
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue