unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: zimoun <zimon.toutoune@gmail.com>
To: 39547@debbugs.gnu.org, "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#39547] [PATCH v3] sources.json: array instead of list
Date: Mon, 2 Mar 2020 18:24:49 +0100	[thread overview]
Message-ID: <CAJ3okZ2UO8Wb0f8PKqiNs2_Podro23D8rpaQBD-rZ5E+TpNbTw@mail.gmail.com> (raw)
In-Reply-To: <20200210170418.32076-1-zimon.toutoune@gmail.com>

[-- Attachment #1: Type: text/plain, Size: 337 bytes --]

Hi Ludo,

Attached, the tiny modification to output the list (array) of URLs
instead of the first one.
The version number is still '1' because I do not know yet if lewo would bump it.
Note also that "transformer" is not useful any more because
'packages-json-builder' and 'sources-json-builder' returns both
vectors now.


Cheers,
simon

[-- Attachment #2: v3-0001-website-Refactor-and-resolve-mirror-of-JSON-packa.patch --]
[-- Type: text/x-patch, Size: 3716 bytes --]

From 57a444f6f215fb6327719161a6e6ad4ad229273f Mon Sep 17 00:00:00 2001
From: zimoun <zimon.toutoune@gmail.com>
Date: Mon, 10 Feb 2020 17:52:13 +0100
Subject: [PATCH v3 1/2] website: Refactor and resolve mirror:// of JSON
 package list.

* website/apps/packages/builder.scm (origin->json): New procedure.
---
 website/apps/packages/builder.scm | 34 ++++++++++++++++++++++---------
 1 file changed, 24 insertions(+), 10 deletions(-)

diff --git a/website/apps/packages/builder.scm b/website/apps/packages/builder.scm
index 9dc44c9..d3a777e 100644
--- a/website/apps/packages/builder.scm
+++ b/website/apps/packages/builder.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
+;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; Initially written by sirgazil
 ;;; who waives all copyright interest on this file.
@@ -37,13 +38,16 @@
   #:use-module (haunt page)
   #:use-module (haunt utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
   #:use-module (guix svn-download)
   #:use-module (guix utils)                       ;location
+  #:use-module ((guix build download) #:select (maybe-expand-mirrors))
   #:use-module (json)
   #:use-module (ice-9 match)
+  #:use-module ((web uri) #:select (string->uri uri->string))
   #:export (builder))
 
 
@@ -84,33 +88,43 @@
   ;; Maximum number of packages shown on /packages.
   30)
 
-(define (packages-json-builder)
-  "Return a JSON page listing all packages."
-  (define (origin->json origin)
+(define (origin->json origin)
     (define method
       (origin-method origin))
 
+    (define uri                         ;represented as string
+      (origin-uri origin))
+
+    (define (resolve urls)
+      (map uri->string
+           (append-map (cut maybe-expand-mirrors <> %mirrors)
+                       (map string->uri urls))))
+
     `((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 (origin-uri origin)
-                             ((? string? url) (vector url))
-                             ((urls ...) (list->vector urls))))))
+               `(("url" . ,(list->vector
+                            (resolve
+                             (match uri
+                               ((? string? url) (list url))
+                               ((urls ...) urls)))))))
               ((eq? git-fetch method)
-               `(("git_url" . ,(git-reference-url (origin-uri origin)))))
+               `(("git_url" . ,(git-reference-url uri))))
               ((eq? svn-fetch method)
-               `(("svn_url" . ,(svn-reference-url (origin-uri origin)))))
+               `(("svn_url" . ,(svn-reference-url uri))))
               (else '()))
       ,@(if (eq? method git-fetch)
-            `(("git_ref" . ,(git-reference-commit (origin-uri origin))))
+            `(("git_ref" . ,(git-reference-commit uri)))
             '())
       ,@(if (eq? method svn-fetch)
             `(("svn_revision" . ,(svn-reference-revision
-                                  (origin-uri origin))))
+                                  uri)))
             '())))
 
+(define (packages-json-builder)
+  "Return a JSON page listing all packages."
   (define (package->json package)
     (define cpe-name
       (assoc-ref (package-properties package) 'cpe-name))
-- 
2.25.0


[-- Attachment #3: v3-0002-website-Provide-JSON-sources-list-used-by-Softwar.patch --]
[-- Type: text/x-patch, Size: 2326 bytes --]

From 73557bc00760b4404bfe17ecb3aca983c6dcc11e Mon Sep 17 00:00:00 2001
From: zimoun <zimon.toutoune@gmail.com>
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


  parent reply	other threads:[~2020-03-02 17:26 UTC|newest]

Thread overview: 18+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-02-10 17:04 [bug#39547] [PATCH] website: Provide JSON sources list used by Software Heritage zimoun
2020-02-14  8:40 ` Ludovic Courtès
2020-02-14  9:04   ` zimoun
2020-02-14 10:20     ` Ludovic Courtès
2020-02-17 17:59       ` zimoun
2020-02-18  8:24         ` Ludovic Courtès
2020-02-18  8:38           ` zimoun
2020-02-18  8:43             ` Ludovic Courtès
2020-02-18 12:32 ` [bug#39547] [PATCH v2 1/2] website: Refactor and resolve mirror:// of JSON package list zimoun
2020-02-18 12:32   ` [bug#39547] [PATCH v2 2/2] website: Provide JSON sources list used by Software Heritage zimoun
2020-03-02 17:24 ` zimoun [this message]
2020-03-06 11:01   ` [bug#39547] [PATCH v3] sources.json: array instead of list Ludovic Courtès
2020-03-07 22:17     ` zimoun
2020-03-09  9:53       ` bug#39547: " Ludovic Courtès
2020-03-03 18:00 ` [bug#39547] Addition of %content-addressed-mirrors to sources.json (SWH)? zimoun
2020-03-05 16:19   ` Ludovic Courtès
2020-03-06  9:26     ` zimoun
2020-03-06 10:57       ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=CAJ3okZ2UO8Wb0f8PKqiNs2_Podro23D8rpaQBD-rZ5E+TpNbTw@mail.gmail.com \
    --to=zimon.toutoune@gmail.com \
    --cc=39547@debbugs.gnu.org \
    --cc=ludo@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).