From 3ef3b0445241df1dc47c3717e63ffcf6267b3c70 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 13 Dec 2016 17:22:52 +0100
Subject: website: Add procedure to generate 'packages.json'.

* website/www/packages.scm (packages->json): New procedure.
* website/README: Mention Guile-JSON.
---
 website/README           |  1 +
 website/www/packages.scm | 19 ++++++++++++++++++-
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/website/README b/website/README
index 99d13ee..b5a565e 100644
--- a/website/README
+++ b/website/README
@@ -22,6 +22,7 @@ To be able to work on the website, you need the following software:
   - [[https://www.gnu.org/software/guile/][GNU Guile]] (programming language)
   - [[https://gnutls.org/][GnuTLS]] (Transport Layer Security Library)
   - [[http://haunt.dthompson.us/][Haunt]] (static site generator)
+  - [[http://savannah.nongnu.org/projects/guile-json/][Guile-JSON]] (to produce the =packages.json= file)
 
 Additionally, [[https://www.gnu.org/software/guix/][GNU Guix]] source code is needed to generate the
 package-related pages of the website. You can clone the latest source
diff --git a/website/www/packages.scm b/website/www/packages.scm
index d050a03..55d494e 100644
--- a/website/www/packages.scm
+++ b/website/www/packages.scm
@@ -34,6 +34,7 @@
   #:use-module (gnu packages)
   #:use-module (sxml simple)
   #:use-module (sxml fold)
+  #:use-module (json)
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -47,7 +48,8 @@
   #:export (%groups
             package-pages
             paginated-packages-page
-            issues-page))
+            issues-page
+            packages->json))
 
 (define lookup-gnu-package
   (let ((gnu (delay (official-gnu-packages))))
@@ -332,6 +334,21 @@ of the form \"PACKAGE-X.Y.Z\"."
           (id "top"))
        "^")))
 
+(define* (packages->json #:optional (packages (all-packages)))
+  "Return a JSON string representing PACKAGES."
+  (define (package->alist package)
+    `((name . ,(package-name package))
+      (version . ,(package-version package))
+      (cpe-name . ,(or (assoc-ref (package-properties package) 'cpe-name)
+                       (package-name package)))
+      (cpe-version . ,(or (assoc-ref (package-properties package)
+                                     'cpe-version)
+                          (package-version package)))
+      (home-page . ,(package-home-page package))))
+
+  (scm->json-string (map package->alist packages)
+                    #:pretty #t))
+
 (define (number* number)
   "Return NUMBER correctly formatting according to English conventions."
   (number->locale-string number 0
-- 
cgit v1.2.3