profiles: Represent propagated inputs as manifest entries.
* guix/profiles.scm (package->manifest-entry): Turn DEPS into a list of manifest entries. (manifest->gexp)[entry->gexp]: Call 'entry->gexp' on DEPS. Bump version to 3. (sexp->manifest)[infer-dependency]: New procedure. Use it for versions 1 and 2. Parse version 3. (manifest-inputs)[entry->gexp]: New procedure. Adjust to 'dependencies' being a list of <manifest-entry>. * tests/profiles.scm ("packages->manifest, propagated inputs") ("read-manifest"): New fields.
This commit is contained in:
parent
a431929d3d
commit
55b4715fd4
|
@ -154,7 +154,7 @@
|
||||||
(output manifest-entry-output ; string
|
(output manifest-entry-output ; string
|
||||||
(default "out"))
|
(default "out"))
|
||||||
(item manifest-entry-item) ; package | store path
|
(item manifest-entry-item) ; package | store path
|
||||||
(dependencies manifest-entry-dependencies ; (store path | package)*
|
(dependencies manifest-entry-dependencies ; <manifest-entry>*
|
||||||
(default '()))
|
(default '()))
|
||||||
(search-paths manifest-entry-search-paths ; search-path-specification*
|
(search-paths manifest-entry-search-paths ; search-path-specification*
|
||||||
(default '())))
|
(default '())))
|
||||||
|
@ -179,10 +179,10 @@
|
||||||
"Return a manifest entry for the OUTPUT of package PACKAGE."
|
"Return a manifest entry for the OUTPUT of package PACKAGE."
|
||||||
(let ((deps (map (match-lambda
|
(let ((deps (map (match-lambda
|
||||||
((label package)
|
((label package)
|
||||||
(gexp-input package))
|
(package->manifest-entry package))
|
||||||
((label package output)
|
((label package output)
|
||||||
(gexp-input package output)))
|
(package->manifest-entry package output)))
|
||||||
(package-transitive-propagated-inputs package))))
|
(package-propagated-inputs package))))
|
||||||
(manifest-entry
|
(manifest-entry
|
||||||
(name (package-name package))
|
(name (package-name package))
|
||||||
(version (package-version package))
|
(version (package-version package))
|
||||||
|
@ -210,20 +210,20 @@ denoting a specific output of a package."
|
||||||
(($ <manifest-entry> name version output (? string? path)
|
(($ <manifest-entry> name version output (? string? path)
|
||||||
(deps ...) (search-paths ...))
|
(deps ...) (search-paths ...))
|
||||||
#~(#$name #$version #$output #$path
|
#~(#$name #$version #$output #$path
|
||||||
(propagated-inputs #$deps)
|
(propagated-inputs #$(map entry->gexp deps))
|
||||||
(search-paths #$(map search-path-specification->sexp
|
(search-paths #$(map search-path-specification->sexp
|
||||||
search-paths))))
|
search-paths))))
|
||||||
(($ <manifest-entry> name version output (? package? package)
|
(($ <manifest-entry> name version output (? package? package)
|
||||||
(deps ...) (search-paths ...))
|
(deps ...) (search-paths ...))
|
||||||
#~(#$name #$version #$output
|
#~(#$name #$version #$output
|
||||||
(ungexp package (or output "out"))
|
(ungexp package (or output "out"))
|
||||||
(propagated-inputs #$deps)
|
(propagated-inputs #$(map entry->gexp deps))
|
||||||
(search-paths #$(map search-path-specification->sexp
|
(search-paths #$(map search-path-specification->sexp
|
||||||
search-paths))))))
|
search-paths))))))
|
||||||
|
|
||||||
(match manifest
|
(match manifest
|
||||||
(($ <manifest> (entries ...))
|
(($ <manifest> (entries ...))
|
||||||
#~(manifest (version 2)
|
#~(manifest (version 3)
|
||||||
(packages #$(map entry->gexp entries))))))
|
(packages #$(map entry->gexp entries))))))
|
||||||
|
|
||||||
(define (find-package name version)
|
(define (find-package name version)
|
||||||
|
@ -254,6 +254,16 @@ procedure is here for backward-compatibility and will eventually vanish."
|
||||||
(package-native-search-paths package)
|
(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
|
(match sexp
|
||||||
(('manifest ('version 0)
|
(('manifest ('version 0)
|
||||||
('packages ((name version output path) ...)))
|
('packages ((name version output path) ...)))
|
||||||
|
@ -286,7 +296,7 @@ procedure is here for backward-compatibility and will eventually vanish."
|
||||||
(version version)
|
(version version)
|
||||||
(output output)
|
(output output)
|
||||||
(item path)
|
(item path)
|
||||||
(dependencies deps)
|
(dependencies (map infer-dependency deps))
|
||||||
(search-paths (infer-search-paths name version)))))
|
(search-paths (infer-search-paths name version)))))
|
||||||
name version output path deps)))
|
name version output path deps)))
|
||||||
|
|
||||||
|
@ -304,10 +314,30 @@ procedure is here for backward-compatibility and will eventually vanish."
|
||||||
(version version)
|
(version version)
|
||||||
(output output)
|
(output output)
|
||||||
(item path)
|
(item path)
|
||||||
(dependencies deps)
|
(dependencies (map infer-dependency deps))
|
||||||
(search-paths (map sexp->search-path-specification
|
(search-paths (map sexp->search-path-specification
|
||||||
search-paths))))
|
search-paths))))
|
||||||
name version output path deps 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
|
(raise (condition
|
||||||
(&message (message "unsupported manifest format")))))))
|
(&message (message "unsupported manifest format")))))))
|
||||||
|
@ -471,12 +501,15 @@ replace it."
|
||||||
|
|
||||||
(define (manifest-inputs manifest)
|
(define (manifest-inputs manifest)
|
||||||
"Return a list of <gexp-input> objects for MANIFEST."
|
"Return a list of <gexp-input> objects for MANIFEST."
|
||||||
(append-map (match-lambda
|
(define entry->input
|
||||||
|
(match-lambda
|
||||||
(($ <manifest-entry> name version output thing deps)
|
(($ <manifest-entry> name version output thing deps)
|
||||||
;; THING may be a package or a file name. In the latter case,
|
;; THING may be a package or a file name. In the latter case, assume
|
||||||
;; assume it's already valid. Ditto for DEPS.
|
;; it's already valid.
|
||||||
(cons (gexp-input thing output) deps)))
|
(cons (gexp-input thing output)
|
||||||
(manifest-entries manifest)))
|
(append-map entry->input deps)))))
|
||||||
|
|
||||||
|
(append-map entry->input (manifest-entries manifest)))
|
||||||
|
|
||||||
(define* (manifest-lookup-package manifest name #:optional version)
|
(define* (manifest-lookup-package manifest name #:optional version)
|
||||||
"Return as a monadic value the first package or store path referenced by
|
"Return as a monadic value the first package or store path referenced by
|
||||||
|
|
|
@ -288,6 +288,42 @@
|
||||||
(manifest-entry-search-paths
|
(manifest-entry-search-paths
|
||||||
(package->manifest-entry mpl)))))
|
(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"
|
(test-assertm "etc/profile"
|
||||||
;; Make sure we get an 'etc/profile' file that at least defines $PATH.
|
;; Make sure we get an 'etc/profile' file that at least defines $PATH.
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
|
|
Loading…
Reference in New Issue