rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2018-09-04 17:22:55 +02:00
parent 1bf758767d
commit 7e1d229019
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 35 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
guix/inferior.scm
View File

@ -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))))

26
tests/inferior.scm
View File

@ -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")