diff options
| -rw-r--r-- | gnu/packages.scm | 43 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 58 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 15 |
3 files changed, 52 insertions, 64 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index e9f2540b91..8365a00051 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -33,6 +33,7 @@ %bootstrap-binaries-path fold-packages find-packages-by-name + find-best-packages-by-name find-newest-available-packages)) ;;; Commentary: @@ -148,24 +149,36 @@ then only return packages whose version is equal to VERSION." result)) '())) -(define (find-newest-available-packages) - "Return a vhash keyed by package names, and with +(define find-newest-available-packages + (memoize + (lambda () + "Return a vhash keyed by package names, and with associated values of the form (newest-version newest-package ...) where the preferred package is listed first." - ;; FIXME: Currently, the preferred package is whichever one - ;; was found last by 'fold-packages'. Find a better solution. - (fold-packages (lambda (p r) - (let ((name (package-name p)) - (version (package-version p))) - (match (vhash-assoc name r) - ((_ newest-so-far . pkgs) - (case (version-compare version newest-so-far) - ((>) (vhash-cons name `(,version ,p) r)) - ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) - ((<) r))) - (#f (vhash-cons name `(,version ,p) r))))) - vlist-null)) + ;; FIXME: Currently, the preferred package is whichever one + ;; was found last by 'fold-packages'. Find a better solution. + (fold-packages (lambda (p r) + (let ((name (package-name p)) + (version (package-version p))) + (match (vhash-assoc name r) + ((_ newest-so-far . pkgs) + (case (version-compare version newest-so-far) + ((>) (vhash-cons name `(,version ,p) r)) + ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) + ((<) r))) + (#f (vhash-cons name `(,version ,p) r))))) + 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 '())))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index dd9a9b8127..1c6dce0539 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -32,8 +32,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) - #:autoload (gnu packages) (find-packages-by-name - find-newest-available-packages) + #:autoload (gnu packages) (find-best-packages-by-name) #:export (guix-build)) (define %store @@ -57,6 +56,27 @@ derivation of a package." ((? procedure? proc) (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. @@ -212,38 +232,6 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (leave (_ "failed to create GC root `~a': ~a~%") 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 ;; Ask for absolute file names so that .drv file names passed from the ;; 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. #f) (('argument . (? string? x)) - (let ((p (find-package x))) + (let ((p (specification->package x))) (if src? (let ((s (package-source p))) (package-source-derivation diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 49fa457a9c..8c197a741e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -292,19 +292,6 @@ return its return value." (format (current-error-port) " interrupted by signal ~a~%" SIGINT) #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")) "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: @@ -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, or if the newest available version is equal to CURRENT-VERSION but would have 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) (case (version-compare candidate-version current-version) ((>) #t) |