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.

7 files changed, 30 insertions, 34 deletions

diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 58c051e283..08bed8767c 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 a7485bb4d0..3724a457a4 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 6e914d6290..646163fb7b 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 4b7d53c704..ef226911b9 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 c76bc9313c..3f2ab1e3ea 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 bb0db1ba85..6beab6b010 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 5b25adc674..ec93fbced6 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))))))