--- Begin Message ---
|
Subject: |
[PATCH] website: Provide JSON sources list used by Software Heritage. |
|
Date: |
Mon, 10 Feb 2020 18:04:18 +0100 |
Format discussed here <https://forge.softwareheritage.org/D2025#51269>.
* website/apps/packages/builder.scm (sources-json-builder): New procedure.
---
website/apps/packages/builder.scm | 62 +++++++++++++++++++++++++++++++
1 file changed, 62 insertions(+)
diff --git a/website/apps/packages/builder.scm
b/website/apps/packages/builder.scm
index 9dc44c9..5279096 100644
--- a/website/apps/packages/builder.scm
+++ b/website/apps/packages/builder.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 Ludovic Courtès <address@hidden>
;;; Copyright © 2019 Ricardo Wurmus <address@hidden>
;;; Copyright © 2019 Nicolò Balzarotti <address@hidden>
+;;; Copyright © 2020 Simon Tournier <address@hidden>
;;;
;;; Initially written by sirgazil
;;; who waives all copyright interest on this file.
@@ -37,6 +38,8 @@
#:use-module (haunt page)
#:use-module (haunt utils)
#:use-module (srfi srfi-1)
+ #:use-module ((web uri) #:select (string->uri uri->string uri-scheme))
+ #:use-module ((guix build download) #:select (maybe-expand-mirrors))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
@@ -70,6 +73,7 @@
(flatten
(list
(index-builder)
+ (sources-json-builder)
(packages-json-builder)
(packages-builder)
(package-list-builder))))
@@ -84,6 +88,64 @@
;; Maximum number of packages shown on /packages.
30)
+(define (sources-json-builder)
+ "Return a JSON page listing all the sources."
+ (define (origin->json origin)
+ (define method
+ (origin-method origin))
+
+ (define uri ;represented as string
+ (origin-uri origin))
+
+ (define (mirror->url uri)
+ (uri->string (car (maybe-expand-mirrors uri %mirrors))))
+
+ (define (resolve urls)
+ (let* ((url (car urls))
+ (uri (string->uri url))
+ (rest (cdr urls)))
+ (case (uri-scheme uri)
+ ((mirror) (mirror->url uri))
+ ((http) url)
+ ((https) url)
+ (else
+ (if (null? rest)
+ url
+ (resolve rest))))))
+
+ `((type . ,(cond ((eq? url-fetch method) 'url)
+ ((eq? git-fetch method) 'git)
+ ((eq? svn-fetch method) 'svn)
+ (else #nil)))
+ ,@(cond ((eq? url-fetch method)
+ `(("url" . ,(match uri
+ ((? string? url) (mirror->url (string->uri
url)))
+ ((urls ...) (resolve urls))))))
+ ((eq? git-fetch method)
+ `(("git_url" . ,(git-reference-url uri))))
+ ((eq? svn-fetch method)
+ `(("svn_url" . ,(svn-reference-url uri))))
+ (else '()))
+ ,@(if (eq? method git-fetch)
+ `(("git_ref" . ,(git-reference-commit uri)))
+ '())
+ ,@(if (eq? method svn-fetch)
+ `(("svn_revision" . ,(svn-reference-revision
+ uri)))
+ '())))
+
+ (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 (packages-json-builder)
"Return a JSON page listing all packages."
(define (origin->json origin)
--
2.23.0
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: [PATCH v3] sources.json: array instead of list |
|
Date: |
Mon, 09 Mar 2020 10:53:09 +0100 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) |
Hi,
zimoun <address@hidden> skribis:
> Yes please push.
Done! <https://guix.gnu.org/sources.json> should show up within an hour.
> PS: i am typing with my smartphone because i am sleeping in a hospital
> (Purpan, Toulouse). I lose part of sensitivity and mobility of my right arm
> after a shock to my neck during a basket ball party with some friends.
> Everything is on the process but I cannot say when i will have access to my
> laptop next ; maybe Tomorrow, maybe one week later. So please go ahead (-:
Ouch, I wish you quick recovery!
Take care of yourself,
Ludo’.
--- End Message ---