summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-21 22:36:32 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-21 22:36:32 +0100
commit3f26bfc18a70a65443688d7724e5f97c53855c01 (patch)
tree71c1928fbced3aeb99c2b5a1b9bb2f0a62bdf30b
parent0820098d1ccf63e3e8b44df67dcb4236b78975c6 (diff)
downloadguix-3f26bfc18a70a65443688d7724e5f97c53855c01.tar.gz
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.
-rw-r--r--gnu/packages.scm43
-rw-r--r--guix/scripts/build.scm58
-rw-r--r--guix/scripts/package.scm15
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)