Factorize package search between 'guix package' and 'guix build'.
* guix/scripts/package.scm (newest-available-packages): Remove. (find-best-packages-by-name): Move to... * gnu/packages.scm (find-best-packages-by-name): ... here. (find-newest-available-packages): Memoize. * guix/scripts/build.scm (specification->package): New procedure, formerly called 'find-package' within 'guix-build'. (guix-build): Adjust accordingly.
This commit is contained in:
parent
0820098d1c
commit
3f26bfc18a
|
@ -33,6 +33,7 @@
|
||||||
%bootstrap-binaries-path
|
%bootstrap-binaries-path
|
||||||
fold-packages
|
fold-packages
|
||||||
find-packages-by-name
|
find-packages-by-name
|
||||||
|
find-best-packages-by-name
|
||||||
find-newest-available-packages))
|
find-newest-available-packages))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
@ -148,24 +149,36 @@ then only return packages whose version is equal to VERSION."
|
||||||
result))
|
result))
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
(define (find-newest-available-packages)
|
(define find-newest-available-packages
|
||||||
"Return a vhash keyed by package names, and with
|
(memoize
|
||||||
|
(lambda ()
|
||||||
|
"Return a vhash keyed by package names, and with
|
||||||
associated values of the form
|
associated values of the form
|
||||||
|
|
||||||
(newest-version newest-package ...)
|
(newest-version newest-package ...)
|
||||||
|
|
||||||
where the preferred package is listed first."
|
where the preferred package is listed first."
|
||||||
|
|
||||||
;; FIXME: Currently, the preferred package is whichever one
|
;; FIXME: Currently, the preferred package is whichever one
|
||||||
;; was found last by 'fold-packages'. Find a better solution.
|
;; was found last by 'fold-packages'. Find a better solution.
|
||||||
(fold-packages (lambda (p r)
|
(fold-packages (lambda (p r)
|
||||||
(let ((name (package-name p))
|
(let ((name (package-name p))
|
||||||
(version (package-version p)))
|
(version (package-version p)))
|
||||||
(match (vhash-assoc name r)
|
(match (vhash-assoc name r)
|
||||||
((_ newest-so-far . pkgs)
|
((_ newest-so-far . pkgs)
|
||||||
(case (version-compare version newest-so-far)
|
(case (version-compare version newest-so-far)
|
||||||
((>) (vhash-cons name `(,version ,p) r))
|
((>) (vhash-cons name `(,version ,p) r))
|
||||||
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
|
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
|
||||||
((<) r)))
|
((<) r)))
|
||||||
(#f (vhash-cons name `(,version ,p) r)))))
|
(#f (vhash-cons name `(,version ,p) r)))))
|
||||||
vlist-null))
|
vlist-null))))
|
||||||
|
|
||||||
|
(define (find-best-packages-by-name name version)
|
||||||
|
"If version is #f, return the list of packages named NAME with the highest
|
||||||
|
version numbers; otherwise, return the list of packages named NAME and at
|
||||||
|
VERSION."
|
||||||
|
(if version
|
||||||
|
(find-packages-by-name name version)
|
||||||
|
(match (vhash-assoc name (find-newest-available-packages))
|
||||||
|
((_ version pkgs ...) pkgs)
|
||||||
|
(#f '()))))
|
||||||
|
|
|
@ -32,8 +32,7 @@
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:autoload (gnu packages) (find-packages-by-name
|
#:autoload (gnu packages) (find-best-packages-by-name)
|
||||||
find-newest-available-packages)
|
|
||||||
#:export (guix-build))
|
#:export (guix-build))
|
||||||
|
|
||||||
(define %store
|
(define %store
|
||||||
|
@ -57,6 +56,27 @@ derivation of a package."
|
||||||
((? procedure? proc)
|
((? procedure? proc)
|
||||||
(run-with-store (%store) (proc) #:system system))))
|
(run-with-store (%store) (proc) #:system system))))
|
||||||
|
|
||||||
|
(define (specification->package spec)
|
||||||
|
"Return a package matching SPEC. SPEC may be a package name, or a package
|
||||||
|
name followed by a hyphen and a version number. If the version number is not
|
||||||
|
present, return the preferred newest version."
|
||||||
|
(let-values (((name version)
|
||||||
|
(package-name->name+version spec)))
|
||||||
|
(match (find-best-packages-by-name name version)
|
||||||
|
((p) ; one match
|
||||||
|
p)
|
||||||
|
((p x ...) ; several matches
|
||||||
|
(warning (_ "ambiguous package specification `~a'~%") spec)
|
||||||
|
(warning (_ "choosing ~a from ~a~%")
|
||||||
|
(package-full-name p)
|
||||||
|
(location->string (package-location p)))
|
||||||
|
p)
|
||||||
|
(_ ; no matches
|
||||||
|
(if version
|
||||||
|
(leave (_ "~A: package not found for version ~a~%")
|
||||||
|
name version)
|
||||||
|
(leave (_ "~A: unknown package~%") name))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Command-line options.
|
;;; Command-line options.
|
||||||
|
@ -212,38 +232,6 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
||||||
(leave (_ "failed to create GC root `~a': ~a~%")
|
(leave (_ "failed to create GC root `~a': ~a~%")
|
||||||
root (strerror (system-error-errno args)))))))
|
root (strerror (system-error-errno args)))))))
|
||||||
|
|
||||||
(define newest-available-packages
|
|
||||||
(memoize find-newest-available-packages))
|
|
||||||
|
|
||||||
(define (find-best-packages-by-name name version)
|
|
||||||
(if version
|
|
||||||
(find-packages-by-name name version)
|
|
||||||
(match (vhash-assoc name (newest-available-packages))
|
|
||||||
((_ version pkgs ...) pkgs)
|
|
||||||
(#f '()))))
|
|
||||||
|
|
||||||
(define (find-package request)
|
|
||||||
;; Return a package matching REQUEST. REQUEST may be a package
|
|
||||||
;; name, or a package name followed by a hyphen and a version
|
|
||||||
;; number. If the version number is not present, return the
|
|
||||||
;; preferred newest version.
|
|
||||||
(let-values (((name version)
|
|
||||||
(package-name->name+version request)))
|
|
||||||
(match (find-best-packages-by-name name version)
|
|
||||||
((p) ; one match
|
|
||||||
p)
|
|
||||||
((p x ...) ; several matches
|
|
||||||
(warning (_ "ambiguous package specification `~a'~%") request)
|
|
||||||
(warning (_ "choosing ~a from ~a~%")
|
|
||||||
(package-full-name p)
|
|
||||||
(location->string (package-location p)))
|
|
||||||
p)
|
|
||||||
(_ ; no matches
|
|
||||||
(if version
|
|
||||||
(leave (_ "~A: package not found for version ~a~%")
|
|
||||||
name version)
|
|
||||||
(leave (_ "~A: unknown package~%") name))))))
|
|
||||||
|
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
;; Ask for absolute file names so that .drv file names passed from the
|
;; Ask for absolute file names so that .drv file names passed from the
|
||||||
;; user to 'read-derivation' are absolute when it returns.
|
;; user to 'read-derivation' are absolute when it returns.
|
||||||
|
@ -268,7 +256,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
||||||
;; Nothing to do; maybe for --log-file.
|
;; Nothing to do; maybe for --log-file.
|
||||||
#f)
|
#f)
|
||||||
(('argument . (? string? x))
|
(('argument . (? string? x))
|
||||||
(let ((p (find-package x)))
|
(let ((p (specification->package x)))
|
||||||
(if src?
|
(if src?
|
||||||
(let ((s (package-source p)))
|
(let ((s (package-source p)))
|
||||||
(package-source-derivation
|
(package-source-derivation
|
||||||
|
|
|
@ -292,19 +292,6 @@ return its return value."
|
||||||
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
|
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
|
||||||
#f))))
|
#f))))
|
||||||
|
|
||||||
(define newest-available-packages
|
|
||||||
(memoize find-newest-available-packages))
|
|
||||||
|
|
||||||
(define (find-best-packages-by-name name version)
|
|
||||||
"If version is #f, return the list of packages named NAME with the highest
|
|
||||||
version numbers; otherwise, return the list of packages named NAME and at
|
|
||||||
VERSION."
|
|
||||||
(if version
|
|
||||||
(find-packages-by-name name version)
|
|
||||||
(match (vhash-assoc name (newest-available-packages))
|
|
||||||
((_ version pkgs ...) pkgs)
|
|
||||||
(#f '()))))
|
|
||||||
|
|
||||||
(define* (specification->package+output spec #:optional (output "out"))
|
(define* (specification->package+output spec #:optional (output "out"))
|
||||||
"Find the package and output specified by SPEC, or #f and #f; SPEC may
|
"Find the package and output specified by SPEC, or #f and #f; SPEC may
|
||||||
optionally contain a version number and an output name, as in these examples:
|
optionally contain a version number and an output name, as in these examples:
|
||||||
|
@ -342,7 +329,7 @@ version; if SPEC does not specify an output, return OUTPUT."
|
||||||
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
|
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
|
||||||
or if the newest available version is equal to CURRENT-VERSION but would have
|
or if the newest available version is equal to CURRENT-VERSION but would have
|
||||||
an output path different than CURRENT-PATH."
|
an output path different than CURRENT-PATH."
|
||||||
(match (vhash-assoc name (newest-available-packages))
|
(match (vhash-assoc name (find-newest-available-packages))
|
||||||
((_ candidate-version pkg . rest)
|
((_ candidate-version pkg . rest)
|
||||||
(case (version-compare candidate-version current-version)
|
(case (version-compare candidate-version current-version)
|
||||||
((>) #t)
|
((>) #t)
|
||||||
|
|
Loading…
Reference in New Issue