diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-09-04 17:22:55 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-09-04 17:22:55 +0200 |
| commit | 7e1d229019c1924a2748e5daec2a619e7efbd7d7 (patch) | |
| tree | 13a9ee538f851ec4ab28d173d75f13d241dc4b85 | |
| parent | 1bf758767d1553594b6d7534ca8c38a2171b5afe (diff) | |
inferior: Add home-page and location package accessors.
* guix/inferior.scm (inferior-package-home-page)
(inferior-package-location): New procedures.
* tests/inferior.scm ("inferior-packages"): Test them.
| -rw-r--r-- | guix/inferior.scm | 20 | ||||
| -rw-r--r-- | tests/inferior.scm | 26 |
2 files changed, 35 insertions, 11 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm index 05c8d65deb..af37233a03 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -19,6 +19,7 @@ (define-module (guix inferior) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) + #:use-module ((guix utils) #:select (source-properties->location)) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:export (inferior? @@ -33,7 +34,9 @@ inferior-packages inferior-package-synopsis - inferior-package-description)) + inferior-package-description + inferior-package-home-page + inferior-package-location)) ;;; Commentary: ;;; @@ -198,3 +201,18 @@ TRANSLATE? is true, translate it to the current locale's language." (if translate? '(compose (@ (guix ui) P_) package-description) 'package-description))) + +(define (inferior-package-home-page package) + "Return the home page of PACKAGE." + (inferior-package-field package 'package-home-page)) + +(define (inferior-package-location package) + "Return the source code location of PACKAGE, either #f or a <location> +record." + (source-properties->location + (inferior-package-field package + '(compose (lambda (loc) + (and loc + (location->source-properties + loc))) + package-location)))) diff --git a/tests/inferior.scm b/tests/inferior.scm index 5e0f8ae66e..ff5cad4210 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -45,9 +45,11 @@ (test-equal "inferior-packages" (take (sort (fold-packages (lambda (package lst) - (alist-cons (package-name package) + (cons (list (package-name package) (package-version package) - lst)) + (package-home-page package) + (package-location package)) + lst)) '()) (lambda (x y) (string<? (car x) (car y)))) @@ -56,14 +58,18 @@ #:command "scripts/guix")) (packages (inferior-packages inferior))) (and (every string? (map inferior-package-synopsis packages)) - (begin + (let () + (define result + (take (sort (map (lambda (package) + (list (inferior-package-name package) + (inferior-package-version package) + (inferior-package-home-page package) + (inferior-package-location package))) + packages) + (lambda (x y) + (string<? (car x) (car y)))) + 10)) (close-inferior inferior) - (take (sort (map (lambda (package) - (cons (inferior-package-name package) - (inferior-package-version package))) - packages) - (lambda (x y) - (string<? (car x) (car y)))) - 10))))) + result)))) (test-end "inferior") |