summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/profiles.scm73
-rw-r--r--tests/profiles.scm36
2 files changed, 89 insertions, 20 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 6733f105e3..a66add3e07 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -154,7 +154,7 @@
(output manifest-entry-output ; string
(default "out"))
(item manifest-entry-item) ; package | store path
- (dependencies manifest-entry-dependencies ; (store path | package)*
+ (dependencies manifest-entry-dependencies ; <manifest-entry>*
(default '()))
(search-paths manifest-entry-search-paths ; search-path-specification*
(default '())))
@@ -179,10 +179,10 @@
"Return a manifest entry for the OUTPUT of package PACKAGE."
(let ((deps (map (match-lambda
((label package)
- (gexp-input package))
+ (package->manifest-entry package))
((label package output)
- (gexp-input package output)))
- (package-transitive-propagated-inputs package))))
+ (package->manifest-entry package output)))
+ (package-propagated-inputs package))))
(manifest-entry
(name (package-name package))
(version (package-version package))
@@ -210,20 +210,20 @@ denoting a specific output of a package."
(($ <manifest-entry> name version output (? string? path)
(deps ...) (search-paths ...))
#~(#$name #$version #$output #$path
- (propagated-inputs #$deps)
+ (propagated-inputs #$(map entry->gexp 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"))
- (propagated-inputs #$deps)
+ (propagated-inputs #$(map entry->gexp deps))
(search-paths #$(map search-path-specification->sexp
search-paths))))))
(match manifest
(($ <manifest> (entries ...))
- #~(manifest (version 2)
+ #~(manifest (version 3)
(packages #$(map entry->gexp entries))))))
(define (find-package name version)
@@ -254,17 +254,27 @@ procedure is here for backward-compatibility and will eventually vanish."
(package-native-search-paths package)
'())))
+ (define (infer-dependency item)
+ ;; Return a <manifest-entry> for ITEM.
+ (let-values (((name version)
+ (package-name->name+version
+ (store-path-package-name item))))
+ (manifest-entry
+ (name name)
+ (version version)
+ (item item))))
+
(match sexp
(('manifest ('version 0)
('packages ((name version output path) ...)))
(manifest
(map (lambda (name version output path)
(manifest-entry
- (name name)
- (version version)
- (output output)
- (item path)
- (search-paths (infer-search-paths name version))))
+ (name name)
+ (version version)
+ (output output)
+ (item path)
+ (search-paths (infer-search-paths name version))))
name version output path)))
;; Version 1 adds a list of propagated inputs to the
@@ -286,7 +296,7 @@ procedure is here for backward-compatibility and will eventually vanish."
(version version)
(output output)
(item path)
- (dependencies deps)
+ (dependencies (map infer-dependency deps))
(search-paths (infer-search-paths name version)))))
name version output path deps)))
@@ -304,10 +314,30 @@ procedure is here for backward-compatibility and will eventually vanish."
(version version)
(output output)
(item path)
- (dependencies deps)
+ (dependencies (map infer-dependency deps))
(search-paths (map sexp->search-path-specification
search-paths))))
name version output path deps search-paths)))
+
+ ;; Version 3 represents DEPS as full-blown manifest entries.
+ (('manifest ('version 3 minor-version ...)
+ ('packages (entries ...)))
+ (letrec ((sexp->manifest-entry
+ (match-lambda
+ ((name version output path
+ ('propagated-inputs deps)
+ ('search-paths search-paths)
+ extra-stuff ...)
+ (manifest-entry
+ (name name)
+ (version version)
+ (output output)
+ (item path)
+ (dependencies (map sexp->manifest-entry deps))
+ (search-paths (map sexp->search-path-specification
+ search-paths)))))))
+
+ (manifest (map sexp->manifest-entry entries))))
(_
(raise (condition
(&message (message "unsupported manifest format")))))))
@@ -471,12 +501,15 @@ replace it."
(define (manifest-inputs manifest)
"Return a list of <gexp-input> objects for MANIFEST."
- (append-map (match-lambda
- (($ <manifest-entry> name version output thing deps)
- ;; THING may be a package or a file name. In the latter case,
- ;; assume it's already valid. Ditto for DEPS.
- (cons (gexp-input thing output) deps)))
- (manifest-entries manifest)))
+ (define entry->input
+ (match-lambda
+ (($ <manifest-entry> name version output thing deps)
+ ;; THING may be a package or a file name. In the latter case, assume
+ ;; it's already valid.
+ (cons (gexp-input thing output)
+ (append-map entry->input deps)))))
+
+ (append-map entry->input (manifest-entries manifest)))
(define* (manifest-lookup-package manifest name #:optional version)
"Return as a monadic value the first package or store path referenced by
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 093422792f..e8b1bb832c 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -288,6 +288,42 @@
(manifest-entry-search-paths
(package->manifest-entry mpl)))))
+(test-equal "packages->manifest, propagated inputs"
+ (map (match-lambda
+ ((label package)
+ (list (package-name package) (package-version package)
+ package)))
+ (package-propagated-inputs packages:guile-2.2))
+ (map (lambda (entry)
+ (list (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (manifest-entry-item entry)))
+ (manifest-entry-dependencies
+ (package->manifest-entry packages:guile-2.2))))
+
+(test-assertm "read-manifest"
+ (mlet* %store-monad ((manifest -> (packages->manifest
+ (list (package
+ (inherit %bootstrap-guile)
+ (native-search-paths
+ (package-native-search-paths
+ packages:guile-2.0))))))
+ (drv (profile-derivation manifest
+ #:hooks '()
+ #:locales? #f))
+ (out -> (derivation->output-path drv)))
+ (define (entry->sexp entry)
+ (list (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (manifest-entry-search-paths entry)
+ (manifest-entry-dependencies entry)))
+
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (let ((manifest2 (profile-manifest out)))
+ (return (equal? (map entry->sexp (manifest-entries manifest))
+ (map entry->sexp (manifest-entries manifest2))))))))
+
(test-assertm "etc/profile"
;; Make sure we get an 'etc/profile' file that at least defines $PATH.
(mlet* %store-monad