[PATCH] gnu-maintenance: Add 'find-package-with-attrs' and '%package-list'.

[PATCH] gnu-maintenance: Add 'find-package-with-attrs' and '%package-list'.

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 799 bytes --]

This patch adds a procedure to fetch information from Womb.

scheme@(guile-user)> ,use (guix gnu-maintenance)
scheme@(guile-user)> (find-package-with-attrs "guix")
$1 = ("package: guix" "logo: /software/guix/graphics/guix-logo.small.png" "doc-category: Sysadmin" "doc-summary: Managing installed software packages and versions" "doc-url: none" "gplv3-status: should-be-ok" "activity-status: newpkg/20121117")

(By the way, we should add 'doc-url'.)

I'd like to simplify it.  For instance, it would be great to find the
needed package using a single 'filter'.  I guess that 'fold' can be
removed too.  

Also, it should be possible to get a single attribute (e.g.,
'doc-summary'), not all of them.  I'll implement that later.

The goal is to use this procedure from 'guix import'.


[-- Attachment #1.2: 0001-gnu-maintenance-Add-find-package-with-attrs-and-pack.patch --]
[-- Type: text/x-diff, Size: 2657 bytes --]

From ce7af670e767f425ccbb732cbe0e74423a194dbf Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Fri, 22 Feb 2013 05:02:33 +0000
Subject: [PATCH] gnu-maintenance: Add 'find-package-with-attrs' and
 '%package-list'.

* guix/gnu-maintenance.scm (%package-list): New variable.
  (find-package-with-attrs): New procedure.
---
 guix/gnu-maintenance.scm |   33 ++++++++++++++++++++++++++++++++-
 1 files changed, 32 insertions(+), 1 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 6475c38..42f4383 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 <nikita@karetnikov.org>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +30,7 @@
   #:use-module (guix ftp-client)
   #:use-module (guix utils)
   #:export (official-gnu-packages
+            find-package-with-attrs
             releases
             latest-release
             gnu-package-name->name+version))
@@ -74,6 +75,36 @@
                   (and=> (regexp-exec %package-line-rx line)
                          (cut match:substring <> 1)))
                 lst)))
