[bug#39547] [PATCH v2 2/2] website: Provide JSON sources list used by Software Heritage.

[zimoun]

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 | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

diff --git a/website/apps/packages/builder.scm 
b/website/apps/packages/builder.scm
index d3a777e..49721f6 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 transformer)
     (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))
@@ -136,7 +137,7 @@
       ,@(if cpe-name `(("cpe_name" . ,cpe-name)) '())
       ,@(if cpe-version `(("cpe_version" . ,cpe-version)) '())
       ,@(if (origin? (package-source package))
-            `(("source" . ,(origin->json (package-source package))))
+            `(("source" . ,(origin->json (package-source package) 
list->vector)))
             '())
       ("synopsis" . ,(package-synopsis package))
       ,@(if (package-home-page package)
@@ -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) car)
+            `(("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