profiles: Switch to gexps.
* guix/profiles.scm (<manifest-entry>)[path]: Rename to... [item]: ... this. Update users. (manifest->sexp): Rename to... (manifest->gexp): ... this. Return a gexp. (lower-input): Remove. (profile-derivation): Remove 'store' parameter, and turn into a monadic procedure. [inputs]: New variable. [builder]: Turn into a gexp. Replace call to 'build-expression->derivation' with call to 'gexp->derivation'. * guix/scripts/package.scm (link-to-empty-profile): Adjust call to 'profile-derivation', and wrap it in 'run-with-store'. (show-what-to-remove/install): Rename 'path' to 'item'. Check whether ITEM is a package, and return its output path if it is. (input->name+path): Remove. (options->installable): Set 'item' to P. (guix-package): Adjust call to 'profile-derivation'. * tests/profiles.scm (guile-2.0.9): Change 'path' to 'item'.
This commit is contained in:
Ludovic Courtès
parent
48704e5b5c
commit
a54c94a40d
|
|
@ -22,6 +22,7 @@
|
|||
#:use-module (guix records)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 ftw)
|
||||
|
|
@ -39,7 +40,7 @@
|
|||
manifest-entry-name
|
||||
manifest-entry-version
|
||||
manifest-entry-output
|
||||
manifest-entry-path
|
||||
manifest-entry-item
|
||||
manifest-entry-dependencies
|
||||
|
||||
manifest-pattern
|
||||
|
|
@ -84,7 +85,7 @@
|
|||
(version manifest-entry-version) ; string
|
||||
(output manifest-entry-output ; string
|
||||
(default "out"))
|
||||
(path manifest-entry-path) ; store path
|
||||
(item manifest-entry-item) ; package | store path
|
||||
(dependencies manifest-entry-dependencies ; list of store paths
|
||||
(default '()))
|
||||
(inputs manifest-entry-inputs ; list of inputs to build
|
||||
|
|
@ -106,17 +107,20 @@
|
|||
(call-with-input-file file read-manifest)
|
||||
(manifest '()))))
|
||||
|
||||
(define (manifest->sexp manifest)
|
||||
"Return a representation of MANIFEST as an sexp."
|
||||
(define (entry->sexp entry)
|
||||
(define (manifest->gexp manifest)
|
||||
"Return a representation of MANIFEST as a gexp."
|
||||
(define (entry->gexp entry)
|
||||
(match entry
|
||||
(($ <manifest-entry> name version path output (deps ...))
|
||||
(list name version path output deps))))
|
||||
(($ <manifest-entry> name version output (? string? path) (deps ...))
|
||||
#~(#$name #$version #$output #$path #$deps))
|
||||
(($ <manifest-entry> name version output (? package? package) (deps ...))
|
||||
#~(#$name #$version #$output
|
||||
(ungexp package (or output "out")) #$deps))))
|
||||
|
||||
(match manifest
|
||||
(($ <manifest> (entries ...))
|
||||
`(manifest (version 1)
|
||||
(packages ,(map entry->sexp entries))))))
|
||||
#~(manifest (version 1)
|
||||
(packages #$(map entry->gexp entries))))))
|
||||
|
||||
(define (sexp->manifest sexp)
|
||||
"Parse SEXP as a manifest."
|
||||
|
|
@ -129,7 +133,7 @@
|
|||
(name name)
|
||||
(version version)
|
||||
(output output)
|
||||
(path path)))
|
||||
(item path)))
|
||||
name version output path)))
|
||||
|
||||
;; Version 1 adds a list of propagated inputs to the
|
||||
|
|
@ -142,7 +146,7 @@
|
|||
(name name)
|
||||
(version version)
|
||||
(output output)
|
||||
(path path)
|
||||
(item path)
|
||||
(dependencies deps)))
|
||||
name version output path deps)))
|
||||
|
||||
|
|
@ -200,50 +204,42 @@ must be a manifest-pattern."
|
|||
;;; Profiles.
|
||||
;;;
|
||||
|
||||
(define* (lower-input store input #:optional (system (%current-system)))
|
||||
"Lower INPUT so that it contains derivations instead of packages."
|
||||
(match input
|
||||
((name (? package? package))
|
||||
`(,name ,(package-derivation store package system)))
|
||||
((name (? package? package) output)
|
||||
`(,name ,(package-derivation store package system)
|
||||
,output))
|
||||
(_ input)))
|
||||
|
||||
(define (profile-derivation store manifest)
|
||||
(define (profile-derivation manifest)
|
||||
"Return a derivation that builds a profile (aka. 'user environment') with
|
||||
the given MANIFEST."
|
||||
(define inputs
|
||||
(append-map (match-lambda
|
||||
(($ <manifest-entry> name version
|
||||
output path deps (inputs ..1))
|
||||
inputs)
|
||||
(($ <manifest-entry> name version output path deps)
|
||||
;; Assume PATH and DEPS are already valid.
|
||||
`((,name ,path) ,@deps)))
|
||||
(manifest-entries manifest)))
|
||||
|
||||
(define builder
|
||||
`(begin
|
||||
(use-modules (ice-9 pretty-print)
|
||||
(guix build union))
|
||||
#~(begin
|
||||
(use-modules (ice-9 pretty-print)
|
||||
(guix build union))
|
||||
|
||||
(setvbuf (current-output-port) _IOLBF)
|
||||
(setvbuf (current-error-port) _IOLBF)
|
||||
(setvbuf (current-output-port) _IOLBF)
|
||||
(setvbuf (current-error-port) _IOLBF)
|
||||
|
||||
(let ((output (assoc-ref %outputs "out"))
|
||||
(inputs (map cdr %build-inputs)))
|
||||
(union-build output inputs
|
||||
#:log-port (%make-void-port "w"))
|
||||
(call-with-output-file (string-append output "/manifest")
|
||||
(lambda (p)
|
||||
(pretty-print ',(manifest->sexp manifest) p))))))
|
||||
(let ((inputs '#$(map (match-lambda
|
||||
((label thing)
|
||||
thing)
|
||||
((label thing output)
|
||||
`(,thing ,output)))
|
||||
inputs)))
|
||||
(union-build #$output inputs
|
||||
#:log-port (%make-void-port "w"))
|
||||
(call-with-output-file (string-append #$output "/manifest")
|
||||
(lambda (p)
|
||||
(pretty-print '#$(manifest->gexp manifest) p))))))
|
||||
|
||||
(build-expression->derivation store "profile" builder
|
||||
#:inputs
|
||||
(append-map (match-lambda
|
||||
(($ <manifest-entry> name version
|
||||
output path deps (inputs ..1))
|
||||
(map (cute lower-input store <>)
|
||||
inputs))
|
||||
(($ <manifest-entry> name version
|
||||
output path deps)
|
||||
;; Assume PATH and DEPS are
|
||||
;; already valid.
|
||||
`((,name ,path) ,@deps)))
|
||||
(manifest-entries manifest))
|
||||
#:modules '((guix build union))
|
||||
#:local-build? #t))
|
||||
(gexp->derivation "profile" builder
|
||||
#:modules '((guix build union))
|
||||
#:local-build? #t))
|
||||
|
||||
(define (profile-regexp profile)
|
||||
"Return a regular expression that matches PROFILE's name and number."
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix profiles)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix config)
|
||||
#:use-module (guix scripts build)
|
||||
|
|
@ -82,7 +83,8 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
|
|||
|
||||
(define (link-to-empty-profile generation)
|
||||
"Link GENERATION, a string, to the empty profile."
|
||||
(let* ((drv (profile-derivation (%store) (manifest '())))
|
||||
(let* ((drv (run-with-store (%store)
|
||||
(profile-derivation (manifest '()))))
|
||||
(prof (derivation->output-path drv "out")))
|
||||
(when (not (build-derivations (%store) (list drv)))
|
||||
(leave (_ "failed to build the empty profile~%")))
|
||||
|
|
@ -205,10 +207,14 @@ packages that will/would be installed and removed."
|
|||
remove))))
|
||||
(_ #f))
|
||||
(match install
|
||||
((($ <manifest-entry> name version output path _) ..1)
|
||||
((($ <manifest-entry> name version output item _) ..1)
|
||||
(let ((len (length name))
|
||||
(install (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>)
|
||||
name version output path)))
|
||||
(install (map (lambda (name version output item)
|
||||
(format #f " ~a-~a\t~a\t~a" name version output
|
||||
(if (package? item)
|
||||
(package-output (%store) item output)
|
||||
item)))
|
||||
name version output item)))
|
||||
(if dry-run?
|
||||
(format (current-error-port)
|
||||
(N_ "The following package would be installed:~%~{~a~%~}~%"
|
||||
|
|
@ -253,17 +259,6 @@ RX."
|
|||
(package-name p2))))
|
||||
same-location?))
|
||||
|
||||
(define (input->name+path input)
|
||||
"Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
|
||||
(let loop ((input input))
|
||||
(match input
|
||||
((name (? package? package))
|
||||
(loop `(,name ,package "out")))
|
||||
((name (? package? package) sub-drv)
|
||||
`(,name ,(package-output (%store) package sub-drv)))
|
||||
(_
|
||||
input))))
|
||||
|
||||
(define %sigint-prompt
|
||||
;; The prompt to jump to upon SIGINT.
|
||||
(make-prompt-tag "interruptible"))
|
||||
|
|
@ -652,14 +647,13 @@ return the new list of manifest entries."
|
|||
;; When given a package via `-e', install the first of its
|
||||
;; outputs (XXX).
|
||||
(let* ((output (or output (car (package-outputs p))))
|
||||
(path (package-output (%store) p output))
|
||||
(deps (deduplicate (package-transitive-propagated-inputs p))))
|
||||
(manifest-entry
|
||||
(name (package-name p))
|
||||
(version (package-version p))
|
||||
(output output)
|
||||
(path path)
|
||||
(dependencies (map input->name+path deps))
|
||||
(item p)
|
||||
(dependencies deps)
|
||||
(inputs (cons (list (package-name p) p output)
|
||||
deps)))))
|
||||
|
||||
|
|
@ -723,7 +717,7 @@ return the new list of manifest entries."
|
|||
(name name)
|
||||
(version version)
|
||||
(output #f)
|
||||
(path path))))
|
||||
(item path))))
|
||||
(_ #f))
|
||||
opts)))
|
||||
|
||||
|
|
@ -932,7 +926,8 @@ more information.~%"))
|
|||
(ensure-default-profile))
|
||||
|
||||
(unless (and (null? install) (null? remove))
|
||||
(let* ((prof-drv (profile-derivation (%store) new))
|
||||
(let* ((prof-drv (run-with-store (%store)
|
||||
(profile-derivation new)))
|
||||
(prof (derivation->output-path prof-drv))
|
||||
(remove (manifest-matching-entries manifest remove)))
|
||||
(show-what-to-remove/install remove install dry-run?)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -30,7 +30,7 @@
|
|||
(manifest-entry
|
||||
(name "guile")
|
||||
(version "2.0.9")
|
||||
(path "/gnu/store/...")
|
||||
(item "/gnu/store/...")
|
||||
(output "out")))
|
||||
|
||||
(define guile-2.0.9:debug
|
||||
|
|
|
|||
Loading…
Reference in New Issue