+
+(define %package-list
+  (string-split (http-fetch %package-list-url) #\nl))
+
+(define (find-package-with-attrs package)
+  "Return a list that contains PACKAGE and its attributes."
+  (define (split-womb-packages xs ys)
+    ;; Return a list of lists; each inner list represents a package.
+    (define (tail lst)
+      (if (null-list? lst)
+          lst
+          (cdr lst)))
+
+    (cond ((null-list? ys) (filter (lambda (lst)
+                                     (not (null-list? lst)))
+                                   xs))
+          (else (let-values (((xs' ys') (span (lambda (str)
+                                                (not (string-null? str)))
+                                              ys)))
+                  (split-womb-packages (append xs (list xs'))
+                                       (tail ys'))))))
+
+  (let ((package-rx (make-regexp (format #f "^package: ~a$" package)
+                                 regexp/icase))
+        (split-lst (split-womb-packages (list '()) %package-list)))
+    (fold append '()
+          (filter (lambda (x)
+                    (regexp-exec package-rx (car x)))
+                  split-lst))))
+
 \f
 ;;;
 ;;; Latest release.
-- 
1.7.5.4


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Add 'find-package-with-attrs' and '%package-list'.

[Ludovic Courtès]

Hi,

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> This patch adds a procedure to fetch information from Womb.

Nice!

> scheme@(guile-user)> ,use (guix gnu-maintenance)
> scheme@(guile-user)> (find-package-with-attrs "guix")
> $1 = ("package: guix" "logo: /software/guix/graphics/guix-logo.small.png" "doc-category: Sysadmin" "doc-summary: Managing installed software packages and versions" "doc-url: none" "gplv3-status: should-be-ok" "activity-status: newpkg/20121117")

Instead of adding a new procedure, what about having this one replace
‘official-gnu-packages’?  It does basically the same, just provides more
info.

Also, I think it should process fields, and return an alist, or even
better, a ‘gnu-package-descriptor’ record (say).

  (define-record-type <gnu-package-descriptor>
    gnu-package-descriptor?
    (gnu-package-descriptor name logo-url doc-category ...)
    ...
    )

  (official-gnu-packages)
  => (#<gnu-package-descriptor name: "guix" logo-url: "http://..." ...#> ...)

WDYT?

> Also, it should be possible to get a single attribute (e.g.,
> 'doc-summary'), not all of them.  I'll implement that later.

It has to read all of the Womb file anyway, so better return all the
information (like above), and let code filter what it wants.

> The goal is to use this procedure from 'guix import'.

Cool!

> +(define %package-list
> +  (string-split (http-fetch %package-list-url) #\nl))

Please don’t make it a global variable.  Instead, fetch it when it’s
asked.  We could have some sort of a cache eventually, if we happen to
call it several times in a row.

Also, instead of fetching it entirely in memory, rather use ‘http-get*’
(Guile 2.0.7) or ‘(http-get ... #:streaming? #t)’ (Guile 2.0.8) to get
an input port to the file.

Then you can write a loop that processes the package list line-by-line
(using ‘read-line’ from (ice-9 rdelim)), with a basic state machine to
determine if you’ve reach the end of a package descriptor.

> +(define (find-package-with-attrs package)
> +  "Return a list that contains PACKAGE and its attributes."
> +  (define (split-womb-packages xs ys)
> +    ;; Return a list of lists; each inner list represents a package.
> +    (define (tail lst)
> +      (if (null-list? lst)
> +          lst
> +          (cdr lst)))
> +
> +    (cond ((null-list? ys) (filter (lambda (lst)
> +                                     (not (null-list? lst)))
> +                                   xs))
> +          (else (let-values (((xs' ys') (span (lambda (str)
> +                                                (not (string-null? str)))
> +                                              ys)))
> +                  (split-womb-packages (append xs (list xs'))
> +                                       (tail ys'))))))

In general, you should use ‘match’ from (ice-9 match) for these things.
It will make your life brighter.  :-)

HTH,
Ludo’.

[PATCH] gnu-maintenance: Replace 'official-gnu-packages' with 'find-packages'.

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 1074 bytes --]

> Also, I think it should process fields, and return an alist, or even
> better, a ‘gnu-package-descriptor’ record (say).
>
>   (define-record-type <gnu-package-descriptor>
>     gnu-package-descriptor?
>     (gnu-package-descriptor name logo-url doc-category ...)
>     ...
>     )
>
>   (official-gnu-packages)
>   => (#<gnu-package-descriptor name: "guix" logo-url: "http://..." ...#> ...)
>
> WDYT?

Oh, I forgot about this when I was writing the attached patch.  Is it
fine?  Should I rewrite it using records?

I guess that it will work faster if I use 'cons' in 'loop' instead of
'append'.  Is it worth it?

Examples:

scheme@(guile-user)> ,use (guix gnu-maintenance)
scheme@(guile-user)> (find-packages "guix")
$1 = (("package: guix" "logo: /software/guix/graphics/guix-logo.small.png" "doc-category: Sysadmin" "doc-summary: Managing installed software packages and versions" "doc-url: none" "gplv3-status: should-be-ok" "activity-status: newpkg/20121117"))

This one:

  (find-packages "guile")

should return several packages.


[-- Attachment #1.2: 0001-gnu-maintenance-Replace-official-gnu-packages-with-f.patch --]
[-- Type: text/x-diff, Size: 3943 bytes --]

From 85f9588d0502a7dd4a1e2c30f8ba54fcb300cca8 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Wed, 6 Mar 2013 18:24:50 +0000
Subject: [PATCH] gnu-maintenance: Replace 'official-gnu-packages' with
 'find-packages'.

* guix/gnu-maintenance.scm (http-fetch): Use 'http-get*' and return a port.
  (official-gnu-packages): Replace with 'find-packages'.
---
 guix/gnu-maintenance.scm |   56 +++++++++++++++++++++++++++++++--------------
 1 files changed, 38 insertions(+), 18 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index cde31aa..6344ebe 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 <nikita@karetnikov.org>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; 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)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -30,7 +31,7 @@
   #:use-module (guix ftp-client)
   #:use-module (guix utils)
   #:use-module (guix packages)
-  #:export (official-gnu-packages
+  #:export (find-packages
             gnu-package?
             releases
             latest-release
@@ -49,16 +50,16 @@
 ;;;
 
 (define (http-fetch uri)
-  "Return a string containing the textual data at URI, a string."
-  (let*-values (((resp data)
-                (http-get (string->uri uri)))
-               ((code)
-                (response-code resp)))
+  "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)
-       data)
+       port)
       (else
-       (error "download failed:" uri code
+       (error "download failed" uri code
               (response-reason-phrase resp))))))
 
 (define %package-list-url
@@ -66,16 +67,35 @@
                  "viewvc/*checkout*/gnumaint/"
                  "gnupackages.txt?root=womb"))
 
-(define (official-gnu-packages)
-  "Return a list of GNU packages."
-  (define %package-line-rx
-    (make-regexp "^package: (.+)$"))
-
-  (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)))
+(define (find-packages regexp)
+  "Find packages that match REGEXP."
+  (let ((package-line-rx
+         (make-regexp (string-append "^package: " regexp "(.?)"))))
+
+    (define (group-packages port state)
+      ;; Return a list of packages.
+      (let ((line (read-line port)))
+        (define (loop str)
+          (match str
+            ('""
+             (group-packages port (append state '(()))))
+            (str
+             (group-packages port (append (drop-right state 1)
+                                          (list (append (last state)
+                                                        (list str))))))))
+
+        (if (eof-object? line)
+            (filter (lambda (lst)
+                      (not (null-list? lst)))
+                    state)
+            (loop line))))
+
+    (filter-map (lambda (sublst)
+                  (and=> (regexp-exec package-line-rx (first sublst))
+                         (lambda _
+                           sublst)))
+                (group-packages (http-fetch %package-list-url)
+                                '(())))))
 
 (define gnu-package?
   (memoize
-- 
1.7.5.4


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Replace 'official-gnu-packages' with 'find-packages'.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> Also, I think it should process fields, and return an alist, or even
>> better, a ‘gnu-package-descriptor’ record (say).
>>
>>   (define-record-type <gnu-package-descriptor>
>>     gnu-package-descriptor?
>>     (gnu-package-descriptor name logo-url doc-category ...)
>>     ...
>>     )
>>
>>   (official-gnu-packages)
>>   => (#<gnu-package-descriptor name: "guix" logo-url: "http://..." ...#> ...)
>>
>> WDYT?
>
> Oh, I forgot about this when I was writing the attached patch.  Is it
> fine?  Should I rewrite it using records?

Yes please, that would be better.

> I guess that it will work faster if I use 'cons' in 'loop' instead of
> 'append'.  Is it worth it?

In general yes: always cons, and reverse at the end (that makes the
complexity linear.)

> Examples:
>
> scheme@(guile-user)> ,use (guix gnu-maintenance)
> scheme@(guile-user)> (find-packages "guix")
> $1 = (("package: guix" "logo: /software/guix/graphics/guix-logo.small.png" "doc-category: Sysadmin" "doc-summary: Managing installed software packages and versions" "doc-url: none" "gplv3-status: should-be-ok" "activity-status: newpkg/20121117"))

Since it has to read all the package file, I’d rather keep an
‘official-gnu-packages’ that would return a list of all the packages
(we’re talking about less than 1 MiB of RAM), and then use ‘filter’ on
that.

(Alternately, ‘official-gnu-packages’ could be a stream (in the sense of
(ice-9 stream)), but then there’s going to be issues with connection
timeouts, so a plain old list is better.)

> +  "Return an input port with the textual data at URI, a string."
> +  (let*-values (((resp port)
> +                 (http-get* (string->uri uri)))

This code is run by the user’s Guile, which may be older than 2.0.7
(‘http-get*’ was introduced in 2.0.7), so you can’t 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’s a way to share
code.

A couple of stylistic comments:

> +    (define (group-packages port state)
> +      ;; Return a list of packages.
> +      (let ((line (read-line port)))
> +        (define (loop str)
> +          (match str
> +            ('""
> +             (group-packages port (append state '(()))))
> +            (str
> +             (group-packages port (append (drop-right state 1)
> +                                          (list (append (last state)
> +                                                        (list str))))))))

It’s called ‘loop’ but it doesn’t loop.

I’d rather change ‘group-packages’ to ‘read-package-fields’ or something
like that.

> +            (filter (lambda (lst)
> +                      (not (null-list? lst)))
> +                    state)

(remove null-list? state)

> +                  (and=> (regexp-exec package-line-rx (first sublst))
> +                         (lambda _
> +                           sublst)))

identity

Thanks,
Ludo’.

[PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 1365 bytes --]

> 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’s Guile, which may be older than 2.0.7
> (‘http-get*’ was introduced in 2.0.7), so you can’t 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’s a way to share
> code.

But how can I return a port with 'http-get'?  ('http-fetch*' is a
temporary function.)

> I’d rather change ‘group-packages’ to ‘read-package-fields’ 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=>' will call 'identity' with the result of 'regexp-exec'.  But it
should return 'sublst' instead.

I also changed 'gnu-package?'.  Please test.


[-- Attachment #1.2: 0001-gnu-maintenance-Improve-official-gnu-packages-add-th.patch --]
[-- Type: text/x-diff, Size: 8529 bytes --]

From 548a5e85ec75678334c2ecbe34cccdb226dbc5a9 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
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.
  (<gnu-package-descriptor>): Add it.
  (official-gnu-packages): Use <gnu-package-descriptor>.
  (find-packages): Add it.
  (gnu-package?): Adjust accordingly.
---
 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
--- 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 <nikita@karetnikov.org>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; 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
-            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))
 
 ;;; Commentary:
 ;;;
@@ -74,21 +93,124 @@
        (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 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."
-  (define %package-line-rx
-    (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 STR 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=> (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 "(.?)")))
 
-  (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)))
+  (map (cut create-gnu-package-descriptor <>)
+       (filter-map (lambda (sublst)
+                     (and=> (regexp-exec (package-line-rx) (first sublst))
+                            (lambda _
+                              sublst)))
+                   (official-gnu-packages))))
 
 (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 going
      ;; through the network.
-     (let ((url (and=> (package-source package) origin-uri)))
+     (let ((url   (and=> (package-source package) origin-uri))
+           (pname (package-name package)))
        (or (and (string? url) (string-prefix? "mirror://gnu" url))
-           (and (member (package-name package) (official-gnu-packages))
+           (and (member pname
+                        (map (cut get-gnu-package-name <>)
+                             (find-packages pname)))
                 #t))))))
 
 \f
-- 
1.7.5.4


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> I apologize for the delay.  What do you think about the attached patch?

No problem, thanks for working on this!

> I noticed that 'guile-gnome' has two 'doc-url' fields.  How can I handle
> this?  (I ignored it for now.)

I think it’s a mistake in this case (could you report it to Karl?).  It
seems safe to ignore.

> Also, is there a better way to create 'gnu-package-descriptor'?  Note
> that I don't want to use setters.

Yes, use the wonderful ‘define-record-type*’ from (guix utils).  This is
what we use for ‘package’, etc.  See
<http://lists.gnu.org/archive/html/guile-user/2012-11/msg00016.html>,
for details.

>> This code is run by the user’s Guile, which may be older than 2.0.7
>> (‘http-get*’ was introduced in 2.0.7), so you can’t 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’s a way to share
>> code.
>
> But how can I return a port with 'http-get'?

On Guile < 2.0.7, you’ll get a string, so you can just call
‘open-input-string’ to wrap it in a port.

On later versions, you’ll get a port.

>> I’d rather change ‘group-packages’ to ‘read-package-fields’ 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=>' will call 'identity' with the result of 'regexp-exec'.  But it
> should return 'sublst' instead.

Ah, you want (and=> (regexp-exec ...) (const sublst)).
But then, it’s equivalent to just (and (regexp-exec ...) sublst).

> +(define-record-type <gnu-package-descriptor>

Yes, define-record-type* will definitely help.

> +  (package          get-gnu-package-name)

Here the field name should rather be ‘name’, for consistency.

Never ever write ‘get-’ for getters.  ;-)  It provides no useful
information.  See <package> and other records, as examples.

>  (define (official-gnu-packages)
>    "Return a list of GNU packages."

This should return directly a list of <gnu-package-descriptor> IMO, so
‘create-gnu-package-descriptor’ would be moved here.

> +  (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 STR to
> +        ;; the same list.
> +        (match str
> +          ('""

Extra quote.

> +           (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)
> +                                      '(())))))

Apparently ‘create-gnu-package-descriptor’ doesn’t rely on the order of
fields, so (map reverse ...) can be omitted, no?

> +(define (find-packages regexp)
> +  "Find packages that match REGEXP."
> +  (define (create-gnu-package-descriptor package)

s/create-gnu-package-descriptor/alist->package-descriptor/ ?

With a comment saying that PACKAGE is an alist.

>  network to check in GNU's database."
>       ;; TODO: Find a way to determine that a package is non-GNU without going
>       ;; through the network.
> -     (let ((url (and=> (package-source package) origin-uri)))
> +     (let ((url   (and=> (package-source package) origin-uri))
> +           (pname (package-name package)))

s/pname/name/

>         (or (and (string? url) (string-prefix? "mirror://gnu" url))
> -           (and (member (package-name package) (official-gnu-packages))

I think the last expression will become:

  (find (compose (cut equal? name <>) package-name)
        (official-gnu-packages))

Thanks!

Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 993 bytes --]

> Yes, use the wonderful ‘define-record-type*’ from (guix utils).  This is
> what we use for ‘package’, etc.  See
> <http://lists.gnu.org/archive/html/guile-user/2012-11/msg00016.html>,
> 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)?


[-- Attachment #1.2: gnu-maintenance.diff --]
[-- Type: text/x-diff, Size: 5979 bytes --]

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 89a0174..3baa460 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 <nikita@karetnikov.org>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; 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))))))
 
+(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 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=> (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))))
 
-  (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)))
+  ;; XXX: 'reverse'?
+  (group-package-fields (http-fetch* %package-list-url)
+                        '(())))
 
+;;; XXX: FIXME!
 (define gnu-package?
   (memoize
    (lambda (package)

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Brandon Invergo]

>  (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))

FYI we just moved the last/next-contact information into a separate file
in Womb called contact-activity.txt, so I'd imagine that it will be
removed from the gnupackages.txt file at some point.

-brandon

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Brandon Invergo <brandon@invergo.net> skribis:

> FYI we just moved the last/next-contact information into a separate file
> in Womb called contact-activity.txt, so I'd imagine that it will be
> removed from the gnupackages.txt file at some point.

OK, thanks for the heads-up.  It’s not essential for our purposes anyway.

Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

> 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.

“Eval is evil”, as lispers love to say.  It should never be used, unless
there’s a very good reason to do so.

In my unfinished binary substitute where a similar situation arises,
I’ve done this:

  (define (fields->alist port)
    "Read recutils-style record from PORT and return them as a list of key/value
  pairs."
    (define field-rx
      (make-regexp "^([[:graph:]]+): (.*)$"))

    (let loop ((line   (read-line port))
               (result '()))
      (cond ((eof-object? line)
             (reverse result))
            ((regexp-exec field-rx line)
             =>
             (lambda (match)
               (cons (match:substring match 1)
                     (match:substring match 2))))
            (else
             (error "unmatched line" line)))))

  (define (alist->record alist make keys)
    "Apply MAKE to the values associated with KEYS in ALIST."
    (let ((args (map (cut assoc-ref alist <>) keys)))
      (apply make args)))

And then, it is used like this:

         (alist->record properties
                        (cut %make-cache url <...>)
                        '("StoreDir" "WantMassQuery"))

To summarize, the input port containing a list of key/value pairs (like
yours) is first read by ‘fields->alist’, which returns a list of
key/value pairs.

Then ‘alist->record’ converts that alist into a record.  In this
example, it calls ‘%make-cache’ in a way equivalent to:

  (%make-cache (assoc-ref properties "StoreDir")
               (assoc-ref properties "WantMassQuery"))

Here ‘%make-cache’ is the ‘normal’ SRFI-9 constructor, which is called
‘make-gnu-package-descriptor’ in your code.

Let me know if you need more details.

Thanks,
Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 1282 bytes --]

> “Eval is evil”, as lispers love to say.

Yeah, I've heard this one.

> It should never be used, unless there’s a very good reason to do so.

I've heard this too.  But people always fail to explain the "a very good
reason" part.  Any examples?  AFAICT, it just means: "I haven't found a
better solution."

> In my unfinished binary substitute where a similar situation arises,
> I’ve done this:

[...]

> And then, it is used like this:

>          (alist->record properties
>                         (cut %make-cache url <...>)
>                         '("StoreDir" "WantMassQuery"))

So, keys and values are strings here, right?  But I want to store
setters as values.  I can do it without 'eval', but it'll be necessary
to write something like:

(define (field-setter field)
  (list (list "package"
			  (cons (gnu-package-descriptor (inherit (first state))
											(name field))
					(cdr state)))
		(list "mundane-name"
			  (cons (gnu-package-descriptor (inherit (first state))
											(mundane-name field))
					(cdr state)))
		...))
			  
It doesn't look right.

Again, the problem is a need to store setters as values without
repeating (cons (gnu-package-descriptor ...)) for every setter.

Am I missing something?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> “Eval is evil”, as lispers love to say.
>
> Yeah, I've heard this one.
>
>> It should never be used, unless there’s a very good reason to do so.
>
> I've heard this too.  But people always fail to explain the "a very good
> reason" part.

There are many reasons, including: it’s hard to reason about code
generated at run time, it’s easy to generate invalid code, generated
code cannot be compiled & optimized, and evaluating code is much slower
than running compiled code.

>> In my unfinished binary substitute where a similar situation arises,
>> I’ve done this:
>
> [...]
>
>> And then, it is used like this:
>
>>          (alist->record properties
>>                         (cut %make-cache url <...>)
>>                         '("StoreDir" "WantMassQuery"))
>
> So, keys and values are strings here, right?

Keys are strings, and values can be anything.

> But I want to store setters as values.

The suggestion I made was in favor of using a single
‘make-gnu-record-descriptor’ call with all the field values (as opposed
to creating the record with all fields set to #f, and then using
‘setters’ to change them to their actual value.)

In the example above, the end result is a single call to the
constructor, equivalent to:

  (%make-cache url
               (assoc-ref properties "StoreDir")
               (assoc-ref properties "WantMassQuery"))

HTH,
Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 337 bytes --]

> The suggestion I made was in favor of using a single
> ‘make-gnu-record-descriptor’ call with all the field values (as opposed
> to creating the record with all fields set to #f, and then using
> ‘setters’ to change them to their actual value.)

OK.  But why functional setters, then?  Can't I use
'define-record-type'?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> The suggestion I made was in favor of using a single
>> ‘make-gnu-record-descriptor’ call with all the field values (as opposed
>> to creating the record with all fields set to #f, and then using
>> ‘setters’ to change them to their actual value.)
>
> OK.  But why functional setters, then?

They’re great, but here you know all the field values, so it’s more
natural and more efficient to make a single call to the constructor.

> Can't I use 'define-record-type'?

You can if you end up not using the “syntactic constructor” with named
fields (as was the case in my example).

Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 356 bytes --]

> 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).


[-- Attachment #1.2: gnu-maintenance.diff --]
[-- Type: text/x-diff, Size: 5079 bytes --]

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 <nikita@karetnikov.org>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; 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)

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> 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).

Looks good to me!

Nitpicking follows:

> +  #:use-module (ice-9 rdelim)           ; http-fetch*

The comment is misleading.

> +  (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))

I’d remove these 5 fields since Brandon mentioned that at least 2 of
them are being moved elsewhere, and we don’t need them anyway.

(It’s surprising that there’s no ‘license’ field in the file.)

Thanks!

Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Hello!

There was a slight issue with http-get vs. http-get* vs. #:streaming?,
which commit ef8c034 fixes.  (I can imagine that the evolution of this
Guile API is hard to follow from the “outside”...)

Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 1151 bytes --]

>> I noticed that 'guile-gnome' has two 'doc-url' fields.  How can I handle
>> this?  (I ignored it for now.)

> I think it’s a mistake in this case (could you report it to Karl?).  It
> seems safe to ignore.

Karl said:

"[...] In general doc-url can occur more than once.  I did that when a
package has an overall documentation page and also many significant
manuals.  Besides guile-gnome, emacs is a prime example.

In theory, I guess logo: could be duplicated [too] in the event of a
package having more than one logo, but in practice that has never
happened.

[...]

I thought of another field that can be repeated, too: doc-shop.
E.g., in libc."

So, should we create another field for 'doc-url'?

And what's the best way to handle 'doc-shop'?  Can we ignore it?

> Never ever write ‘get-’ for getters.  ;-)  It provides no useful
> information.  See <package> and other records, as examples.

I know; it's easy to end up with something like:

  getObject.getSetter.getString.getField()

I found (name get-employee-name) in the manual and decided that it's a
convention.

What about 'set-' for setters?

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add the related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>>> I noticed that 'guile-gnome' has two 'doc-url' fields.  How can I handle
>>> this?  (I ignored it for now.)
>
>> I think it’s a mistake in this case (could you report it to Karl?).  It
>> seems safe to ignore.
>
> Karl said:
>
> "[...] In general doc-url can occur more than once.  I did that when a
> package has an overall documentation page and also many significant
> manuals.  Besides guile-gnome, emacs is a prime example.
>
> In theory, I guess logo: could be duplicated [too] in the event of a
> package having more than one logo, but in practice that has never
> happened.
>
> [...]
>
> I thought of another field that can be repeated, too: doc-shop.
> E.g., in libc."
>
> So, should we create another field for 'doc-url'?

What about calling that field ‘doc-urls’ (plural) and having it hold a
list of URLs?

> And what's the best way to handle 'doc-shop'?  Can we ignore it?

What is it?  Perhaps we don’t need it for our purposes?

>> Never ever write ‘get-’ for getters.  ;-)  It provides no useful
>> information.  See <package> and other records, as examples.
>
> I know; it's easy to end up with something like:
>
>   getObject.getSetter.getString.getField()
>
> I found (name get-employee-name) in the manual and decided that it's a
> convention.

Argh, I just saw that, it’s a shame!  ;-)

Seriously, nobody uses that convention.  The convention is really
‘employee-name’.

> What about 'set-' for setters?

We don’t use them in Guix.  (The convention is ‘set-employee-name!’,
with an exclamation mark.)

Ludo’.

[PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add related procedures.

[Nikita Karetnikov]

[-- Attachment #1.1: Type: text/plain, Size: 1238 bytes --]

I'm attaching the patch.

> What about calling that field ‘doc-urls’ (plural) and having it hold a
> list of URLs?

Done.

By the way, some fields return "none."  Should it be converted to #f?

>> And what's the best way to handle 'doc-shop'?  Can we ignore it?

> What is it?

FSF's shop.

> Perhaps we don’t need it for our purposes?

I think so.

> On Guile < 2.0.7, you’ll get a string, so you can just call
> ‘open-input-string’ to wrap it in a port.

> On later versions, you’ll get a port.

I'm using 2.0.7; 'http-get' returns a string.  I used the following:

+             ((string<=? (version) "2.0.7")
+              (open-input-string data))
+             (else data)))

>> +  (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))

> I’d remove these 5 fields since Brandon mentioned that at least 2 of
> them are being moved elsewhere, and we don’t need them anyway.

Done.

> (It’s surprising that there’s no ‘license’ field in the file.)

I'll ask Karl about this.


[-- Attachment #1.2: 0001-gnu-maintenance-Improve-official-gnu-packages-add-re.patch --]
[-- Type: text/x-diff, Size: 9799 bytes --]

From fdbda64e75e31782a7f08ade46b1ea01a5fd06d3 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Thu, 28 Mar 2013 01:50:31 +0000
Subject: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add
 related procedures.

* guix/gnu-maintenance.scm (http-fetch): Return an input port.
  (<gnu-package-descriptor>): Add it.
  (official-gnu-packages): Use <gnu-package-descriptor>.
  (find-packages): Add it.
  (gnu-package?): Adjust accordingly.
---
 guix/gnu-maintenance.scm |  161 +++++++++++++++++++++++++++++++++++++--------
 1 files changed, 132 insertions(+), 29 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 89a0174..28c301f 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 <nikita@karetnikov.org>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +22,7 @@
   #:use-module (web client)
   #:use-module (web response)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -30,8 +31,22 @@
   #:use-module (guix ftp-client)
   #:use-module (guix utils)
   #:use-module (guix packages)
-  #:export (official-gnu-packages
+  #:export (gnu-package-name
+            gnu-package-mundane-name
+            gnu-package-copyright-holder
+            gnu-package-savannah
+            gnu-package-fsd
+            gnu-package-language
+            gnu-package-logo
+            gnu-package-doc-category
+            gnu-package-doc-summary
+            gnu-package-doc-urls
+            gnu-package-download-url
+
+            official-gnu-packages
+            find-packages
             gnu-package?
+
             releases
             latest-release
             gnu-package-name->name+version))
@@ -49,29 +64,32 @@
 ;;;
 
 (define (http-fetch uri)
-  "Return a string containing the textual data at URI, a string."
+  "Return an input port containing the textual data at URI, a string."
   (let*-values (((resp data)
                 (http-get (string->uri uri)))
                ((code)
                 (response-code resp)))
     (case code
       ((200)
-       (if data
-           data
-           (begin
-             ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
-             ;; encoding, which is required when fetching %PACKAGE-LIST-URL
-             ;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
-             ;; Since users may still be using these versions, warn them and
-             ;; bail out.
-             (format (current-error-port)
-                     "warning: using Guile ~a, which does not support HTTP ~s encoding~%"
-                     (version)
-                     (response-transfer-encoding resp))
-             (error "download failed; use a newer Guile"
-                    uri resp))))
+       (cond ((string<=? (version) "2.0.5")
+              (begin
+                ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
+                ;; encoding, which is required when fetching %PACKAGE-LIST-URL
+                ;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
+                ;; Since users may still be using these versions, warn them and
+                ;; bail out.
+                (format (current-error-port)
+                        "warning: using Guile ~a, ~a ~s encoding~%"
+                        (version)
+                        "which does not support HTTP"
+                        (response-transfer-encoding resp))
+                (error "download failed; use a newer Guile"
+                       uri resp)))
+             ((string<=? (version) "2.0.7")
+              (open-input-string data))
+             (else data)))
       (else
-       (error "download failed:" uri code
+       (error "download failed" uri code
               (response-reason-phrase resp))))))
 
 (define %package-list-url
@@ -79,16 +97,101 @@
                  "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-urls         gnu-package-doc-urls)
+  (download-url     gnu-package-download-url))
+
 (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:]]+): (.*)$"))
+          (doc-urls-rx (make-regexp "^doc-url: (.*)$"))
+          (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 doc-urls-rx str)
+                  =>
+                  (lambda (match)
+                    (if (equal? (assoc-ref (first state) "doc-urls") #f)
+                        (group-package-fields
+                         port (cons (cons (cons "doc-urls"
+                                                (list
+                                                 (match:substring match 1)))
+                                          (first state))
+                                    (drop state 1)))
+                        (group-package-fields
+                         port (cons (cons (cons "doc-urls"
+                                                (cons (match:substring match 1)
+                                                      (assoc-ref (first state)
+                                                                 "doc-urls")))
+                                          (assoc-remove! (first state)
+                                                         "doc-urls"))
+                                    (drop state 1))))))
+                 ((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)))
+
+  (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-urls"
+                               "download-url")))
+        (group-package-fields (http-fetch %package-list-url)
+                              '(())))))
 
-  (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)))
+(define (find-packages regexp)
+  "Find GNU packages which satisfy REGEXP."
+  (let ((name-rx (make-regexp regexp)))
+    (filter (lambda (package)
+              (and=> (false-if-exception
+                      (regexp-exec name-rx (gnu-package-name package)))
+                     (const package)))
+            (official-gnu-packages))))
 
 (define gnu-package?
   (memoize
@@ -97,10 +200,10 @@
 network to check in GNU's database."
      ;; TODO: Find a way to determine that a package is non-GNU without going
      ;; through the network.
-     (let ((url (and=> (package-source package) origin-uri)))
+     (let ((url  (and=> (package-source package) origin-uri))
+           (name (package-name package)))
        (or (and (string? url) (string-prefix? "mirror://gnu" url))
-           (and (member (package-name package) (official-gnu-packages))
-                #t))))))
+           (not (null-list? (find-packages (format #f "^~a$" name)))))))))
 
 \f
 ;;;
-- 
1.7.5.4


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add related procedures.

[Ludovic Courtès]

Nikita Karetnikov <nikita@karetnikov.org> skribis:

>> What about calling that field ‘doc-urls’ (plural) and having it hold a
>> list of URLs?
>
> Done.
>
> By the way, some fields return "none."  Should it be converted to #f?

Hmm, dunno.  Let’s leave it for later.  ;-)

> +(define (find-packages regexp)
> +  "Find GNU packages which satisfy REGEXP."
> +  (let ((name-rx (make-regexp regexp)))
> +    (filter (lambda (package)
> +              (and=> (false-if-exception
> +                      (regexp-exec name-rx (gnu-package-name package)))
> +                     (const package)))
> +            (official-gnu-packages))))

This would give the same result:

  (filter (lambda (p)
            (false-if-exception
             (regexp-exec name-rx (gnu-package-name package))))
          (official-gnu-packages))

>  (define gnu-package?
>    (memoize
> @@ -97,10 +200,10 @@
>  network to check in GNU's database."
>       ;; TODO: Find a way to determine that a package is non-GNU without going
>       ;; through the network.
> -     (let ((url (and=> (package-source package) origin-uri)))
> +     (let ((url  (and=> (package-source package) origin-uri))
> +           (name (package-name package)))
>         (or (and (string? url) (string-prefix? "mirror://gnu" url))
> -           (and (member (package-name package) (official-gnu-packages))
> -                #t))))))
> +           (not (null-list? (find-packages (format #f "^~a$" name)))))))))

This can be simplified:

  (or (and (string? url) ...)
      (and (member name (map gnu-package-name (official-gnu-packages)))
           #t))

Thus I think you can remove ‘find-packages’, which is a special case
anyway.

WDYT?

If you agree with the changes, you can then push the final version.

Thanks!

Ludo’.

Re: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add related procedures.

[Nikita Karetnikov]

[-- Attachment #1: Type: text/plain, Size: 1641 bytes --]

> I'll ask Karl about this.

-------------------- Start of forwarded message --------------------
    While we are at it, I also noticed that the "note" field is repeated
    (package: cobol).

True.

    "(It’s surprising that there’s no ‘license’ field in the file.)"
    Could you explain why?

Simple -- it's never been needed.  That is, rms has never asked me a
question that required sorting by license.  All software in GNU is
GPL-compatible by definition.  As you've seen, the most I've needed is
an indication of GPLv3 status, where I tossed some other random license
information as I found it.

    Also, why do you use "doc-url: none"?

As a human, I've found it is much more reliable to have an explicit
doc-url field for every package.  Before I started using doc-url: none, 
I was always unsure as to whether the lack of the field meant there
really was no explicit doc page, or whether I hadn't looked for one yet.
So I'm not going to get rid of it.

When I create the table for www.gnu.org/manual (file allgnupkgs.html),
obviously I don't actually put in a link to "none".  I just replace it
with another link to the home page, since there's nothing better.

Feel free to forward all this to whatever list.  Also feel free to start
cc-ing the list in the first place :).

BTW, if you ever find any updates to the data or needed, or have
suggestions for the categories and/or descriptions and/or whatever,
please let me know.  There's nothing set in stone about any of it --
it's just the best I could do or find.
-------------------- End of forwarded message --------------------

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]