Browse Source

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'.
gn-latest-20200428
Ludovic Courtès 8 years ago
parent
commit
1fcc3ba309
  1. 202
      guix/scripts/package.scm

202
guix/scripts/package.scm

@ -91,7 +91,9 @@
(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 @@
(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 @@ the given MANIFEST."
(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 @@ RX."
(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 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(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 @@ derivations that need to be built."
(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 @@ derivations that need to be built."
;; 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 @@ derivations that need to be built."
(_ #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 @@ more information.~%"))
(_ #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 @@ more information.~%"))
(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?)

Loading…
Cancel
Save