nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2013-07-10 22:33:40 +02:00
parent 836d10f154
commit c4ca9411f9
1 changed files with 31 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
guix/gnu-maintenance.scm
View File

@ -48,6 +48,7 @@
gnu-package-logo gnu-package-logo
gnu-package-doc-category gnu-package-doc-category
gnu-package-doc-summary gnu-package-doc-summary
gnu-package-doc-description
gnu-package-doc-urls gnu-package-doc-urls
gnu-package-download-url gnu-package-download-url
@ -80,6 +81,11 @@
"viewvc/*checkout*/gnumaint/" "viewvc/*checkout*/gnumaint/"
"gnupackages.txt?root=womb"))) "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> (define-record-type* <gnu-package-descriptor>
gnu-package-descriptor gnu-package-descriptor
make-gnu-package-descriptor make-gnu-package-descriptor
@ -95,31 +101,44 @@
(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-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))
(define (official-gnu-packages) (define (official-gnu-packages)
"Return a list of records, which are 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 ;; Return a list of alists. Each alist contains fields of a GNU
;; package. ;; package.
(let loop ((alist (recutils->alist port)) (let loop ((alist (recutils->alist port))
(result '())) (result '()))
(if (null? alist) (if (null? alist)
result (reverse result)
(loop (recutils->alist port) (loop (recutils->alist port)
(cons alist result))))) (cons alist result)))))
(reverse (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) (map (lambda (alist)
(alist->record alist (let ((name (assoc-ref alist "package")))
(alist->record `(("description" . ,(gsrc-description name))
,@alist)
make-gnu-package-descriptor make-gnu-package-descriptor
(list "package" "mundane-name" "copyright-holder" (list "package" "mundane-name" "copyright-holder"
"savannah" "fsd" "language" "logo" "savannah" "fsd" "language" "logo"
"doc-category" "doc-summary" "doc-url" "doc-category" "doc-summary" "description"
"doc-url"
"download-url") "download-url")
'("doc-url" "language"))) '("doc-url" "language"))))
(group-package-fields (http-fetch %package-list-url #:text? #t))))) (read-records (http-fetch %package-list-url #:text? #t))))
(define (find-packages regexp) (define (find-packages regexp)
"Find GNU packages which satisfy REGEXP." "Find GNU packages which satisfy REGEXP."