nixo
/
guix-devel
1
0
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) (define-module (guix inferior)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module ((guix utils) #:select (source-properties->location))
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
#:export (inferior? #:export (inferior?
@ -33,7 +34,9 @@
inferior-packages inferior-packages
inferior-package-synopsis inferior-package-synopsis
inferior-package-description)) inferior-package-description
inferior-package-home-page
inferior-package-location))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -198,3 +201,18 @@ TRANSLATE? is true, translate it to the current locale's language."
(if translate? (if translate?
'(compose (@ (guix ui) P_) package-description) '(compose (@ (guix ui) P_) package-description)
'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" (test-equal "inferior-packages"
(take (sort (fold-packages (lambda (package lst) (take (sort (fold-packages (lambda (package lst)
(alist-cons (package-name package) (cons (list (package-name package)
(package-version package) (package-version package)
lst)) (package-home-page package)
(package-location package))
lst))
'()) '())
(lambda (x y) (lambda (x y)
(string<? (car x) (car y)))) (string<? (car x) (car y))))
@ -56,14 +58,18 @@
#:command "scripts/guix")) #:command "scripts/guix"))
(packages (inferior-packages inferior))) (packages (inferior-packages inferior)))
(and (every string? (map inferior-package-synopsis packages)) (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) (close-inferior inferior)
(take (sort (map (lambda (package) result))))
(cons (inferior-package-name package)
(inferior-package-version package)))
packages)
(lambda (x y)
(string<? (car x) (car y))))
10)))))
(test-end "inferior") (test-end "inferior")