From 73557bc00760b4404bfe17ecb3aca983c6dcc11e Mon Sep 17 00:00:00 2001
From: zimoun <address@hidden>
Date: Tue, 18 Feb 2020 13:25:14 +0100
Subject: [PATCH v3 2/2] website: Provide JSON sources list used by Software
 Heritage.

Format discussed here <https://forge.softwareheritage.org/D2025#51269>.

* website/apps/packages/builder.scm (origin->json): Add list modifier.
* website/apps/packages/builder.scm (sources-json-builder): New procedure.
---
 website/apps/packages/builder.scm | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

diff --git a/website/apps/packages/builder.scm b/website/apps/packages/builder.scm
index d3a777e..3fc1285 100644
--- a/website/apps/packages/builder.scm
+++ b/website/apps/packages/builder.scm
@@ -74,6 +74,7 @@
   (flatten
    (list
     (index-builder)
+    (sources-json-builder)
     (packages-json-builder)
     (packages-builder)
     (package-list-builder))))
@@ -88,7 +89,7 @@
   ;; Maximum number of packages shown on /packages.
   30)
 
-(define (origin->json origin)
+(define* (origin->json origin #:optional (transformer list->vector))
     (define method
       (origin-method origin))
 
@@ -105,7 +106,7 @@
                      ((eq? svn-fetch method) 'svn)
                      (else                   #nil)))
       ,@(cond ((eq? url-fetch method)
-               `(("url" . ,(list->vector
+               `(("url" . ,(transformer
                             (resolve
                              (match uri
                                ((? string? url) (list url))
@@ -155,6 +156,21 @@
 	     (list->vector (map package->json (all-packages)))
              scm->json))
 
+(define (sources-json-builder)
+  "Return a JSON page listing all the sources.
+
+See <https://forge.softwareheritage.org/D2025#51269>."
+  (define (package->json package)
+    `(,@(if (origin? (package-source package))
+            (origin->json (package-source package))
+            `(("type" . "no-origin")
+              ("name" . ,(package-name package))))))
+
+  (make-page "sources.json"
+             `(("sources" . ,(list->vector (map package->json (all-packages))))
+               ("version" . "1"))
+             scm->json))
+
 (define (index-builder)
   "Return a Haunt page listing some random packages."
   (define (sample n from)
-- 
2.25.0