profiles: Add 'package->manifest-entry'.

Suggested by Alex Kost <alezost@gmail.com>.

* guix/scripts/package.scm (options->installable)[package->manifest-entry]:
  Move to (guix profiles).
  [package->manifest-entry*]: New procedure.
  Use it.
* guix/profiles.scm (package->manifest-entry): New procedure.
* tests/profiles.scm (guile-for-build): New variable.
  Call '%guile-for-build'.
  ("profile-derivation"): New test.
This commit is contained in:
Ludovic Courtès 2014-07-26 22:54:40 +02:00
parent 4ca0b4101d
commit 462f5ccade
3 changed files with 49 additions and 18 deletions

View File

@ -51,6 +51,7 @@
manifest-matching-entries
profile-manifest
package->manifest-entry
profile-derivation
generation-number
generation-numbers
@ -105,6 +106,22 @@
(call-with-input-file file read-manifest)
(manifest '()))))
(define* (package->manifest-entry package #:optional output)
"Return a manifest entry for the OUTPUT of package PACKAGE. When OUTPUT is
omitted or #f, use the first output of PACKAGE."
(let ((deps (map (match-lambda
((label package)
`(,package "out"))
((label package output)
`(,package ,output)))
(package-transitive-propagated-inputs package))))
(manifest-entry
(name (package-name package))
(version (package-version package))
(output (or output (car (package-outputs package))))
(item package)
(dependencies (delete-duplicates deps)))))
(define (manifest->gexp manifest)
"Return a representation of MANIFEST as a gexp."
(define (entry->gexp entry)

View File

@ -641,24 +641,11 @@ return the new list of manifest entries."
(delete-duplicates deps same?))
(define (package->manifest-entry p output)
;; Return a manifest entry for the OUTPUT of package P.
(check-package-freshness p)
(define (package->manifest-entry* package output)
(check-package-freshness package)
;; When given a package via `-e', install the first of its
;; outputs (XXX).
(let* ((output (or output (car (package-outputs p))))
(deps (map (match-lambda
((label package)
`(,package "out"))
((label package output)
`(,package ,output)))
(package-transitive-propagated-inputs p))))
(manifest-entry
(name (package-name p))
(version (package-version p))
(output output)
(item p)
(dependencies (delete-duplicates deps)))))
(package->manifest-entry package output))
(define upgrade-regexps
(filter-map (match-lambda
@ -689,7 +676,7 @@ return the new list of manifest entries."
(define to-upgrade
(map (match-lambda
((package output)
(package->manifest-entry package output)))
(package->manifest-entry* package output)))
packages-to-upgrade))
(define packages-to-install
@ -707,7 +694,7 @@ return the new list of manifest entries."
(define to-install
(append (map (match-lambda
((package output)
(package->manifest-entry package output)))
(package->manifest-entry* package output)))
packages-to-install)
(filter-map (match-lambda
(('install . (? package?))

View File

@ -18,11 +18,25 @@
(define-module (test-profiles)
#:use-module (guix profiles)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
#:use-module (srfi srfi-64))
;; Test the (guix profile) module.
(define %store
(open-connection))
(define guile-for-build
(package-derivation %store %bootstrap-guile))
;; Make it the default.
(%guile-for-build guile-for-build)
;; Example manifest entries.
@ -87,6 +101,19 @@
(null? (manifest-entries m3))
(null? (manifest-entries m4)))))))
(test-assert "profile-derivation"
(run-with-store %store
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
(guile (package->derivation %bootstrap-guile))
(drv (profile-derivation (manifest (list entry))))
(profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin"))
(_ (built-derivations (list drv))))
(return (and (file-exists? (string-append bindir "/guile"))
(string=? (dirname (readlink bindir))
(derivation->output-path guile)))))))
(test-end "profiles")