GNU bug report logs -
#39547
[PATCH] website: Provide JSON sources list used by Software Heritage.
Previous Next
Reported by: zimoun <zimon.toutoune <at> gmail.com>
Date: Mon, 10 Feb 2020 17:05:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Bug is archived. No further changes may be made.
Full log
View this message in rfc822 format
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
This bug report was last modified 5 years and 160 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.