From 85f9588d0502a7dd4a1e2c30f8ba54fcb300cca8 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <address@hidden>
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 <address@hidden>
 ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013 Nikita Karetnikov <address@hidden>
 ;;;
 ;;; 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