nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
master
Ludovic Courtès 2017-06-06 14:01:12 +02:00
parent a431929d3d
commit 55b4715fd4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 89 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
guix/profiles.scm
View File

@ -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,17 +254,27 @@ 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) ...)))
(manifest (manifest
(map (lambda (name version output path) (map (lambda (name version output path)
(manifest-entry (manifest-entry
(name name) (name name)
(version version) (version version)
(output output) (output output)
(item path) (item path)
(search-paths (infer-search-paths name version)))) (search-paths (infer-search-paths name version))))
name version output path))) name version output path)))
;; Version 1 adds a list of propagated inputs to the ;; 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) (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
(($ <manifest-entry> name version output thing deps) (match-lambda
;; THING may be a package or a file name. In the latter case, (($ <manifest-entry> name version output thing deps)
;; assume it's already valid. Ditto for DEPS. ;; THING may be a package or a file name. In the latter case, assume
(cons (gexp-input thing output) deps))) ;; it's already valid.
(manifest-entries manifest))) (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) (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

36
tests/profiles.scm
View File

@ -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