From ce7af670e767f425ccbb732cbe0e74423a194dbf Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <address@hidden>
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 <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.
 ;;;
@@ -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))))
+

 ;;;
 ;;; Latest release.
-- 
1.7.5.4