* m4/guix.m4 (GUIX_CHECK_GUILE_JSON): New macro.
* configure.ac: Use it.
* doc/guix.texi (Requirements): Mention the Guile-JSON version.
* guix/git-download.scm (git-fetch)[guile-json]: Use GUILE-JSON-3.
* guix/import/cpan.scm (string->license): Expect vectors instead of
lists.
(module->dist-name): Use 'json-fetch' instead of 'json-fetch-alist'.
(cpan-fetch): Likewise.
* guix/import/crate.scm (crate-fetch): Likewise, and call 'vector->list'
for DEPS.
* guix/import/gem.scm (rubygems-fetch): Likewise.
* guix/import/json.scm (json-fetch-alist): Remove.
* guix/import/pypi.scm (pypi-fetch): Use 'json-fetch' instead of
'json-fetch-alist'.
(latest-source-release, latest-wheel-release): Call 'vector->list' on
RELEASES.
* guix/import/stackage.scm (stackage-lts-info-fetch): Use 'json-fetch'
instead of 'json-fetch-alist'.
(lts-package-version): Use 'vector->list'.
* guix/import/utils.scm (hash-table->alist): Remove.
(alist->package): Pass 'vector->list' on the inputs fields, and default
to the empty vector.
* guix/scripts/import/json.scm (guix-import-json): Remove call to
'hash-table->alist'.
* guix/swh.scm (define-json-reader): Expect pair? or null? instead of
hash-table?.
[extract-field]: Use 'assoc-ref' instead of 'hash-ref'.
(json->branches): Use 'map' instead of 'hash-map->list'.
(json->checksums): Likewise.
(json->directory-entries, origin-visits): Call 'vector->list' on the
result of 'json->scm'.
* tests/import-utils.scm ("alist->package with dependencies"): New test.
* gnu/installer.scm (build-compiled-file)[builder]: Use GUILE-JSON-3.
* gnu/installer.scm (installer-program)[installer-builder]: Likewise.
* gnu/installer/locale.scm (iso639->iso639-languages): Use 'assoc-ref'
instead of 'hash-ref', and pass vectors through 'vector->list'.
(iso3166->iso3166-territories): Likewise.
* gnu/system/vm.scm (system-docker-image)[build]: Use GUILE-JSON-3.
* guix/docker.scm (manifest, config): Adjust for Guile-JSON 3.
* guix/scripts/pack.scm (docker-image)[build]: Use GUILE-JSON-3.
---
configure.ac | 4 ++--
doc/guix.texi | 2 +-
gnu/installer.scm | 4 ++--
gnu/installer/locale.scm | 21 ++++++++++++---------
gnu/system/vm.scm | 2 +-
guix/docker.scm | 19 ++++++++++---------
guix/git-download.scm | 4 ++--
guix/import/cpan.scm | 14 +++++++-------
guix/import/crate.scm | 6 +++---
guix/import/gem.scm | 10 +++++++---
guix/import/json.scm | 11 ++---------
guix/import/pypi.scm | 8 ++++----
guix/import/stackage.scm | 4 ++--
guix/import/utils.scm | 25 ++++++-------------------
guix/scripts/import/json.scm | 2 +-
guix/scripts/pack.scm | 2 +-
guix/self.scm | 2 +-
guix/swh.scm | 35 +++++++++++++++++++----------------
m4/guix.m4 | 21 +++++++++++++++++++++
tests/import-utils.scm | 22 ++++++++++++++++++++++
20 files changed, 126 insertions(+), 92 deletions(-)
Toggle diff (402 lines)
diff --git a/configure.ac b/configure.ac
index 3918550a79..689b28d984 100644
--- a/configure.ac
+++ b/configure.ac
@@ -119,8 +119,8 @@ if test "x$have_guile_git" != "xyes"; then
fi
dnl Check for Guile-JSON.
-GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
-if test "x$have_guile_json" != "xyes"; then
+GUIX_CHECK_GUILE_JSON
+if test "x$guix_cv_have_recent_guile_json" != "xyes"; then
AC_MSG_ERROR([Guile-JSON is missing; please install it.])
fi
diff --git a/doc/guix.texi b/doc/guix.texi
index 107c16b8db..3a37555721 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -746,7 +746,7 @@ or later;
@c FIXME: Specify a version number once a release has been made.
@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August
2017 or later;
-@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON};
+@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} 3.x;
@item @url{https://zlib.net, zlib};
@item @url{https://www.gnu.org/software/make/, GNU Make}.
@end itemize
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 1452c4dc7e..15d971dfc4 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -69,7 +69,7 @@ version of this file."
(setlocale LC_ALL "en_US.utf8")))
(define builder
- (with-extensions (list guile-json)
+ (with-extensions (list guile-json-3)
(with-imported-modules (source-module-closure
'((gnu installer locale)))
#~(begin
@@ -313,7 +313,7 @@ selected keymap."
;; packages …), etc. modules.
(with-extensions (list guile-gcrypt guile-newt
guile-parted guile-bytestructures
- guile-json guile-git guix)
+ guile-json-3 guile-git guix)
(with-imported-modules `(,@(source-module-closure
`(,@modules
(gnu services herd)
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 13f3a1e881..ccffb6d8ef 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -134,16 +134,18 @@ ISO639-3 and ISO639-5 files."
(lambda (port-iso639-5)
(filter-map
(lambda (hash)
- (let ((alpha2 (hash-ref hash "alpha_2"))
- (alpha3 (hash-ref hash "alpha_3"))
- (name (hash-ref hash "name")))
+ (let ((alpha2 (assoc-ref hash "alpha_2"))
+ (alpha3 (assoc-ref hash "alpha_3"))
+ (name (assoc-ref hash "name")))
(and (supported-locale? locales alpha2 alpha3)
`((alpha2 . ,alpha2)
(alpha3 . ,alpha3)
(name . ,name)))))
(append
- (hash-ref (json->scm port-iso639-3) "639-3")
- (hash-ref (json->scm port-iso639-5) "639-5"))))))))
+ (vector->list
+ (assoc-ref (json->scm port-iso639-3) "639-3"))
+ (vector->list
+ (assoc-ref (json->scm port-iso639-5) "639-5")))))))))
(define (language-code->language-name languages language-code)
"Using LANGUAGES as a list of ISO639 association lists, return the language
@@ -179,10 +181,11 @@ ISO3166 file."
(call-with-input-file iso3166
(lambda (port)
(map (lambda (hash)
- `((alpha2 . ,(hash-ref hash "alpha_2"))
- (alpha3 . ,(hash-ref hash "alpha_3"))
- (name . ,(hash-ref hash "name"))))
- (hash-ref (json->scm port) "3166-1")))))
+ `((alpha2 . ,(assoc-ref hash "alpha_2"))
+ (alpha3 . ,(assoc-ref hash "alpha_3"))
+ (name . ,(assoc-ref hash "name"))))
+ (vector->list
+ (assoc-ref (json->scm port) "3166-1"))))))
(define (territory-code->territory-name territories territory-code)
"Using TERRITORIES as a list of ISO3166 association lists return the
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index e7f7d8ca51..ac6e4ded92 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -514,7 +514,7 @@ system."
(name (string-append name ".tar.gz"))
(graph "system-graph"))
(define build
- (with-extensions (cons guile-json ;for (guix docker)
+ (with-extensions (cons guile-json-3 ;for (guix docker)
gcrypt-sqlite3&co) ;for (guix store database)
(with-imported-modules `(,@(source-module-closure
'((guix docker)
diff --git a/guix/docker.scm b/guix/docker.scm
index b1bd226fa1..c598a073f6 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -62,9 +62,9 @@
(define (manifest path id)
"Generate a simple image manifest."
- `(((Config . "config.json")
- (RepoTags . (,(generate-tag path)))
- (Layers . (,(string-append id "/layer.tar"))))))
+ `#(((Config . "config.json")
+ (RepoTags . #(,(generate-tag path)))
+ (Layers . #(,(string-append id "/layer.tar"))))))
;; According to the specifications this is required for backwards
;; compatibility. It duplicates information provided by the manifest.
@@ -81,17 +81,18 @@
`((architecture . ,arch)
(comment . "Generated by GNU Guix")
(created . ,time)
- (config . ,`((env . ,(map (match-lambda
- ((name . value)
- (string-append name "=" value)))
- environment))
+ (config . ,`((env . ,(list->vector
+ (map (match-lambda
+ ((name . value)
+ (string-append name "=" value)))
+ environment)))
,@(if entry-point
- `((entrypoint . ,entry-point))
+ `((entrypoint . ,(list->vector entry-point)))
'())))
(container_config . #nil)
(os . "linux")
(rootfs . ((type . "layers")
- (diff_ids . (,(layer-diff-id layer)))))))
+ (diff_ids . #(,(layer-diff-id layer)))))))
(define %tar-determinism-options
;; GNU tar options to produce archives deterministically.
diff --git a/guix/git-download.scm b/guix/git-download.scm
index f904d11c25..8f84681d46 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;;
@@ -85,7 +85,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(module-ref (resolve-interface '(gnu packages compression)) 'zlib))
(define guile-json
- (module-ref (resolve-interface '(gnu packages guile)) 'guile-json))
+ (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
(define gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index d4bea84353..ec86f11743 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -76,8 +76,8 @@
;; ssleay
;; sun
("zlib" 'zlib)
- ((x) (string->license x))
- ((lst ...) `(list ,@(map string->license lst)))
+ (#(x) (string->license x))
+ (#(lst ...) `(list ,@(map string->license lst)))
(_ #f)))
(define (module->name module)
@@ -88,10 +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-alist (string-append
- "https://fastapi.metacpan.org/v1/module/"
- module
- "?fields=distribution"))
+ (assoc-ref (json-fetch (string-append
+ "https://fastapi.metacpan.org/v1/module/"
+ module
+ "?fields=distribution"))
"distribution"))
(define (package->upstream-name package)
@@ -114,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-alist (string-append "https://fastapi.metacpan.org/v1/release/" name)))
+ (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name)))
(define (cpan-home name)
(string-append "https://metacpan.org/release/" name))
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 29318aac0e..52c5cb1c30 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-alist (string-append crate-url crate-name)))
+ (and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
(crate (assoc-ref crate-json "crate"))
(name (assoc-ref crate "name"))
(version (assoc-ref crate "max_version"))
@@ -63,8 +63,8 @@
string->license)
'())) ;missing license info
(path (string-append "/" version "/dependencies"))
- (deps-json (json-fetch-alist (string-append crate-url name path)))
- (deps (assoc-ref deps-json "dependencies"))
+ (deps-json (json-fetch (string-append crate-url name path)))
+ (deps (vector->list (assoc-ref deps-json "dependencies")))
(dep-crates (filter (crate-kind-predicate "normal") deps))
(dev-dep-crates
(filter (lambda (dep)
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index ea576b5e4a..0bf9ff2552 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -40,7 +40,7 @@
(define (rubygems-fetch name)
"Return an alist representation of the RubyGems metadata for the package NAME,
or #f on failure."
- (json-fetch-alist
+ (json-fetch
(string-append "https://rubygems.org/api/v1/gems/" name ".json")))
(define (ruby-package-name name)
@@ -130,14 +130,18 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
(assoc-ref package "info")))
(home-page (assoc-ref package "homepage_uri"))
(dependencies-names (map (lambda (dep) (assoc-ref dep "name"))
- (assoc-ref* package "dependencies" "runtime")))
+ (vector->list
+ (assoc-ref* package
+ "dependencies"
+ "runtime"))))
(dependencies (map (lambda (dep)
(if (string=? dep "bundler")
"bundler" ; special case, no prefix
(ruby-package-name dep)))
dependencies-names))
(licenses (map string->license
- (assoc-ref package "licenses"))))
+ (vector->list
+ (assoc-ref package "licenses")))))
(values (make-gem-sexp name version hash home-page synopsis
description dependencies licenses)
dependencies-names)))))
diff --git a/guix/import/json.scm b/guix/import/json.scm
index 81ea5e7b31..8900724dcd 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,8 +23,7 @@
#:use-module (guix http-client)
#:use-module (guix import utils)
#:use-module (srfi srfi-34)
- #:export (json-fetch
- json-fetch-alist))
+ #:export (json-fetch))
(define* (json-fetch url
;; Note: many websites returns 403 if we omit a
@@ -43,9 +42,3 @@ the query."
(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."
- (and=> (json-fetch url)
- hash-table->alist))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index ab7a024ee0..9b3d80a02e 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -56,7 +56,7 @@
(define (pypi-fetch name)
"Return an alist representation of the PyPI metadata for the package NAME,
or #f on failure."
- (json-fetch-alist (string-append "https://pypi.org/pypi/" name "/json")))
+ (json-fetch (string-append "https://pypi.org/pypi/" name "/json")))
;; For packages found on PyPI that lack a source distribution.
(define-condition-type &missing-source-error &error
@@ -69,7 +69,7 @@ or #f on failure."
(assoc-ref* pypi-package "info" "version"))))
(or (find (lambda (release)
(string=? "sdist" (assoc-ref release "packagetype")))
- releases)
+ (vector->list releases))
(raise (condition (&missing-source-error
(package pypi-package)))))))
@@ -80,7 +80,7 @@ or #f if there isn't any."
(assoc-ref* pypi-package "info" "version"))))
(or (find (lambda (release)
(string=? "bdist_wheel" (assoc-ref release "packagetype")))
- releases)
+ (vector->list releases))
#f)))
(define (python->package-name name)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 1c1e73a723..194bea633e 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-alist url)))
+ (lts-info (json-fetch url)))
(if lts-info
(reverse lts-info)
(leave-with-message "LTS release version not found: ~a" version))))))
@@ -74,7 +74,7 @@
(define (lts-package-version pkgs-info name)
"Return the version of the package with upstream NAME included in PKGS-INFO."
(let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
- pkgs-info)))
+ (vector->list pkgs-info))))
(stackage-package-version pkg)))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 84503ab907..2a3b7341fb 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -45,7 +45,6 @@
#:use-module (srfi srfi-41)
#:export (factorize-uri
- hash-table->alist
flatten
assoc-ref*
@@ -100,21 +99,6 @@ of the string VERSION is replaced by the symbol 'version."
'()
indices))))))
-(define (hash-table->alist table)
- "Return an alist represenation of TABLE."
- (map (match-lambda
- ((key . (lst ...))
- (cons key
- (map (lambda (x)
- (if (hash-table? x)
- (hash-table->alist x)
- x))
- lst)))
- ((key . (? hash-table? table))
- (cons key (hash-table->alist table)))
- (pair pair))
- (hash-map->list cons table)))
-
(define (flatten lst)
"Return a list that recursively concatenates all sub-lists of LST."
(fold-right
@@ -330,11 +314,14 @@ the expected fields of an <origin> object."
(lookup-build-system-by-name
(string->symbol (assoc-ref meta "build-system"))))
(native-inputs
- (specs->package-lists (or (assoc-ref meta "native-inputs") '())))
+ (specs->package-lists
+ (vector->list (or (assoc-ref meta "native-input
