summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-09-04 17:22:55 +0200
committerLudovic Courtès <ludo@gnu.org>2018-09-04 17:22:55 +0200
commit7e1d229019c1924a2748e5daec2a619e7efbd7d7 (patch)
tree13a9ee538f851ec4ab28d173d75f13d241dc4b85
parent1bf758767d1553594b6d7534ca8c38a2171b5afe (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.scm20
-rw-r--r--tests/inferior.scm26
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")