From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures. Date: Fri, 22 Mar 2013 05:37:35 +0400 Message-ID: <877gl0kye8.fsf@karetnikov.org> References: <87obfchq38.fsf@karetnikov.org> <87sj4ok6sc.fsf@gnu.org> <87sj48gxzp.fsf_-_@karetnikov.org> <87lia09khe.fsf@gnu.org> <874ngbcfbl.fsf_-_@karetnikov.org> <87vc8rq6ol.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:48419) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIqtN-00009D-RW for bug-guix@gnu.org; Thu, 21 Mar 2013 21:35:42 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UIqtL-0001Io-2g for bug-guix@gnu.org; Thu, 21 Mar 2013 21:35:37 -0400 In-Reply-To: <87vc8rq6ol.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Sun, 17 Mar 2013 00:13:46 +0100") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: bug-guix@gnu.org --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable > Yes, use the wonderful =E2=80=98define-record-type*=E2=80=99 from (guix u= tils). This is > what we use for =E2=80=98package=E2=80=99, etc. See > , > for details. I attached the draft. (I remember about other issues.) But it doesn't work. These lines rise an error: + (cons (gnu-package-descriptor + (inherit (first state)) + ((eval (match-field str) + (interaction-environment)) str)) (There may be other problems. For instance, it should remove fields' names from 'str' before creating a record.) What do you think about the 'eval' idea? It's used to avoid unnecessary repetition. I'll try to pinpoint the cause later. Though, it will save a lot of time if you tell that the whole idea is bad. Or if you already know the cause of the problem. Also, is it possible to create a default value for a field (like #f)? --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=gnu-maintenance.diff Content-Transfer-Encoding: quoted-printable diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 89a0174..3baa460 100644 =2D-- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU =2D;;; Copyright =C2=A9 2012 Nikita Karetnikov ;;; Copyright =C2=A9 2010, 2011, 2012, 2013 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2012, 2013 Nikita Karetnikov ;;; ;;; 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,119 @@ (error "download failed:" uri code (response-reason-phrase resp)))))) =20 +(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=3Dwomb")) =20 +(define-record-type* + 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) =2D "Return a list of GNU packages." =2D (define %package-line-rx =2D (make-regexp "^package: (.+)$")) + "Return the list of records, which are GNU packages." + (define (group-package-fields port state) + (let ((line (read-line port))) + (define (match-field str) + (define empty-descriptor + (gnu-package-descriptor (name #f) + (mundane-name #f) + (copyright-holder #f) + (savannah #f) + (fsd #f) + (language #f) + (logo #f) + (doc-category #f) + (doc-summary #f) + (doc-url #f) + (download-url #f) + (gplv3-status #f) + (activity-status #f) + (last-contact #f) + (next-contact #f) + (note #f))) + + (define field-setter-alist + (list (list "package" 'name) + (list "mundane-name" 'mundane-name) + (list "copyright-holder" 'copyright-holder) + (list "savannah" 'savannah) + (list "fsd" 'fsd) + (list "language" 'language) + (list "logo" 'logo) + (list "doc-category" 'doc-category) + (list "doc-summary" 'doc-summary) + (list "doc-url" 'doc-url) + (list "doc-category" 'doc-category) + (list "download-url" 'download-url) + (list "gplv3-status" 'gplv3-status) + (list "activity-status" 'activity-status) + (list "last-contact" 'last-contact) + (list "next-contact" 'next-contact) + (list "note" 'note))) + + (define (find-setter str) + "Find the right setter for STR." + (define (field-prefix? lst str) + ;; Find the field which is a prefix of STR. + (false-if-exception (string-prefix? (first lst) str))) + + (and=3D> (find (cut field-prefix? <> str) field-setter-alist) + last)) + + (match str + ("" + (group-package-fields port (cons empty-descriptor state))) + (str + (group-package-fields + port + (cons (gnu-package-descriptor + (inherit (first state)) + ((eval (match-field str) + (interaction-environment)) str)) + (drop state 1)))))) + + (if (eof-object? line) + (remove null-list? state) + (match-field line)))) =20 =2D (let ((lst (string-split (http-fetch %package-list-url) #\nl))) =2D (filter-map (lambda (line) =2D (and=3D> (regexp-exec %package-line-rx line) =2D (cut match:substring <> 1))) =2D lst))) + ;; XXX: 'reverse'? + (group-package-fields (http-fetch* %package-list-url) + '(()))) =20 +;;; XXX: FIXME! (define gnu-package? (memoize (lambda (package) --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJRS7XkAAoJEM+IQzI9IQ38XUUP/j3+E9YtqCzBw0K+eO97/sRL v9rSTfepq/VmTW4SwdR9BiQnFN4cl2ormaI3G3staBRxTEGszYQnuoQnRp99Nw3j wrIzk9rj2w6cSe2/uEgCGLyCrb6N8ryW4ezyRBuRlfDCAJOAgRVAkOIdbO7U6f1s DiYZDYvuFEan/GGN76LflkFSjFIejsDuSdxPSAbTu8sKJjNsAyIxvhJTLGGkmqv0 pk3ktE8JPncPpygzfaCClyU4gdBaWvD/9NgQ2/gkP8AfmkBZJ755bgTSuBedzgqZ nr6g6NlbPAVVUSaTLsgWtDag1UugmrCLe2QVWpi6V2VLmbwJ7MHcW1CQUNIezfML quF62VZpfdyg480r8hL45Fd3PY6gXVdaWT+YFg813HL8CGxggSfMpYgsk0RtEe8m B2QkIxWG+gXeobu8dxOMS+ugLLTGYLj6uIoXW1zNkQaRftTaGDyVsGMojrWptj0c tKhPD644ReqwCUqT5Hryqo2F1K9LwgTcNme9EelwbBEPHsfK1meNCMT3gHlThb2S 5ZQAz5zrcih+9GG1Py/AyErmV0DyAQFoiwg5DICyWz5m/dB1guvHJjHcOmtXNJQf v382dbtUhrYqe0E1qT04g4KIJKXLplr+8QC/y/MA4gctYwxDbW7UcT0dVpbGgVxH WZJmHY9vDEXJV0kG4YGi =M18m -----END PGP SIGNATURE----- --==-=-=--