[PATCH] list-packages: Display package usage count.

[Eric Bavier]

This patch adds a simple message like "used by X other packages" to each
packages description on
https://www.gnu.org/software/guix/package-list.html.

>From 41a3599bcdc3888085379801e9a7f05430ffe0c3 Mon Sep 17 00:00:00 2001
From: Eric Bavier <address@hidden>
Date: Mon, 20 Oct 2014 12:12:28 -0500
Subject: [PATCH] list-packages: Display package usage count.

* gnu/packages.scm (find-packages, find-package-by-name*): New
  procedures.
* build-aux/list-packages.scm (package->sxml)[users]: New local
  procedure.
---
 build-aux/list-packages.scm |    8 ++++++++
 gnu/packages.scm            |   12 ++++++++----
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/build-aux/list-packages.scm b/build-aux/list-packages.scm
index 7b046fe..276c153 100755
--- a/build-aux/list-packages.scm
+++ b/build-aux/list-packages.scm
@@ -166,6 +166,13 @@ decreasing, is 1."
           ,(url "i686-linux") " "
           ,(url "mips64el-linux")))
 
+  (define (users package)
+    (let ((n (length (package-transitive-dependents
+                      (find-packages-by-name* (package-name package)
+                                              (package-version package))))))
+      (and (> n 0)
+           `(div "used by " ,n " other " ,(if (= n 1) "package" "packages")))))
+
   (define (package-logo name)
     (and=> (lookup-gnu-package name)
            gnu-package-logo))
@@ -206,6 +213,7 @@ description-ids as formal parameters."
                        ,(package-home-page package))
                     ,(status package)
                     ,(patches package)
+                    ,(users package)
                     ,(if js?
                          (insert-js-call description-ids)
                          ""))))))
diff --git a/gnu/packages.scm b/gnu/packages.scm
index d3a064c..2ec160a 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -41,6 +41,7 @@
             fold-packages*
 
             find-packages-by-name
+            find-packages-by-name*
             find-best-packages-by-name
             find-newest-available-packages
 
@@ -192,11 +193,11 @@ guaranteed to never traverse the same package twice."
         (filter package? inputs))))
    (fold-packages cons '())))
 
-(define find-packages-by-name
+(define (find-packages fold)
   (let ((packages (delay
-                    (fold-packages (lambda (p r)
-                                     (vhash-cons (package-name p) p r))
-                                   vlist-null))))
+                    (fold (lambda (p r)
+                            (vhash-cons (package-name p) p r))
+                          vlist-null))))
     (lambda* (name #:optional version)
       "Return the list of packages with the given NAME.  If VERSION is not #f,
 then only return packages whose version is equal to VERSION."
@@ -207,6 +208,9 @@ then only return packages whose version is equal to 
VERSION."
                     matching)
             matching)))))
 
+(define find-packages-by-name  (find-packages fold-packages))
+(define find-packages-by-name* (find-packages fold-packages*))
+
 (define find-newest-available-packages
   (memoize
    (lambda ()
-- 
1.7.9.5

-- 
Eric Bavier