TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

guix package: Specify inputs for each manifest entry.

Browse source 
* guix/scripts/package.scm (<manifest-entry>): Add 'inputs' field.
  (manifest=?, lower-input): New procedure.
  (profile-derivation)[builder]: Add #:log-port argument to
  'union-build'.
  [ensure-valid-input]: Remove.
  Add each entry's inputs to the input list.
  (options->installable): Return just the list of entries.
  [package->manifest-entry]: Set 'inputs' field.
  [canonicalize-deps]: Rename to...
  [deduplicate]: ... this.  Remove input fiddling.
  (guix-package)[process-actions]: Use 'manifest=?' to compare the new
  and old manifests.  Pass directly PROF-DRV to 'show-what-to-build'.
  Pass #:print-build-trace #f to 'set-build-options'.
This commit is contained in:
Ludovic Courtès 2013-10-30 22:01:43 +01:00
parent c065c443a0
commit 1fcc3ba309
1 changed files with 92 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

194
guix/scripts/package.scm
View file

@ -91,7 +91,9 @@ (define-record-type* <manifest-entry> manifest-entry
(default "out")) (default "out"))
(path manifest-entry-path) ; store path (path manifest-entry-path) ; store path
(dependencies manifest-entry-dependencies ; list of store paths (dependencies manifest-entry-dependencies ; list of store paths
(default '()))) (default '()))
(inputs manifest-entry-inputs ; list of inputs to build
(default '()))) ; this entry
(define (profile-manifest profile) (define (profile-manifest profile)
"Return the PROFILE's manifest." "Return the PROFILE's manifest."
@ -174,6 +176,13 @@ (define (->bool x)
(string=? entry-name name))) (string=? entry-name name)))
(manifest-entries manifest)))) (manifest-entries manifest))))
(define (manifest=? m1 m2)
"Return #t if manifests M1 and M2 are equal. This differs from 'equal?' in
that the 'inputs' field is ignored for the comparison, since it is know to
have no effect on the manifest contents."
(equal? (manifest->sexp m1)
(manifest->sexp m2)))
;;; ;;;
;;; Profiles. ;;; Profiles.
@ -258,31 +267,28 @@ (define builder
(let ((output (assoc-ref %outputs "out")) (let ((output (assoc-ref %outputs "out"))
(inputs (map cdr %build-inputs))) (inputs (map cdr %build-inputs)))
(format #t "building profile `~a' with ~a packages...~%" (format #t "building profile '~a' with ~a packages...~%"
output (length inputs)) output (length inputs))
(union-build output inputs) (union-build output inputs
#:log-port (%make-void-port "w"))
(call-with-output-file (string-append output "/manifest") (call-with-output-file (string-append output "/manifest")
(lambda (p) (lambda (p)
(pretty-print ',(manifest->sexp manifest) p)))))) (pretty-print ',(manifest->sexp manifest) p))))))
(define ensure-valid-input
;; If a package object appears in the given input, turn it into a
;; derivation path.
(match-lambda
((name (? package? p) sub-drv ...)
`(,name ,(package-derivation (%store) p) ,@sub-drv))
(input
input)))
(build-expression->derivation store "profile" (build-expression->derivation store "profile"
(%current-system) (%current-system)
builder builder
(append-map (match-lambda (append-map (match-lambda
(($ <manifest-entry> name version
output path deps (inputs ..1))
(map (cute lower-input
(%store) <>)
inputs))
(($ <manifest-entry> name version (($ <manifest-entry> name version
output path deps) output path deps)
`((,name ,path) ;; Assume PATH and DEPS are
,@(map ensure-valid-input ;; already valid.
deps)))) `((,name ,path) ,@deps)))
(manifest-entries manifest)) (manifest-entries manifest))
#:modules '((guix build union)))) #:modules '((guix build union))))
@ -429,6 +435,16 @@ (define matches?
(package-name p2)))) (package-name p2))))
same-location?)) same-location?))
(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 (input->name+path input) (define (input->name+path input)
"Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple." "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
(let loop ((input input)) (let loop ((input input))
@ -790,12 +806,10 @@ (define %options
(define (options->installable opts manifest) (define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
return two values: the new list of manifest entries, and the list of return the new list of manifest entries."
derivations that need to be built." (define (deduplicate deps)
(define (canonicalize-deps deps) ;; Remove duplicate entries from DEPS, a list of propagated inputs, where
;; Remove duplicate entries from DEPS, a list of propagated inputs, ;; each input is a name/path tuple.
;; where each input is a name/path tuple, and replace package objects with
;; store paths.
(define (same? d1 d2) (define (same? d1 d2)
(match d1 (match d1
((_ p1) ((_ p1)
@ -809,12 +823,7 @@ (define (same? d1 d2)
(eq? p1 p2))) (eq? p1 p2)))
(_ #f))))) (_ #f)))))
(map (match-lambda (delete-duplicates deps same?))
((name package)
(list name (package-output (%store) package)))
((name package output)
(list name (package-output (%store) package output))))
(delete-duplicates deps same?)))
(define (package->manifest-entry p output) (define (package->manifest-entry p output)
;; Return a manifest entry for the OUTPUT of package P. ;; Return a manifest entry for the OUTPUT of package P.
@ -823,13 +832,15 @@ (define (package->manifest-entry p output)
;; outputs (XXX). ;; outputs (XXX).
(let* ((output (or output (car (package-outputs p)))) (let* ((output (or output (car (package-outputs p))))
(path (package-output (%store) p output)) (path (package-output (%store) p output))
(deps (package-transitive-propagated-inputs p))) (deps (deduplicate (package-transitive-propagated-inputs p))))
(manifest-entry (manifest-entry
(name (package-name p)) (name (package-name p))
(version (package-version p)) (version (package-version p))
(output output) (output output)
(path path) (path path)
(dependencies (canonicalize-deps deps))))) (dependencies (map input->name+path deps))
(inputs (cons (list (package-name p) p output)
deps)))))
(define upgrade-regexps (define upgrade-regexps
(filter-map (match-lambda (filter-map (match-lambda
@ -895,15 +906,7 @@ (define to-install
(_ #f)) (_ #f))
opts))) opts)))
(define derivations (append to-upgrade to-install))
(map (match-lambda
((package output)
;; FIXME: We should really depend on just OUTPUT rather than on all
;; the outputs of PACKAGE.
(package-derivation (%store) package)))
(append packages-to-install packages-to-upgrade)))
(values (append to-upgrade to-install) derivations))
;;; ;;;
@ -1089,74 +1092,60 @@ (define (delete-generation number)
(_ #f)) (_ #f))
opts)) opts))
(else (else
(let*-values (((manifest) (let* ((manifest (profile-manifest profile))
(profile-manifest profile)) (install* (options->installable opts manifest))
((install* drv) (remove (filter-map (match-lambda
(options->installable opts manifest))) (('remove . package)
(let* ((remove (filter-map (match-lambda package)
(('remove . package) (_ #f))
package) opts))
(_ #f)) (remove* (filter (cut manifest-installed? manifest <>)
opts)) remove))
(remove* (filter (cut manifest-installed? manifest <>) (entries
remove)) (append install*
(entries (fold (lambda (package result)
(append install* (match package
(fold (lambda (package result) (($ <manifest-entry> name _ out _ ...)
(match package (filter (negate
(($ <manifest-entry> name _ out _ ...) (cut same-package? <>
(filter (negate name out))
(cut same-package? <> result))))
name out)) (manifest-entries
result)))) (manifest-remove manifest remove))
(manifest-entries install*)))
(manifest-remove manifest remove)) (new (make-manifest entries)))
install*))))
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
(ensure-default-profile)) (ensure-default-profile))
(show-what-to-remove/install remove* install* dry-run?) (if (manifest=? new manifest)
(show-what-to-build (%store) drv (format (current-error-port) (_ "nothing to be done~%"))
#:use-substitutes? (assoc-ref opts 'substitutes?) (let ((prof-drv (profile-derivation (%store) new)))
#:dry-run? dry-run?) (show-what-to-remove/install remove* install* dry-run?)
(show-what-to-build (%store) (list prof-drv)
#:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run? dry-run?)
(or dry-run? (or dry-run?
(and (build-derivations (%store) drv) (let* ((prof (derivation->output-path prof-drv))
(let* ((prof-drv (profile-derivation (%store) (number (generation-number profile))
(make-manifest
entries)))
(prof (derivation->output-path prof-drv))
(old-drv (profile-derivation
(%store) (profile-manifest profile)))
(old-prof (derivation->output-path old-drv))
(number (generation-number profile))
;; Always use NUMBER + 1 for the new profile, ;; Always use NUMBER + 1 for the new profile,
;; possibly overwriting a "previous future ;; possibly overwriting a "previous future
;; generation". ;; generation".
(name (format #f "~a-~a-link" (name (format #f "~a-~a-link"
profile (+ 1 number)))) profile (+ 1 number))))
(if (string=? old-prof prof) (and (build-derivations (%store) (list prof-drv))
(when (or (pair? install*) (pair? remove)) (let ((count (length entries)))
(format (current-error-port) (switch-symlinks name prof)
(_ "nothing to be done~%"))) (switch-symlinks profile name)
(and (parameterize ((current-build-output-port (format #t (N_ "~a package in profile~%"
;; Output something when Guile "~a packages in profile~%"
;; needs to be built. count)
(if (or verbose? (guile-missing?)) count)
(current-error-port) (display-search-paths entries
(%make-void-port "w")))) profile)))))))))))
(build-derivations (%store) (list prof-drv)))
(let ((count (length entries)))
(switch-symlinks name prof)
(switch-symlinks profile name)
(format #t (N_ "~a package in profile~%"
"~a packages in profile~%"
count)
count)
(display-search-paths entries
profile))))))))))))
(define (process-query opts) (define (process-query opts)
;; Process any query specified by OPTS. Return #t when a query was ;; Process any query specified by OPTS. Return #t when a query was
@ -1266,6 +1255,7 @@ (define (list-generation number)
(with-error-handling (with-error-handling
(parameterize ((%store (open-connection))) (parameterize ((%store (open-connection)))
(set-build-options (%store) (set-build-options (%store)
#:print-build-trace #f
#:fallback? (assoc-ref opts 'fallback?) #:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes? #:use-substitutes?
(assoc-ref opts 'substitutes?) (assoc-ref opts 'substitutes?)