> You can if you end up not using the “syntactic constructor” with named > fields (as was the case in my example).
Heh, I used it; it's very handy. I didn't even try to use 'gnu-package-descriptor'. Thanks for your suggestions. Any other comments? If not, I'll create a proper patch (the attached version doesn't honor multiple fields).
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 89a0174..a0e9da5 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Nikita Karetnikov <[email protected]> ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <[email protected]> +;;; Copyright © 2012, 2013 Nikita Karetnikov <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ #:use-module (web response) #:use-module (ice-9 regex) #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) ; http-fetch* #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -74,22 +75,100 @@ (error "download failed:" uri code (response-reason-phrase resp)))))) +(define (http-fetch* uri) + "Return an input port with the textual data at URI, a string." + (let*-values (((resp port) + (http-get* (string->uri uri))) + ((code) + (response-code resp))) + (case code + ((200) + port) + (else + (error "download failed" uri code + (response-reason-phrase resp)))))) + (define %package-list-url (string-append "http://cvs.savannah.gnu.org/"; "viewvc/*checkout*/gnumaint/" "gnupackages.txt?root=womb")) +(define-record-type* <gnu-package-descriptor> + gnu-package-descriptor + make-gnu-package-descriptor + + gnu-package-descriptor? + + (name gnu-package-name) + (mundane-name gnu-package-mundane-name) + (copyright-holder gnu-package-copyright-holder) + (savannah gnu-package-savannah) + (fsd gnu-package-fsd) + (language gnu-package-language) + (logo gnu-package-logo) + (doc-category gnu-package-doc-category) + (doc-summary gnu-package-doc-summary) + (doc-url gnu-package-doc-url) + (download-url gnu-package-download-url) + (gplv3-status gnu-package-gplv3-status) + (activity-status gnu-package-activity-status) + (last-contact gnu-package-last-contact) + (next-contact gnu-package-next-contact) + (note gnu-package-note)) + (define (official-gnu-packages) - "Return a list of GNU packages." - (define %package-line-rx - (make-regexp "^package: (.+)$")) + "Return a list of records, which are GNU packages." + (define (group-package-fields port state) + ;; Return a list of alists. Each alist contains fields of a GNU + ;; package. + (let ((line (read-line port)) + (field-rx (make-regexp "^([[:graph:]]+): (.*)$")) + (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 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)))) + + (define (alist->record alist make keys) + ;; Apply MAKE, which should be a syntactic constructor, to the + ;; values associated with KEYS in ALIST. + (let ((args (map (cut assoc-ref alist <>) keys))) + (apply make args))) - (let ((lst (string-split (http-fetch %package-list-url) #\nl))) - (filter-map (lambda (line) - (and=> (regexp-exec %package-line-rx line) - (cut match:substring <> 1))) - lst))) + (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" "gplv3-status" + "activity-status" "last-contact" "next-contact" + "note"))) + (group-package-fields (http-fetch* %package-list-url) + '(()))))) +;;; XXX: FIXME! (define gnu-package? (memoize (lambda (package)
pgpI2UoUGofe9.pgp
Description: PGP signature
