Move specification->package to gnu/packages.scm.

* guix/scripts/build.scm (specification->package): Move from here...
* gnu/packages.scm: ... to here.
This commit is contained in:
Cyril Roelandt 2014-09-01 01:45:09 +02:00
parent 3af2d27eb3
commit 5e3b388b51
2 changed files with 26 additions and 23 deletions

View File

@ -28,6 +28,7 @@
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-39) #:use-module (srfi srfi-39)
#:export (search-patch #:export (search-patch
@ -45,7 +46,9 @@
package-transitive-dependents package-transitive-dependents
package-covering-dependents package-covering-dependents
check-package-freshness)) check-package-freshness
specification->package))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -326,3 +329,24 @@ but ~a is available upstream~%")
(case key (case key
((getaddrinfo-error ftp-error) #f) ((getaddrinfo-error ftp-error) #f)
(else (apply throw key args)))))) (else (apply throw key args))))))
(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))))))

View File

@ -33,7 +33,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-best-packages-by-name) #:autoload (gnu packages) (specification->package)
#:autoload (guix download) (download-to-store) #:autoload (guix download) (download-to-store)
#:export (%standard-build-options #:export (%standard-build-options
set-build-options-from-command-line set-build-options-from-command-line
@ -41,27 +41,6 @@
guix-build)) guix-build))
(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))))))
(define (register-root store paths root) (define (register-root store paths root)
"Register ROOT as an indirect GC root for all of PATHS." "Register ROOT as an indirect GC root for all of PATHS."
(let* ((root (string-append (canonicalize-path (dirname root)) (let* ((root (string-append (canonicalize-path (dirname root))