From 7e1d229019c1924a2748e5daec2a619e7efbd7d7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 4 Sep 2018 17:22:55 +0200
Subject: 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.
---
 guix/inferior.scm  | 20 +++++++++++++++++++-
 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")
-- 
cgit v1.2.3