Skip to content
Snippets Groups Projects
Commit 1fcc3ba3 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

guix package: Specify inputs for each manifest entry. 

* 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'.
parent c065c443
No related branches found
No related tags found
Hide whitespace changes
Inline Side-by-side
guix/scripts/package.scm
+ 96
− 106
View file @ 1fcc3ba3
......@@ -91,7 +91,9 @@ (define-record-type* <manifest-entry> manifest-entry
(default "out"))
(path manifest-entry-path) ; store path
(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)
"Return the PROFILE's manifest."
......@@ -174,6 +176,13 @@ (define (->bool x)
(string=? entry-name name)))
(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.
......@@ -258,31 +267,28 @@ (define builder
(let ((output (assoc-ref %outputs "out"))
(inputs (map cdr %build-inputs)))
(format #t "building profile `~a' with ~a packages...~%"
(format #t "building profile '~a' with ~a packages...~%"
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")
(lambda (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"
(%current-system)
builder
(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)
`((,name ,path)
,@(map ensure-valid-input
deps))))
;; Assume PATH and DEPS are
;; already valid.
`((,name ,path) ,@deps)))
(manifest-entries manifest))
#:modules '((guix build union))))
......@@ -429,6 +435,16 @@ (define matches?
(package-name p2))))
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)
"Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
(let loop ((input input))
......@@ -790,12 +806,10 @@ (define %options
(define (options->installable opts manifest)
"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
derivations that need to be built."
(define (canonicalize-deps deps)
;; Remove duplicate entries from DEPS, a list of propagated inputs,
;; where each input is a name/path tuple, and replace package objects with
;; store paths.
return the new list of manifest entries."
(define (deduplicate deps)
;; Remove duplicate entries from DEPS, a list of propagated inputs, where
;; each input is a name/path tuple.
(define (same? d1 d2)
(match d1
((_ p1)
......@@ -809,12 +823,7 @@ (define (same? d1 d2)
(eq? p1 p2)))
(_ #f)))))
(map (match-lambda
((name package)
(list name (package-output (%store) package)))
((name package output)
(list name (package-output (%store) package output))))
(delete-duplicates deps same?)))
(delete-duplicates deps same?))
(define (package->manifest-entry p output)
;; Return a manifest entry for the OUTPUT of package P.
......@@ -823,13 +832,15 @@ (define (package->manifest-entry p output)
;; outputs (XXX).
(let* ((output (or output (car (package-outputs p))))
(path (package-output (%store) p output))
(deps (package-transitive-propagated-inputs p)))
(deps (deduplicate (package-transitive-propagated-inputs p))))
(manifest-entry
(name (package-name p))
(version (package-version p))
(output output)
(path path)
(dependencies (canonicalize-deps deps)))))
(dependencies (map input->name+path deps))
(inputs (cons (list (package-name p) p output)
deps)))))
(define upgrade-regexps
(filter-map (match-lambda
......@@ -895,15 +906,7 @@ (define to-install
(_ #f))
opts)))
(define derivations
(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))
(append to-upgrade to-install))
;;;
......@@ -1089,74 +1092,60 @@ (define (delete-generation number)
(_ #f))
opts))
(else
(let*-values (((manifest)
(profile-manifest profile))
((install* drv)
(options->installable opts manifest)))
(let* ((remove (filter-map (match-lambda
(('remove . package)
package)
(_ #f))
opts))
(remove* (filter (cut manifest-installed? manifest <>)
remove))
(entries
(append install*
(fold (lambda (package result)
(match package
(($ <manifest-entry> name _ out _ ...)
(filter (negate
(cut same-package? <>
name out))
result))))
(manifest-entries
(manifest-remove manifest remove))
install*))))
(when (equal? profile %current-profile)
(ensure-default-profile))
(show-what-to-remove/install remove* install* dry-run?)
(show-what-to-build (%store) drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? dry-run?)
(or dry-run?
(and (build-derivations (%store) drv)
(let* ((prof-drv (profile-derivation (%store)
(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,
;; possibly overwriting a "previous future
;; generation".
(name (format #f "~a-~a-link"
profile (+ 1 number))))
(if (string=? old-prof prof)
(when (or (pair? install*) (pair? remove))
(format (current-error-port)
(_ "nothing to be done~%")))
(and (parameterize ((current-build-output-port
;; Output something when Guile
;; needs to be built.
(if (or verbose? (guile-missing?))
(current-error-port)
(%make-void-port "w"))))
(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))))))))))))
(let* ((manifest (profile-manifest profile))
(install* (options->installable opts manifest))
(remove (filter-map (match-lambda
(('remove . package)
package)
(_ #f))
opts))
(remove* (filter (cut manifest-installed? manifest <>)
remove))
(entries
(append install*
(fold (lambda (package result)
(match package
(($ <manifest-entry> name _ out _ ...)
(filter (negate
(cut same-package? <>
name out))
result))))
(manifest-entries
(manifest-remove manifest remove))
install*)))
(new (make-manifest entries)))
(when (equal? profile %current-profile)
(ensure-default-profile))
(if (manifest=? new manifest)
(format (current-error-port) (_ "nothing to be done~%"))
(let ((prof-drv (profile-derivation (%store) new)))
(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?
(let* ((prof (derivation->output-path prof-drv))
(number (generation-number profile))
;; Always use NUMBER + 1 for the new profile,
;; possibly overwriting a "previous future
;; generation".
(name (format #f "~a-~a-link"
profile (+ 1 number))))
(and (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)
;; Process any query specified by OPTS. Return #t when a query was
......@@ -1266,6 +1255,7 @@ (define (list-generation number)
(with-error-handling
(parameterize ((%store (open-connection)))
(set-build-options (%store)
#:print-build-trace #f
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes?
(assoc-ref opts 'substitutes?)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment