futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions 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

122
guix/scripts/package.scm
View File

@ -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,11 +1092,9 @@ more information.~%"))
(_ #f))
opts))
(else
(let*-values (((manifest)
(profile-manifest profile))
((install* drv)
(options->installable opts manifest)))
(let* ((remove (filter-map (match-lambda
(let* ((manifest (profile-manifest profile))
(install* (options->installable opts manifest))
(remove (filter-map (match-lambda
(('remove . package)
package)
(_ #f))
@ -1111,25 +1112,23 @@ more information.~%"))
result))))
(manifest-entries
(manifest-remove manifest remove))
install*))))
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) drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
(show-what-to-build (%store) (list prof-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))
(let* ((prof (derivation->output-path prof-drv))
(number (generation-number profile))
;; Always use NUMBER + 1 for the new profile,
@ -1137,17 +1136,7 @@ more information.~%"))
;; 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)))
(and (build-derivations (%store) (list prof-drv))
(let ((count (length entries)))
(switch-symlinks name prof)
(switch-symlinks profile name)
@ -1156,7 +1145,7 @@ more information.~%"))
count)
count)
(display-search-paths entries
profile))))))))))))
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?)