edit: Use 'specification->location' to read information from the cache.
That way 'guix edit' doesn't need to load any package module. * gnu/packages.scm (find-package-locations, specification->location): New procedures. * guix/scripts/edit.scm (package->location-specification): Rename to... (location->location-specification): ... this. Expect a location object instead of a package. (guix-edit): Use 'specification->location' instead of 'specification->package'. * tests/packages.scm ("find-package-locations") ("find-package-locations with cache") ("specification->location"): New tests.
This commit is contained in:
parent
5fbdc9a5aa
commit
ee8099f5b6
|
@ -55,10 +55,12 @@
|
||||||
fold-packages
|
fold-packages
|
||||||
|
|
||||||
find-packages-by-name
|
find-packages-by-name
|
||||||
|
find-package-locations
|
||||||
find-best-packages-by-name
|
find-best-packages-by-name
|
||||||
|
|
||||||
specification->package
|
specification->package
|
||||||
specification->package+output
|
specification->package+output
|
||||||
|
specification->location
|
||||||
specifications->manifest
|
specifications->manifest
|
||||||
|
|
||||||
generate-package-cache))
|
generate-package-cache))
|
||||||
|
@ -274,6 +276,31 @@ decreasing version order."
|
||||||
versions modules symbols)))
|
versions modules symbols)))
|
||||||
(find-packages-by-name/direct name version)))
|
(find-packages-by-name/direct name version)))
|
||||||
|
|
||||||
|
(define* (find-package-locations name #:optional version)
|
||||||
|
"Return a list of version/location pairs corresponding to each package
|
||||||
|
matching NAME and VERSION."
|
||||||
|
(define cache
|
||||||
|
(load-package-cache (current-profile)))
|
||||||
|
|
||||||
|
(if (and cache (cache-is-authoritative?))
|
||||||
|
(match (cache-lookup cache name)
|
||||||
|
(#f '())
|
||||||
|
((#(name versions modules symbols outputs
|
||||||
|
supported? deprecated?
|
||||||
|
files lines columns) ...)
|
||||||
|
(fold (lambda (version* file line column result)
|
||||||
|
(if (and file
|
||||||
|
(or (not version)
|
||||||
|
(version-prefix? version version*)))
|
||||||
|
(alist-cons version* (location file line column)
|
||||||
|
result)
|
||||||
|
result))
|
||||||
|
'()
|
||||||
|
versions files lines columns)))
|
||||||
|
(map (lambda (package)
|
||||||
|
(cons (package-version package) (package-location package)))
|
||||||
|
(find-packages-by-name/direct name version))))
|
||||||
|
|
||||||
(define (find-best-packages-by-name name version)
|
(define (find-best-packages-by-name name version)
|
||||||
"If version is #f, return the list of packages named NAME with the highest
|
"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 numbers; otherwise, return the list of packages named NAME and at
|
||||||
|
@ -393,6 +420,30 @@ present, return the preferred newest version."
|
||||||
(let-values (((name version) (package-name->name+version spec)))
|
(let-values (((name version) (package-name->name+version spec)))
|
||||||
(%find-package spec name version)))
|
(%find-package spec name version)))
|
||||||
|
|
||||||
|
(define (specification->location spec)
|
||||||
|
"Return the location of the highest-numbered package matching SPEC, a
|
||||||
|
specification such as \"guile@2\" or \"emacs\"."
|
||||||
|
(let-values (((name version) (package-name->name+version spec)))
|
||||||
|
(match (find-package-locations name version)
|
||||||
|
(()
|
||||||
|
(if version
|
||||||
|
(leave (G_ "~A: package not found for version ~a~%") name version)
|
||||||
|
(leave (G_ "~A: unknown package~%") name)))
|
||||||
|
(lst
|
||||||
|
(let* ((highest (match lst (((version . _) _ ...) version)))
|
||||||
|
(locations (take-while (match-lambda
|
||||||
|
((version . location)
|
||||||
|
(string=? version highest)))
|
||||||
|
lst)))
|
||||||
|
(match locations
|
||||||
|
(((version . location) . rest)
|
||||||
|
(unless (null? rest)
|
||||||
|
(warning (G_ "ambiguous package specification `~a'~%") spec)
|
||||||
|
(warning (G_ "choosing ~a@~a from ~a~%")
|
||||||
|
name version
|
||||||
|
(location->string location)))
|
||||||
|
location)))))))
|
||||||
|
|
||||||
(define* (specification->package+output spec #:optional (output "out"))
|
(define* (specification->package+output spec #:optional (output "out"))
|
||||||
"Return the package and output specified by SPEC, or #f and #f; SPEC may
|
"Return 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:
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
|
;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -21,7 +21,6 @@
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix scripts)
|
#:use-module (guix scripts)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix packages)
|
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
@ -63,14 +62,13 @@ Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n"))
|
||||||
file path))
|
file path))
|
||||||
absolute-file-name))
|
absolute-file-name))
|
||||||
|
|
||||||
(define (package->location-specification package)
|
(define (location->location-specification location)
|
||||||
"Return the location specification for PACKAGE for a typical editor command
|
"Return the location specification for LOCATION for a typical editor command
|
||||||
line."
|
line."
|
||||||
(let ((loc (package-location package)))
|
(list (string-append "+"
|
||||||
(list (string-append "+"
|
(number->string
|
||||||
(number->string
|
(location-line location)))
|
||||||
(location-line loc)))
|
(search-path* %load-path (location-file location))))
|
||||||
(search-path* %load-path (location-file loc)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define (guix-edit . args)
|
(define (guix-edit . args)
|
||||||
|
@ -83,18 +81,13 @@ line."
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(let* ((specs (reverse (parse-arguments)))
|
(let* ((specs (reverse (parse-arguments)))
|
||||||
(packages (map specification->package specs)))
|
(locations (map specification->location specs)))
|
||||||
(for-each (lambda (package)
|
|
||||||
(unless (package-location package)
|
|
||||||
(leave (G_ "source location of package '~a' is unknown~%")
|
|
||||||
(package-full-name package))))
|
|
||||||
packages)
|
|
||||||
|
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ((file-names (append-map package->location-specification
|
(let ((file-names (append-map location->location-specification
|
||||||
packages)))
|
locations)))
|
||||||
;; Use `system' instead of `exec' in order to sanely handle
|
;; Use `system' instead of `exec' in order to sanely handle
|
||||||
;; possible command line arguments in %EDITOR.
|
;; possible command line arguments in %EDITOR.
|
||||||
(exit (system (string-join (cons (%editor) file-names))))))
|
(exit (system (string-join (cons (%editor) file-names))))))
|
||||||
|
|
|
@ -1131,6 +1131,29 @@
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
key)))
|
key)))
|
||||||
|
|
||||||
|
(test-equal "find-package-locations"
|
||||||
|
(map (lambda (package)
|
||||||
|
(cons (package-version package)
|
||||||
|
(package-location package)))
|
||||||
|
(find-packages-by-name "guile"))
|
||||||
|
(find-package-locations "guile"))
|
||||||
|
|
||||||
|
(test-equal "find-package-locations with cache"
|
||||||
|
(map (lambda (package)
|
||||||
|
(cons (package-version package)
|
||||||
|
(package-location package)))
|
||||||
|
(find-packages-by-name "guile"))
|
||||||
|
(call-with-temporary-directory
|
||||||
|
(lambda (cache)
|
||||||
|
(generate-package-cache cache)
|
||||||
|
(mock ((guix describe) current-profile (const cache))
|
||||||
|
(mock ((gnu packages) cache-is-authoritative? (const #t))
|
||||||
|
(find-package-locations "guile"))))))
|
||||||
|
|
||||||
|
(test-equal "specification->location"
|
||||||
|
(package-location (specification->package "guile@2"))
|
||||||
|
(specification->location "guile@2"))
|
||||||
|
|
||||||
(test-end "packages")
|
(test-end "packages")
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
|
Loading…
Reference in New Issue