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

[Nikita Karetnikov <nikita@karetnikov.org>]

[-- 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 --]