[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/02: profiles: Store search paths in manifests.
|
From: |
Ludovic Courtès |
|
Subject: |
01/02: profiles: Store search paths in manifests. |
|
Date: |
Sat, 02 May 2015 22:10:13 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit dedb17ad010ee9ef67f3f4f3997dd17f226c8090
Author: Ludovic Courtès <address@hidden>
Date: Sat May 2 23:55:24 2015 +0200
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.
---
guix/packages.scm | 15 +++++++++
guix/profiles.scm | 76 ++++++++++++++++++++++++++++++++++++++++-----
guix/scripts/package.scm | 22 +------------
tests/profiles.scm | 22 +++++++++++++
4 files changed, 106 insertions(+), 29 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index a979f31..b7a1979 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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.
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 4bb3093..2e515d5 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -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."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1e724b4..fca70f5 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -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)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 54fbaea..890f09a 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -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")