From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures. Date: Sat, 16 Mar 2013 23:30:54 +0400 Message-ID: <874ngbcfbl.fsf_-_@karetnikov.org> References: <87obfchq38.fsf@karetnikov.org> <87sj4ok6sc.fsf@gnu.org> <87sj48gxzp.fsf_-_@karetnikov.org> <87lia09khe.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]:59023) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UGwmm-0004Zo-8B for bug-guix@gnu.org; Sat, 16 Mar 2013 15:29:00 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UGwmi-00043M-J2 for bug-guix@gnu.org; Sat, 16 Mar 2013 15:28:56 -0400 In-Reply-To: <87lia09khe.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Thu, 07 Mar 2013 00:28:13 +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 please, that would be better. I apologize for the delay. What do you think about the attached patch? I noticed that 'guile-gnome' has two 'doc-url' fields. How can I handle this? (I ignored it for now.) Also, is there a better way to create 'gnu-package-descriptor'? Note that I don't want to use setters. For example, it should be possible to match a list of regexps against a list of fields. But I haven't found a way to do so because some fields are optional and I also don't want to rely on their order. > This code is run by the user=E2=80=99s Guile, which may be older than 2.0= .7 > (=E2=80=98http-get*=E2=80=99 was introduced in 2.0.7), so you can=E2=80= =99t rely on it. > What you can do is something along the lines of what (guix build > download) does, but always return a port. Maybe there=E2=80=99s a way to= share > code. But how can I return a port with 'http-get'? ('http-fetch*' is a temporary function.) > I=E2=80=99d rather change =E2=80=98group-packages=E2=80=99 to =E2=80=98re= ad-package-fields=E2=80=99 or something > like that. I changed it to 'group-package-fields' and added some comments. > identity (identity sublst) won't work. If (regexp-exec package-line-rx (first sublst)) returns #t, 'and=3D>' will call 'identity' with the result of 'regexp-exec'. But it should return 'sublst' instead. I also changed 'gnu-package?'. Please test. --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-gnu-maintenance-Improve-official-gnu-packages-add-th.patch Content-Transfer-Encoding: quoted-printable From=20548a5e85ec75678334c2ecbe34cccdb226dbc5a9 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Sat, 16 Mar 2013 18:33:07 +0000 Subject: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures. * guix/gnu-maintenance.scm (http-fetch*): Add it. (): Add it. (official-gnu-packages): Use . (find-packages): Add it. (gnu-package?): Adjust accordingly. =2D-- guix/gnu-maintenance.scm | 147 ++++++++++++++++++++++++++++++++++++++++++= ---- 1 files changed, 136 insertions(+), 11 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 89a0174..ef91055 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,7 +23,9 @@ #:use-module (web response) #:use-module (ice-9 regex) #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (system foreign) @@ -31,10 +33,27 @@ #:use-module (guix utils) #:use-module (guix packages) #:export (official-gnu-packages + find-packages gnu-package? releases latest-release =2D gnu-package-name->name+version)) + gnu-package-name->name+version + get-gnu-package-name + get-gnu-package-mundane-name + get-gnu-package-copyright-holder + get-gnu-package-savannah + get-gnu-package-fsd + get-gnu-package-language + get-gnu-package-logo + get-gnu-package-doc-category + get-gnu-package-doc-summary + get-gnu-package-doc-url + get-gnu-package-download-url + get-gnu-package-gplv3-status + get-gnu-package-activity-status + get-gnu-package-last-contact + get-gnu-package-next-contact + get-gnu-package-note)) =20 ;;; Commentary: ;;; @@ -74,21 +93,124 @@ (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 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) + gnu-package-descriptor? + (package get-gnu-package-name) + (mundane-name get-gnu-package-mundane-name) + (copyright-holder get-gnu-package-copyright-holder) + (savannah get-gnu-package-savannah) + (fsd get-gnu-package-fsd) + (language get-gnu-package-language) + (logo get-gnu-package-logo) + (doc-category get-gnu-package-doc-category) + (doc-summary get-gnu-package-doc-summary) + (doc-url get-gnu-package-doc-url) + (download-url get-gnu-package-download-url) + (gplv3-status get-gnu-package-gplv3-status) + (activity-status get-gnu-package-activity-status) + (last-contact get-gnu-package-last-contact) + (next-contact get-gnu-package-next-contact) + (note get-gnu-package-note)) + (define (official-gnu-packages) "Return a list of GNU packages." =2D (define %package-line-rx =2D (make-regexp "^package: (.+)$")) + (define (group-package-fields port state) + ;; Return a list of lists where /most/ inner lists are the GNU + ;; packages. Note that some lists are not packages at all; they + ;; contain additional information. So it is necessary to filter + ;; the output. + (let ((line (read-line port))) + (define (match-field str) + ;; Packages are separated by empty strings. Each package is + ;; represented as a list. If STR is an empty string, create a new + ;; list to store fields of a different package. Otherwise, add ST= R to + ;; the same list. + (match str + ('"" + (group-package-fields port (cons '() state))) + (str + (group-package-fields port (cons (cons str (first state)) + (drop state 1)))))) + + (if (eof-object? line) + (remove null-list? state) + (match-field line)))) + + (reverse (map reverse + (group-package-fields (http-fetch* %package-list-url) + '(()))))) + +(define (find-packages regexp) + "Find packages that match REGEXP." + (define (create-gnu-package-descriptor package) + (define (field-rx field) + (make-regexp (format #f "^~a: (.+)" field))) + + (define (match-field-rx field str) + (and=3D> (regexp-exec (field-rx field) str) + (cut match:substring <> 1))) + + (gnu-package-descriptor + (any (cut match-field-rx "package" <>) package) + (any (cut match-field-rx "mundane-name" <>) package) + (any (cut match-field-rx "copyright-holder" <>) package) + (any (cut match-field-rx "savannah" <>) package) + (any (cut match-field-rx "fsd" <>) package) + (any (cut match-field-rx "language" <>) package) + (any (cut match-field-rx "logo" <>) package) + (any (cut match-field-rx "doc-category" <>) package) + (any (cut match-field-rx "doc-summary" <>) package) + (any (cut match-field-rx "doc-url" <>) package) + (any (cut match-field-rx "download-url" <>) package) + (any (cut match-field-rx "gplv3-status" <>) package) + (any (cut match-field-rx "activity-status" <>) package) + (any (cut match-field-rx "last-contact" <>) package) + (any (cut match-field-rx "next-contact" <>) package) + (any (cut match-field-rx "note" <>) package))) + + (define (package-line-rx) + (make-regexp (string-append "^package: " regexp "(.?)"))) =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))) + (map (cut create-gnu-package-descriptor <>) + (filter-map (lambda (sublst) + (and=3D> (regexp-exec (package-line-rx) (first sublst= )) + (lambda _ + sublst))) + (official-gnu-packages)))) =20 (define gnu-package? (memoize @@ -97,9 +219,12 @@ network to check in GNU's database." ;; TODO: Find a way to determine that a package is non-GNU without go= ing ;; through the network. =2D (let ((url (and=3D> (package-source package) origin-uri))) + (let ((url (and=3D> (package-source package) origin-uri)) + (pname (package-name package))) (or (and (string? url) (string-prefix? "mirror://gnu" url)) =2D (and (member (package-name package) (official-gnu-packages)) + (and (member pname + (map (cut get-gnu-package-name <>) + (find-packages pname))) #t)))))) =20 =2D-=20 1.7.5.4 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJRRMhyAAoJEM+IQzI9IQ38Fd0QAJCQzLsHAGJFPc0cRds9wL0C zOLaWPeLueQlI1KiYVYonYjaJhhsTO7QcdyYyk1RQB+lI1fww8ewajdBnUW5wx/S ReieRRCB9z9xR+g7upSBo8y5/KZjB2IRo38ENOzUVMjmZqifuX67oZtIlZk2AKNr GoWrBo6bZU2AlRy0OIDM7XPya5nFC1zqqwNGTWdkmixoj1OE56+AaAMF4KvHhqcV VrIzXH0SO67yUUyt4x9QNXQW54YoPlnuytPO+zgMgFBBOs+8bF5vTu9F7n3NV04t q3GlnzZ6B7so2xpTLAdSz66K4q510BrWkDi/dX93kAgTGZjDdqhSadipG40aOnXl OLXcbygnNgbM0ik/+bFw84xvi5na+tj98k2t+4mIG4hdpoJ2wCogruGUwyJzvGzZ /tsZ/cIVM1rx3Enn9QpiOnvMIZpEZfBHN5XhfxhcElmsvNugA3fjSNZSDeiNs1xX p4vrPOaBu0Cp5D9RqJNFo86FgbK4+voqvSTW7TF+3uc3hYTzUQlT5Oi8JR+NJkAK T9TKQ9fZ3UTd005yGEuSTcE//aBpc9LD1iZPEOpS9IQubigRqp1nuLIJ7lq4cDI3 asHj+O9Q5An4+xaNtAEtSEn3KWn5HkLLhbroUf4LOCC54NxogpYu5hYZ5zMERDKg cYWoUfzooXmtIhBkr5J2 =qjHL -----END PGP SIGNATURE----- --==-=-=--