Re: Maintaining implementations of similar utility functions like json-fetch

[Jelle Licht <jlicht@fsfe.org>]

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

Ludovic Courtès <ludo@gnu.org> writes:

> Hey,
>
> Jelle Licht <jlicht@fsfe.org> skribis:
>
>> I basically added the robust features of `json-fetch*' to the exported
>> `json-fetch'
>> instead, and all existing functionality seems to work out as far as I can
>> see.
>
> So are you saying that we can get rid of ‘json-fetch*’?
>
>> I did notice that I now produce hash-tables by default, and some of the
>> existing usages of `json-fetch*' expect an alist instead. What would be a
>> guile-
>> appropriate way of dealing with this? I currently have multiple
>> `(hash-table->alist (json-fetch <...>))' littered in my patch which seems
>> suboptimal,
>> but always converting the parsed json into an alist seems like it might
>> also not be
>> what we want.
>
> Why insist on having an alist?  Perhaps you can just stick to hash
> tables?   :-)
>
> Ludo’.

Hey hey,

Sorry for the delay. Cue the drum roll; Attached is my initial draft of
this patch. I initially wanted to split it up into 2 or more patches, but
could not make this work in a way that I could wrap my head around.

Also, there is yet another 'json-fetch'-like function implemented in
`guix/ci.scm', but I was not sure whether the error-handling facilities
would be applicable there.

Anyway, I am open to comments. I have verified that at least the
(tests of the) importers still work as they did before. After the
comments, I could push it myself if that is okay.

[-- Attachment #2: 0001-import-json-Consolidate-duplicate-json-fetch-functio.patch --]
[-- Type: text/x-patch, Size: 8561 bytes --]

From c60686975df2999906118c3a26cc9c2cef2a93b2 Mon Sep 17 00:00:00 2001
From: Jelle Licht <jlicht@fsfe.org>
Date: Sun, 10 Jun 2018 20:35:39 +0200
Subject: [PATCH] import: json: Consolidate duplicate json-fetch functionality.

* guix/import/json.scm (json-fetch): Return a list or hash table.
  (json-fetch-alist): New procedure.
* guix/import/github.scm (json-fetch*): Remove.
  (latest-released-version): Use json-fetch.
* guix/import/cpan.scm (module->dist-name): Use json-fetch-alist.
  (cpan-fetch): Likewise.
* guix/import/crate.scm (crate-fetch): Likewise.
* guix/import/gem.scm (rubygems-fetch): Likewise.
* guix/import/pypi.scm (pypi-fetch): Likewise.
* guix/import/stackage.scm (stackage-lts-info-fetch): Likewise.
---
 guix/import/cpan.scm     |  9 +++++----
 guix/import/crate.scm    |  4 ++--
 guix/import/gem.scm      |  2 +-
 guix/import/github.scm   | 19 ++-----------------
 guix/import/json.scm     | 24 +++++++++++++++++-------
 guix/import/pypi.scm     |  4 ++--
 guix/import/stackage.scm |  2 +-
 7 files changed, 30 insertions(+), 34 deletions(-)

diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 58c051e28..08bed8767 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -88,9 +88,10 @@
   "Return the base distribution module for a given module.  E.g. the 'ok'
 module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
 return \"Test-Simple\""
-  (assoc-ref (json-fetch (string-append "https://fastapi.metacpan.org/v1/module/"
-                                        module
-                                        "?fields=distribution"))
+  (assoc-ref (json-fetch-alist (string-append
+                                "https://fastapi.metacpan.org/v1/module/"
+                                module
+                                "?fields=distribution"))
              "distribution"))
 
 (define (package->upstream-name package)
@@ -113,7 +114,7 @@ return \"Test-Simple\""
   "Return an alist representation of the CPAN metadata for the perl module MODULE,
 or #f on failure.  MODULE should be e.g. \"Test::Script\""
   ;; This API always returns the latest release of the module.
-  (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name)))
+  (json-fetch-alist (string-append "https://fastapi.metacpan.org/v1/release/" name)))
 
 (define (cpan-home name)
   (string-append "http://search.cpan.org/dist/" name "/"))
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index a7485bb4d..3724a457a 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -51,7 +51,7 @@
   (define (crate-kind-predicate kind)
     (lambda (dep) (string=? (assoc-ref dep "kind") kind)))
 
-  (and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
+  (and-let* ((crate-json (json-fetch-alist (string-append crate-url crate-name)))
              (crate (assoc-ref crate-json "crate"))
              (name (assoc-ref crate "name"))
              (version (assoc-ref crate "max_version"))
@@ -63,7 +63,7 @@
                                  string->license)
                           '()))                   ;missing license info
              (path (string-append "/" version "/dependencies"))
-             (deps-json (json-fetch (string-append crate-url name path)))
+             (deps-json (json-fetch-alist (string-append crate-url name path)))
              (deps (assoc-ref deps-json "dependencies"))
              (input-crates (filter (crate-kind-predicate "normal") deps))
              (native-input-crates
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 6e914d629..646163fb7 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -38,7 +38,7 @@
 (define (rubygems-fetch name)
   "Return an alist representation of the RubyGems metadata for the package NAME,
 or #f on failure."
-  (json-fetch
+  (json-fetch-alist
    (string-append "https://rubygems.org/api/v1/gems/" name ".json")))
 
 (define (ruby-package-name name)
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 4b7d53c70..ef226911b 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -22,31 +22,16 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
-  #:use-module (json)
   #:use-module (guix utils)
   #:use-module ((guix download) #:prefix download:)
   #:use-module (guix import utils)
+  #:use-module (guix import json)
   #:use-module (guix packages)
   #:use-module (guix upstream)
   #:use-module (guix http-client)
   #:use-module (web uri)
   #:export (%github-updater))
 
-(define (json-fetch* url)
-  "Return a representation of the JSON resource URL (a list or hash table), or
-#f if URL returns 403 or 404."
-  (guard (c ((and (http-get-error? c)
-                  (let ((error (http-get-error-code c)))
-                    (or (= 403 error)
-                        (= 404 error))))
-             #f))     ;; "expected" if there is an authentification error (403),
-                      ;; or if package is unknown (404).
-    ;; Note: github.com returns 403 if we omit a 'User-Agent' header.
-    (let* ((port   (http-fetch url))
-           (result (json->scm port)))
-      (close-port port)
-      result)))
-
 (define (find-extension url)
   "Return the extension of the archive e.g. '.tar.gz' given a URL, or
 false if none is recognized"
@@ -144,7 +129,7 @@ the package e.g. 'bedtools2'.  Return #f if there is no releases"
                    "https://api.github.com/repos/"
                    (github-user-slash-repository url)
                    "/releases"))
-         (json (json-fetch*
+         (json (json-fetch
                 (if token
                     (string-append api-url "?access_token=" token)
                     api-url))))
diff --git a/guix/import/json.scm b/guix/import/json.scm
index c76bc9313..3f2ab1e3e 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -22,15 +22,25 @@
   #:use-module (guix http-client)
   #:use-module (guix import utils)
   #:use-module (srfi srfi-34)
-  #:export (json-fetch))
+  #:export (json-fetch
+            json-fetch-alist))
 
 (define (json-fetch url)
-  "Return an alist representation of the JSON resource URL, or #f on failure."
+  "Return a representation of the JSON resource URL (a list or hash table), or
+#f if URL returns 403 or 404."
   (guard (c ((and (http-get-error? c)
-                  (= 404 (http-get-error-code c)))
-             #f))                       ;"expected" if package is unknown
-    (let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile")
-                                             (Accept . "application/json"))))
-           (result (hash-table->alist (json->scm port))))
+                  (let ((error (http-get-error-code c)))
+                    (or (= 403 error)
+                        (= 404 error))))
+             #f))
+    ;; Note: many websites returns 403 if we omit a 'User-Agent' header.
+    (let* ((port   (http-fetch url #:headers '((user-agent . "GNU Guile")
+                                               (Accept . "application/json"))))
+           (result (json->scm port)))
       (close-port port)
       result)))
+
+(define (json-fetch-alist url)
+  "Return an alist representation of the JSON resource URL, or #f if URL
+returns 403 or 404."
+  (hash-table->alist (json-fetch url)))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index bb0db1ba8..6beab6b01 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -51,8 +51,8 @@
 (define (pypi-fetch name)
   "Return an alist representation of the PyPI metadata for the package NAME,
 or #f on failure."
-  (json-fetch (string-append "https://pypi.python.org/pypi/"
-                             name "/json")))
+  (json-fetch-alist (string-append "https://pypi.python.org/pypi/"
+                                   name "/json")))
 
 ;; For packages found on PyPI that lack a source distribution.
 (define-condition-type &missing-source-error &error
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 5b25adc67..ec93fbced 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -60,7 +60,7 @@
      (let* ((url (if (string=? "" version)
                      (string-append %stackage-url "/lts")
                      (string-append %stackage-url "/lts-" version)))
-            (lts-info (json-fetch url)))
+            (lts-info (json-fetch-alist url)))
        (if lts-info
            (reverse lts-info)
            (leave-with-message "LTS release version not found: ~a" version))))))
-- 
2.17.1