aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-07-10 22:33:40 +0200
committerLudovic Courtès <ludo@gnu.org>2013-07-10 22:34:03 +0200
commitc4ca9411f945e229d8cc1c455768a9364c19f84b (patch)
tree32f1c24b6af6a5bc5c3e519efd77be32ac0088f0
parent836d10f154275e56c7185c1fcd6daee2027b41de (diff)
downloadguix-c4ca9411f945e229d8cc1c455768a9364c19f84b.tar
guix-c4ca9411f945e229d8cc1c455768a9364c19f84b.tar.gz
gnu-maintenance: Add `doc-description' field to <gnu-package-descriptor>.
* guix/gnu-maintenance.scm (%gsrc-package-list-url): New variable. (<gnu-package-descriptor>): Add `doc-description' field. (official-gnu-packages)[group-package-fields]: Rename to... [read-records]: ... this. Reverse the result. [gsrc-description]: New procedure. Add the "description" field to the alist passed to `alist->record'.
-rw-r--r--guix/gnu-maintenance.scm43
1 files changed, 31 insertions, 12 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index f9f2fbb8e3..f34930a37b 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -48,6 +48,7 @@
gnu-package-logo
gnu-package-doc-category
gnu-package-doc-summary
+ gnu-package-doc-description
gnu-package-doc-urls
gnu-package-download-url
@@ -80,6 +81,11 @@
"viewvc/*checkout*/gnumaint/"
"gnupackages.txt?root=womb")))
+(define %gsrc-package-list-url
+ ;; This file is normally kept in sync with GSRC.
+ ;; See <http://lists.gnu.org/archive/html/bug-guix/2013-04/msg00117.html>.
+ (string->uri "http://www.gnu.org/software/gsrc/MANIFEST.rec"))
+
(define-record-type* <gnu-package-descriptor>
gnu-package-descriptor
make-gnu-package-descriptor
@@ -95,31 +101,44 @@
(logo gnu-package-logo)
(doc-category gnu-package-doc-category)
(doc-summary gnu-package-doc-summary)
+ (doc-description gnu-package-doc-description) ; taken from GSRC
(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)
+ (define (read-records port)
;; Return a list of alists. Each alist contains fields of a GNU
;; package.
(let loop ((alist (recutils->alist port))
(result '()))
(if (null? alist)
- result
+ (reverse result)
(loop (recutils->alist port)
(cons alist result)))))
- (reverse
- (map (lambda (alist)
- (alist->record alist
- make-gnu-package-descriptor
- (list "package" "mundane-name" "copyright-holder"
- "savannah" "fsd" "language" "logo"
- "doc-category" "doc-summary" "doc-url"
- "download-url")
- '("doc-url" "language")))
- (group-package-fields (http-fetch %package-list-url #:text? #t)))))
+ (define gsrc-description
+ (let ((gsrc (read-records (http-fetch %gsrc-package-list-url
+ #:text? #t))))
+ (lambda (name)
+ ;; Return the description found in GSRC for package NAME, or #f.
+ (and=> (find (lambda (alist)
+ (equal? name (assoc-ref alist "Upstream_name")))
+ gsrc)
+ (cut assoc-ref <> "Blurb")))))
+
+ (map (lambda (alist)
+ (let ((name (assoc-ref alist "package")))
+ (alist->record `(("description" . ,(gsrc-description name))
+ ,@alist)
+ make-gnu-package-descriptor
+ (list "package" "mundane-name" "copyright-holder"
+ "savannah" "fsd" "language" "logo"
+ "doc-category" "doc-summary" "description"
+ "doc-url"
+ "download-url")
+ '("doc-url" "language"))))
+ (read-records (http-fetch %package-list-url #:text? #t))))
(define (find-packages regexp)
"Find GNU packages which satisfy REGEXP."