[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/03: maint: Switch to Guile-JSON 3.x.
|
From: |
guix-commits |
|
Subject: |
01/03: maint: Switch to Guile-JSON 3.x. |
|
Date: |
Wed, 24 Jul 2019 18:37:26 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 81c3dc32244a17241d74eea9fa265edfcb326f6d
Author: Ludovic Courtès <address@hidden>
Date: Sun Jul 21 23:05:54 2019 +0200
maint: Switch to Guile-JSON 3.x.
Guile-JSON 3.x is incompatible with Guile-JSON 1.x, which we relied on
until now: it maps JSON dictionaries to alists (instead of hash tables),
and JSON arrays to vectors (instead of lists). This commit is about
adjusting all the existing code to this new mapping.
* 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.
* guix/import/github.scm (fetch-releases-or-tags): Update docstring.
(latest-released-version): Use 'assoc-ref' instead of 'hash-ref'. Pass
the result of 'fetch-releases-or-tags' to 'vector->list'.
* guix/import/launchpad.scm (latest-released-version): Likewise.
---
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/github.scm | 13 +++++++------
guix/import/json.scm | 11 ++---------
guix/import/launchpad.scm | 13 +++++++------
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 ++++++++++++++++++++++
22 files changed, 140 insertions(+), 104 deletions(-)
diff --git a/configure.ac b/configure.ac
index 3918550..689b28d 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 f6d9718..c2da4ce 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -750,7 +750,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 1452c4d..15d971d 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 13f3a1e..ccffb6d 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 e7f7d8c..ac6e4de 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 b1bd226..c598a07 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 f904d11..8f84681 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 <address@hidden>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès
<address@hidden>
;;; Copyright © 2017 Mathieu Lirzin <address@hidden>
;;; Copyright © 2017 Christopher Baines <address@hidden>
;;;
@@ -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 d4bea84..ec86f11 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 29318aa..52c5cb1 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 ea576b5..0bf9ff2 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/github.scm b/guix/import/github.scm
index cdac704..fa23fa4 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ben Woodcroft <address@hidden>
-;;; Copyright © 2017, 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <address@hidden>
;;; Copyright © 2018 Eric Bavier <address@hidden>
;;; Copyright © 2019 Arun Isaac <address@hidden>
;;;
@@ -130,7 +130,7 @@ repository separated by a forward slash, from a string URL
of the form
(define (fetch-releases-or-tags url)
"Fetch the list of \"releases\" or, if it's empty, the list of tags for the
-repository at URL. Return the corresponding JSON dictionaries (hash tables),
+repository at URL. Return the corresponding JSON dictionaries (alists),
or #f if the information could not be retrieved.
We look at both /releases and /tags because the \"release\" feature of GitHub
@@ -172,11 +172,11 @@ empty list."
'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
the package e.g. 'bedtools2'. Return #f if there is no releases"
(define (pre-release? x)
- (hash-ref x "prerelease"))
+ (assoc-ref x "prerelease"))
(define (release->version release)
- (let ((tag (or (hash-ref release "tag_name") ;a "release"
- (hash-ref release "name"))) ;a tag
+ (let ((tag (or (assoc-ref release "tag_name") ;a "release"
+ (assoc-ref release "name"))) ;a tag
(name-length (string-length package-name)))
(cond
;; some tags include the name of the package e.g. "fdupes-1.51"
@@ -197,7 +197,8 @@ the package e.g. 'bedtools2'. Return #f if there is no
releases"
tag)
(else #f))))
- (let* ((json (fetch-releases-or-tags url)))
+ (let* ((json (and=> (fetch-releases-or-tags url)
+ vector->list)))
(if (eq? json #f)
(if (%github-token)
(error "Error downloading release information through the GitHub
diff --git a/guix/import/json.scm b/guix/import/json.scm
index 81ea5e7..8900724 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 <address@hidden>
;;; Copyright © 2015, 2016 Eric Bavier <address@hidden>
-;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018, 2019 Ludovic Courtès <address@hidden>
;;;
;;; 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/launchpad.scm b/guix/import/launchpad.scm
index ffd5e92..1a15f28 100644
--- a/guix/import/launchpad.scm
+++ b/guix/import/launchpad.scm
@@ -87,15 +87,16 @@ for example, 'linuxdcpp'. Return #f if there is no
releases."
;; example, "5.1.0-rc1") are assumed to be pre-releases.
(not (string-every (char-set-union (char-set #\.)
char-set:digit)
- (hash-ref x "version"))))
+ (assoc-ref x "version"))))
- (hash-ref
+ (assoc-ref
(last (remove
pre-release?
- (hash-ref (json-fetch
- (string-append "https://api.launchpad.net/1.0/";
- package-name "/releases"))
- "entries")))
+ (vector->list
+ (assoc-ref (json-fetch
+ (string-append "https://api.launchpad.net/1.0/";
+ package-name "/releases"))
+ "entries"))))
"version"))
(define (latest-release pkg)
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index ab7a024..9b3d80a 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 <address@hidden>
;;; Copyright © 2015 Cyril Roelandt <address@hidden>
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <address@hidden>
;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
;;; Copyright © 2018 Ricardo Wurmus <address@hidden>
;;; Copyright © 2019 Maxim Cournoyer <address@hidden>
@@ -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 1c1e73a..194bea6 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 84503ab..2a3b734 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-inputs") '#()))))
(inputs
- (specs->package-lists (or (assoc-ref meta "inputs") '())))
+ (specs->package-lists
+ (vector->list (or (assoc-ref meta "inputs") '#()))))
(propagated-inputs
- (specs->package-lists (or (assoc-ref meta "propagated-inputs") '())))
+ (specs->package-lists
+ (vector->list (or (assoc-ref meta "propagated-inputs") '#()))))
(home-page
(assoc-ref meta "home-page"))
(synopsis
diff --git a/guix/scripts/import/json.scm b/guix/scripts/import/json.scm
index 8771e7b..c9daf65 100644
--- a/guix/scripts/import/json.scm
+++ b/guix/scripts/import/json.scm
@@ -93,7 +93,7 @@ Import and convert the JSON package definition in
PACKAGE-FILE.\n"))
(let ((json (json-string->scm
(with-input-from-file file-name read-string))))
;; TODO: also print define-module boilerplate
- (package->code (alist->package (hash-table->alist json)))))
+ (package->code (alist->package json))))
(lambda _
(leave (G_ "invalid JSON in file '~a'~%") file-name))))
(()
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 01472d9..fdb9898 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -479,7 +479,7 @@ the image."
(define build
;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
- (with-extensions (list guile-json guile-gcrypt)
+ (with-extensions (list guile-json-3 guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
,@(source-module-closure
`((guix docker)
diff --git a/guix/self.scm b/guix/self.scm
index 838ede7..f03fe01 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -50,7 +50,7 @@
(module-ref (resolve-interface module) variable))))
(match-lambda
("guile" (ref '(gnu packages commencement) 'guile-final))
- ("guile-json" (ref '(gnu packages guile) 'guile-json))
+ ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh))
("guile-git" (ref '(gnu packages guile) 'guile-git))
("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
diff --git a/guix/swh.scm b/guix/swh.scm
index d692f81..df2a138 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -138,16 +138,16 @@ following SPEC, a series of field specifications."
(json->scm input))
((string? input)
(json-string->scm input))
- ((hash-table? input)
+ ((or (null? input) (pair? input))
input))))
(let-syntax ((extract-field (syntax-rules ()
((_ table (field key json->value))
- (json->value (hash-ref table key)))
+ (json->value (assoc-ref table key)))
((_ table (field key))
- (hash-ref table key))
+ (assoc-ref table key))
((_ table (field))
- (hash-ref table
- (symbol->string 'field))))))
+ (assoc-ref table
+ (symbol->string 'field))))))
(ctor (extract-field table spec) ...)))))
(define-syntax-rule (define-json-mapping rtd ctor pred json->record
@@ -257,12 +257,13 @@ FALSE-IF-404? is true, return #f upon 404 responses."
(target-url branch-target-url))
(define (json->branches branches)
- (hash-map->list (lambda (key value)
- (make-branch key
- (string->symbol
- (hash-ref value "target_type"))
- (hash-ref value "target_url")))
- branches))
+ (map (match-lambda
+ ((key . value)
+ (make-branch key
+ (string->symbol
+ (assoc-ref value "target_type"))
+ (assoc-ref value "target_url"))))
+ branches))
;;
<https://archive.softwareheritage.org/api/1/release/1f44934fb6e2cefccbecd4fa347025349fa9ff76/>
(define-json-mapping <release> make-release release?
@@ -292,9 +293,10 @@ FALSE-IF-404? is true, return #f upon 404 responses."
(license-url content-license-url "license_url"))
(define (json->checksums checksums)
- (hash-map->list (lambda (key value)
- (cons key (base16-string->bytevector value)))
- checksums))
+ (map (match-lambda
+ ((key . value)
+ (cons key (base16-string->bytevector value))))
+ checksums))
;;
<https://archive.softwareheritage.org/api/1/directory/27c69c5d298a43096a53affbf881e7b13f17bdcd/>
(define-json-mapping <directory-entry> make-directory-entry directory-entry?
@@ -365,14 +367,15 @@ FALSE-IF-404? is true, return #f upon 404 responses."
json->directory-entries)
(define (json->directory-entries port)
- (map json->directory-entry (json->scm port)))
+ (map json->directory-entry
+ (vector->list (json->scm port))))
(define (origin-visits origin)
"Return the list of visits of ORIGIN, a record as returned by
'lookup-origin'."
(call (swh-url (origin-visits-url origin))
(lambda (port)
- (map json->visit (json->scm port)))))
+ (map json->visit (vector->list (json->scm port))))))
(define (visit-snapshot visit)
"Return the snapshot corresponding to VISIT."
diff --git a/m4/guix.m4 b/m4/guix.m4
index d0c5ec0..716bfb0 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -174,6 +174,27 @@ AC_DEFUN([GUIX_CHECK_GUILE_SQLITE3], [
fi])
])
+dnl GUIX_CHECK_GUILE_JSON
+dnl
+dnl Check whether a recent-enough Guile-JSON is available.
+AC_DEFUN([GUIX_CHECK_GUILE_JSON], [
+ dnl Check whether we're using Guile-JSON 3.x, which uses a JSON-to-Scheme
+ dnl mapping different from that of earlier versions.
+ AC_CACHE_CHECK([whether Guile-JSON is available and recent enough],
+ [guix_cv_have_recent_guile_json],
+ [GUILE_CHECK([retval],
+ [(use-modules (json) (ice-9 match))
+ (match (json-string->scm \"[[] { \\\"a\\\": 42 } []]\")
+ (#(("a" . 42)) #t)
+ (_ #f))])
+ if test "$retval" = 0; then
+ guix_cv_have_recent_guile_json="yes"
+ else
+ guix_cv_have_recent_guile_json="no"
+ fi])
+])
+
+
dnl GUIX_TEST_ROOT_DIRECTORY
AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [
AC_CACHE_CHECK([for unit test root directory],
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 5c0c041..c3ab25d 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -23,6 +23,7 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix build-system)
+ #:use-module (gnu packages)
#:use-module (srfi srfi-64))
(test-begin "import-utils")
@@ -98,4 +99,25 @@
(or (package-license (alist->package meta))
'license-is-false)))
+(test-equal "alist->package with dependencies"
+ `(("gettext" ,(specification->package "gettext")))
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" . (("method" . "url-fetch")
+ ("uri" .
"mirror://gnu/hello/hello-2.10.tar.gz")
+ ("sha256" .
+ (("base32" .
+
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org";)
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ;
+ ;; Note: As with Guile-JSON 3.x, JSON arrays are represented
+ ;; by vectors.
+ ("native-inputs" . #("gettext"))
+
+ ("license" . #f))))
+ (package-native-inputs (alist->package meta))))
+
(test-end "import-utils")