mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
parent
4ca0b4101d
commit
462f5ccade
3 changed files with 49 additions and 18 deletions
|
@ -51,6 +51,7 @@ (define-module (guix profiles)
|
|||
manifest-matching-entries
|
||||
|
||||
profile-manifest
|
||||
package->manifest-entry
|
||||
profile-derivation
|
||||
generation-number
|
||||
generation-numbers
|
||||
|
@ -105,6 +106,22 @@ (define (profile-manifest profile)
|
|||
(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)
|
||||
|
|
|
@ -641,24 +641,11 @@ (define (same? d1 d2)
|
|||
|
||||
(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 @@ (define packages-to-upgrade
|
|||
(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 @@ (define packages-to-install
|
|||
(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?))
|
||||
|
|
|
@ -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 @@ (define guile-2.0.9:debug
|
|||
(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")
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue