mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 13:49:23 -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
|
manifest-matching-entries
|
||||||
|
|
||||||
profile-manifest
|
profile-manifest
|
||||||
|
package->manifest-entry
|
||||||
profile-derivation
|
profile-derivation
|
||||||
generation-number
|
generation-number
|
||||||
generation-numbers
|
generation-numbers
|
||||||
|
@ -105,6 +106,22 @@ (define (profile-manifest profile)
|
||||||
(call-with-input-file file read-manifest)
|
(call-with-input-file file read-manifest)
|
||||||
(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)
|
(define (manifest->gexp manifest)
|
||||||
"Return a representation of MANIFEST as a gexp."
|
"Return a representation of MANIFEST as a gexp."
|
||||||
(define (entry->gexp entry)
|
(define (entry->gexp entry)
|
||||||
|
|
|
@ -641,24 +641,11 @@ (define (same? d1 d2)
|
||||||
|
|
||||||
(delete-duplicates deps same?))
|
(delete-duplicates deps same?))
|
||||||
|
|
||||||
(define (package->manifest-entry p output)
|
(define (package->manifest-entry* package output)
|
||||||
;; Return a manifest entry for the OUTPUT of package P.
|
(check-package-freshness package)
|
||||||
(check-package-freshness p)
|
|
||||||
;; When given a package via `-e', install the first of its
|
;; When given a package via `-e', install the first of its
|
||||||
;; outputs (XXX).
|
;; outputs (XXX).
|
||||||
(let* ((output (or output (car (package-outputs p))))
|
(package->manifest-entry package output))
|
||||||
(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)))))
|
|
||||||
|
|
||||||
(define upgrade-regexps
|
(define upgrade-regexps
|
||||||
(filter-map (match-lambda
|
(filter-map (match-lambda
|
||||||
|
@ -689,7 +676,7 @@ (define packages-to-upgrade
|
||||||
(define to-upgrade
|
(define to-upgrade
|
||||||
(map (match-lambda
|
(map (match-lambda
|
||||||
((package output)
|
((package output)
|
||||||
(package->manifest-entry package output)))
|
(package->manifest-entry* package output)))
|
||||||
packages-to-upgrade))
|
packages-to-upgrade))
|
||||||
|
|
||||||
(define packages-to-install
|
(define packages-to-install
|
||||||
|
@ -707,7 +694,7 @@ (define packages-to-install
|
||||||
(define to-install
|
(define to-install
|
||||||
(append (map (match-lambda
|
(append (map (match-lambda
|
||||||
((package output)
|
((package output)
|
||||||
(package->manifest-entry package output)))
|
(package->manifest-entry* package output)))
|
||||||
packages-to-install)
|
packages-to-install)
|
||||||
(filter-map (match-lambda
|
(filter-map (match-lambda
|
||||||
(('install . (? package?))
|
(('install . (? package?))
|
||||||
|
|
|
@ -18,11 +18,25 @@
|
||||||
|
|
||||||
(define-module (test-profiles)
|
(define-module (test-profiles)
|
||||||
#:use-module (guix 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 (ice-9 match)
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64))
|
||||||
|
|
||||||
;; Test the (guix profile) module.
|
;; 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.
|
;; Example manifest entries.
|
||||||
|
|
||||||
|
@ -87,6 +101,19 @@ (define guile-2.0.9:debug
|
||||||
(null? (manifest-entries m3))
|
(null? (manifest-entries m3))
|
||||||
(null? (manifest-entries m4)))))))
|
(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")
|
(test-end "profiles")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue