gnu-maintenance: Get descriptions from 'gnumaint/pkgdescr.txt'.

* guix/gnu-maintenance.scm (%gnumaint-base-url): New variable.
  (%package-list-url): Use it.
  (%gsrc-package-list-url): Remove.
  (%package-description-url): New variable.
  (official-gnu-packages): Change to use %PACKAGE-DESCRIPTION-URL
  instead of %GSRC-PACKAGE-LIST-URL.  Adjust recutils field names
  accordingly.
This commit is contained in:
Ludovic Courtès 2013-10-09 13:00:00 +02:00
parent 470d08ffcc
commit 129f9e1173
1 changed files with 18 additions and 16 deletions

View File

@ -75,16 +75,18 @@
;;; List of GNU packages. ;;; List of GNU packages.
;;; ;;;
(define %gnumaint-base-url
"http://cvs.savannah.gnu.org/viewvc/*checkout*/gnumaint/")
(define %package-list-url (define %package-list-url
(string->uri (string->uri
(string-append "http://cvs.savannah.gnu.org/" (string-append %gnumaint-base-url "gnupackages.txt?root=womb")))
"viewvc/*checkout*/gnumaint/"
"gnupackages.txt?root=womb")))
(define %gsrc-package-list-url (define %package-description-url
;; This file is normally kept in sync with GSRC. ;; This file contains package descriptions in recutils format.
;; See <http://lists.gnu.org/archive/html/bug-guix/2013-04/msg00117.html>. ;; See <https://lists.gnu.org/archive/html/guix-devel/2013-10/msg00071.html>.
(string->uri "http://www.gnu.org/software/gsrc/MANIFEST.rec")) (string->uri
(string-append %gnumaint-base-url "pkgdescr.txt?root=womb")))
(define-record-type* <gnu-package-descriptor> (define-record-type* <gnu-package-descriptor>
gnu-package-descriptor gnu-package-descriptor
@ -101,7 +103,7 @@
(logo gnu-package-logo) (logo gnu-package-logo)
(doc-category gnu-package-doc-category) (doc-category gnu-package-doc-category)
(doc-summary gnu-package-doc-summary) (doc-summary gnu-package-doc-summary)
(doc-description gnu-package-doc-description) ; taken from GSRC (doc-description gnu-package-doc-description) ; taken from 'pkgdescr.txt'
(doc-urls gnu-package-doc-urls) ; list of strings (doc-urls gnu-package-doc-urls) ; list of strings
(download-url gnu-package-download-url)) (download-url gnu-package-download-url))
@ -117,19 +119,19 @@
(loop (recutils->alist port) (loop (recutils->alist port)
(cons alist result))))) (cons alist result)))))
(define gsrc-description (define official-description
(let ((gsrc (read-records (http-fetch %gsrc-package-list-url (let ((db (read-records (http-fetch %package-description-url
#:text? #t)))) #:text? #t))))
(lambda (name) (lambda (name)
;; Return the description found in GSRC for package NAME, or #f. ;; Return the description found upstream for package NAME, or #f.
(and=> (find (lambda (alist) (and=> (find (lambda (alist)
(equal? name (assoc-ref alist "Upstream_name"))) (equal? name (assoc-ref alist "package")))
gsrc) db)
(cut assoc-ref <> "Blurb"))))) (cut assoc-ref <> "blurb")))))
(map (lambda (alist) (map (lambda (alist)
(let ((name (assoc-ref alist "package"))) (let ((name (assoc-ref alist "package")))
(alist->record `(("description" . ,(gsrc-description name)) (alist->record `(("description" . ,(official-description name))
,@alist) ,@alist)
make-gnu-package-descriptor make-gnu-package-descriptor
(list "package" "mundane-name" "copyright-holder" (list "package" "mundane-name" "copyright-holder"