futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

edit: Use 'specification->location' to read information from the cache.

Browse Source 
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:
Ludovic Courtès 2019-01-13 14:27:10 +01:00
parent 5fbdc9a5aa
commit ee8099f5b6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 85 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
gnu/packages.scm
View File

@ -55,10 +55,12 @@
fold-packages
find-packages-by-name
find-package-locations
find-best-packages-by-name
specification->package
specification->package+output
specification->location
specifications->manifest
generate-package-cache))
@ -274,6 +276,31 @@ decreasing version order."
versions modules symbols)))
(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)
"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
@ -393,6 +420,30 @@ present, return the preferred newest version."
(let-values (((name version) (package-name->name+version spec)))
(%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"))
"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:

29
guix/scripts/edit.scm
View File

@ -1,5 +1,5 @@
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -21,7 +21,6 @@
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
@ -63,14 +62,13 @@ Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n"))
file path))
absolute-file-name))
(define (package->location-specification package)
"Return the location specification for PACKAGE for a typical editor command
(define (location->location-specification location)
"Return the location specification for LOCATION for a typical editor command
line."
(let ((loc (package-location package)))
(list (string-append "+"
(number->string
(location-line loc)))
(search-path* %load-path (location-file loc)))))
(list (string-append "+"
(number->string
(location-line location)))
(search-path* %load-path (location-file location))))
(define (guix-edit . args)
@ -83,18 +81,13 @@ line."
'()))
(with-error-handling
(let* ((specs (reverse (parse-arguments)))
(packages (map specification->package specs)))
(for-each (lambda (package)
(unless (package-location package)
(leave (G_ "source location of package '~a' is unknown~%")
(package-full-name package))))
packages)
(let* ((specs (reverse (parse-arguments)))
(locations (map specification->location specs)))
(catch 'system-error
(lambda ()
(let ((file-names (append-map package->location-specification
packages)))
(let ((file-names (append-map location->location-specification
locations)))
;; Use `system' instead of `exec' in order to sanely handle
;; possible command line arguments in %EDITOR.
(exit (system (string-join (cons (%editor) file-names))))))

23
tests/packages.scm
View File

@ -1131,6 +1131,29 @@
(lambda (key . args)
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")
;;; Local Variables: