From: zimoun <zimon.toutoune@gmail.com>
To: 39547@debbugs.gnu.org
Cc: zimoun <zimon.toutoune@gmail.com>
Subject: [bug#39547] [PATCH v2 1/2] website: Refactor and resolve mirror:// of JSON package list.
Date: Tue, 18 Feb 2020 13:32:45 +0100 [thread overview]
Message-ID: <20200218123246.32473-1-zimon.toutoune@gmail.com> (raw)
In-Reply-To: <20200210170418.32076-1-zimon.toutoune@gmail.com>
* 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
next prev parent reply other threads:[~2020-02-18 12:34 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 ` zimoun [this message]
2020-02-18 12:32 ` [bug#39547] [PATCH v2 2/2] " zimoun
2020-03-02 17:24 ` [bug#39547] [PATCH v3] sources.json: array instead of list zimoun
2020-03-06 11:01 ` 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=20200218123246.32473-1-zimon.toutoune@gmail.com \
--to=zimon.toutoune@gmail.com \
--cc=39547@debbugs.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).