From mboxrd@z Thu Jan  1 00:00:00 1970
Received: from eggs.gnu.org ([2001:470:142:3::10]:39284)
 by lists.gnu.org with esmtp (Exim 4.90_1)
 (envelope-from <Debian-debbugs@debbugs.gnu.org>) id 1j2WX1-0003oH-N5
 for guix-patches@gnu.org; Fri, 14 Feb 2020 03:41:04 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <Debian-debbugs@debbugs.gnu.org>) id 1j2WX0-0002lD-F2
 for guix-patches@gnu.org; Fri, 14 Feb 2020 03:41:03 -0500
Received: from debbugs.gnu.org ([209.51.188.43]:54846)
 by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16)
 (Exim 4.71) (envelope-from <Debian-debbugs@debbugs.gnu.org>)
 id 1j2WX0-0002l5-Bf
 for guix-patches@gnu.org; Fri, 14 Feb 2020 03:41:02 -0500
Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2)
 (envelope-from <Debian-debbugs@debbugs.gnu.org>) id 1j2WX0-0007In-AC
 for guix-patches@gnu.org; Fri, 14 Feb 2020 03:41:02 -0500
Subject: [bug#39547] [PATCH] website: Provide JSON sources list used by
 Software Heritage.
Resent-Message-ID: <handler.39547.B39547.158166965328048@debbugs.gnu.org>
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludovic.courtes@inria.fr>
References: <20200210170418.32076-1-zimon.toutoune@gmail.com>
Date: Fri, 14 Feb 2020 09:40:45 +0100
In-Reply-To: <20200210170418.32076-1-zimon.toutoune@gmail.com> (zimoun's
 message of "Mon, 10 Feb 2020 18:04:18 +0100")
Message-ID: <87pnehk1de.fsf@gnu.org>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
List-Id: <guix-patches.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/guix-patches>,
 <mailto:guix-patches-request@gnu.org?subject=unsubscribe>
List-Archive: <https://lists.gnu.org/archive/html/guix-patches>
List-Post: <mailto:guix-patches@gnu.org>
List-Help: <mailto:guix-patches-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/guix-patches>,
 <mailto:guix-patches-request@gnu.org?subject=subscribe>
Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org
Sender: "Guix-patches" <guix-patches-bounces+kyle=kyleam.com@gnu.org>
To: zimoun <zimon.toutoune@gmail.com>
Cc: 39547@debbugs.gnu.org

Hello,

zimoun <zimon.toutoune@gmail.com> skribis:

> Format discussed here <https://forge.softwareheritage.org/D2025#51269>.
>
> * website/apps/packages/builder.scm (sources-json-builder): New procedure.

[...]

> +(define (sources-json-builder)
> +  "Return a JSON page listing all the sources."

Please add a reference to
<https://forge.softwareheritage.org/D2025#51269> here.

> +  (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)))
> +            '())))

Could you, in a first patch, move =E2=80=98origin->json=E2=80=99 out of
=E2=80=98packages-json-builder=E2=80=99, and in a second patch, add mirror-=
expansion
feature?

For mirror:// expansion, I think you can just write something like:

  (define uris
    (append-map (cut maybe-expand-mirrors <> %mirrors)
                (match url
                  ((_ ...) (map string->uri url))
                  (_       (list (string->uri url))))))

and then pick the first element of the list.

In parallel, I=E2=80=99d recommend suggesting a format change or addition t=
hat
would allow us to provide all the URLs.  :-)

With those changes in place, I think we=E2=80=99ll be ready to go!

Thanks for working on it, Simon!

Ludo=E2=80=99.