summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-07-10 18:08:09 +0200
committerLudovic Courtès <ludo@gnu.org>2013-07-10 21:52:55 +0200
commitb0efe83a8f3d37600b9b31a67dd5265e3e1f1fa7 (patch)
tree86e8e0d24a1a059470901094e4ae6fceca396f52
parentc8772a7a21f954b5e75746529e70edc3a1017249 (diff)
gnu-maintenance: Use `recutils->alist'.
* guix/gnu-maintenance.scm (official-gnu-packages)[group-package-fields]: Rewrite in terms of `recutils->alist'. Remove `state' parameter. Specify "doc-url" and "language" as multiple-value keys in the `alist->record' call.
-rw-r--r--guix/gnu-maintenance.scm67
1 files changed, 13 insertions, 54 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index b460976f4e..f9f2fbb8e3 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -22,7 +22,6 @@
#:use-module (web client)
#:use-module (web response)
#:use-module (ice-9 regex)
- #:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
@@ -92,64 +91,24 @@
(copyright-holder gnu-package-copyright-holder)
(savannah gnu-package-savannah)
(fsd gnu-package-fsd)
- (language gnu-package-language)
+ (language gnu-package-language) ; list of strings
(logo gnu-package-logo)
(doc-category gnu-package-doc-category)
(doc-summary gnu-package-doc-summary)
- (doc-urls gnu-package-doc-urls)
+ (doc-urls gnu-package-doc-urls) ; list of strings
(download-url gnu-package-download-url))
(define (official-gnu-packages)
"Return a list of records, which are GNU packages."
- (define (group-package-fields port state)
+ (define (group-package-fields port)
;; Return a list of alists. Each alist contains fields of a GNU
;; package.
- (let ((line (read-line port))
- (field-rx (make-regexp "^([[:graph:]]+): (.*)$"))
- (doc-urls-rx (make-regexp "^doc-url: (.*)$"))
- (end-rx (make-regexp "^# End. .+Do not remove this line.+")))
-
- (define (match-field str)
- ;; Packages are separated by empty strings. If STR is an
- ;; empty string, create a new list to store fields of a
- ;; different package. Otherwise, match and create a key-value
- ;; pair.
- (match str
- (""
- (group-package-fields port (cons '() state)))
- (str
- (cond ((regexp-exec doc-urls-rx str)
- =>
- (lambda (match)
- (if (equal? (assoc-ref (first state) "doc-urls") #f)
- (group-package-fields
- port (cons (cons (cons "doc-urls"
- (list
- (match:substring match 1)))
- (first state))
- (drop state 1)))
- (group-package-fields
- port (cons (cons (cons "doc-urls"
- (cons (match:substring match 1)
- (assoc-ref (first state)
- "doc-urls")))
- (assoc-remove! (first state)
- "doc-urls"))
- (drop state 1))))))
- ((regexp-exec field-rx str)
- =>
- (lambda (match)
- (group-package-fields
- port (cons (cons (cons (match:substring match 1)
- (match:substring match 2))
- (first state))
- (drop state 1)))))
- (else (group-package-fields port state))))))
-
- (if (or (eof-object? line)
- (regexp-exec end-rx line)) ; don't include dummy fields
- (remove null-list? state)
- (match-field line))))
+ (let loop ((alist (recutils->alist port))
+ (result '()))
+ (if (null? alist)
+ result
+ (loop (recutils->alist port)
+ (cons alist result)))))
(reverse
(map (lambda (alist)
@@ -157,10 +116,10 @@
make-gnu-package-descriptor
(list "package" "mundane-name" "copyright-holder"
"savannah" "fsd" "language" "logo"
- "doc-category" "doc-summary" "doc-urls"
- "download-url")))
- (group-package-fields (http-fetch %package-list-url #:text? #t)
- '(())))))
+ "doc-category" "doc-summary" "doc-url"
+ "download-url")
+ '("doc-url" "language")))
+ (group-package-fields (http-fetch %package-list-url #:text? #t)))))
(define (find-packages regexp)
"Find GNU packages which satisfy REGEXP."