summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-07-21 23:05:54 +0200
committerLudovic Courtès <ludo@gnu.org>2019-07-25 00:16:41 +0200
commit81c3dc32244a17241d74eea9fa265edfcb326f6d (patch)
treef480f5cb7728612aab25f2ff89da0fa7a249763a
parenta0efa069a147f0e7b3bb305ae546609e9dd77045 (diff)
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.
-rw-r--r--configure.ac4
-rw-r--r--doc/guix.texi2
-rw-r--r--gnu/installer.scm4
-rw-r--r--gnu/installer/locale.scm21
-rw-r--r--gnu/system/vm.scm2
-rw-r--r--guix/docker.scm19
-rw-r--r--guix/git-download.scm4
-rw-r--r--guix/import/cpan.scm14
-rw-r--r--guix/import/crate.scm6
-rw-r--r--guix/import/gem.scm10
-rw-r--r--guix/import/github.scm13
-rw-r--r--guix/import/json.scm11
-rw-r--r--guix/import/launchpad.scm13
-rw-r--r--guix/import/pypi.scm8
-rw-r--r--guix/import/stackage.scm4
-rw-r--r--guix/import/utils.scm25
-rw-r--r--guix/scripts/import/json.scm2
-rw-r--r--guix/scripts/pack.scm2
-rw-r--r--guix/self.scm2
-rw-r--r--guix/swh.scm35
-rw-r--r--m4/guix.m421
-rw-r--r--tests/import-utils.scm22
22 files changed, 140 insertions, 104 deletions
diff --git a/configure.ac b/configure.ac
index 3918550a791..689b28d984f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -119,8 +119,8 @@ if test "x$have_guile_git" != "xyes"; then
119fi 119fi
120 120
121dnl Check for Guile-JSON. 121dnl Check for Guile-JSON.
122GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) 122GUIX_CHECK_GUILE_JSON
123if test "x$have_guile_json" != "xyes"; then 123if test "x$guix_cv_have_recent_guile_json" != "xyes"; then
124 AC_MSG_ERROR([Guile-JSON is missing; please install it.]) 124 AC_MSG_ERROR([Guile-JSON is missing; please install it.])
125fi 125fi
126 126
diff --git a/doc/guix.texi b/doc/guix.texi
index f6d9718f590..c2da4ce1730 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -750,7 +750,7 @@ or later;
750@c FIXME: Specify a version number once a release has been made. 750@c FIXME: Specify a version number once a release has been made.
751@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August 751@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August
7522017 or later; 7522017 or later;
753@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON}; 753@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} 3.x;
754@item @url{https://zlib.net, zlib}; 754@item @url{https://zlib.net, zlib};
755@item @url{https://www.gnu.org/software/make/, GNU Make}. 755@item @url{https://www.gnu.org/software/make/, GNU Make}.
756@end itemize 756@end itemize
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 1452c4dc7ed..15d971dfc4d 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -69,7 +69,7 @@ version of this file."
69 (setlocale LC_ALL "en_US.utf8"))) 69 (setlocale LC_ALL "en_US.utf8")))
70 70
71 (define builder 71 (define builder
72 (with-extensions (list guile-json) 72 (with-extensions (list guile-json-3)
73 (with-imported-modules (source-module-closure 73 (with-imported-modules (source-module-closure
74 '((gnu installer locale))) 74 '((gnu installer locale)))
75 #~(begin 75 #~(begin
@@ -313,7 +313,7 @@ selected keymap."
313 ;; packages …), etc. modules. 313 ;; packages …), etc. modules.
314 (with-extensions (list guile-gcrypt guile-newt 314 (with-extensions (list guile-gcrypt guile-newt
315 guile-parted guile-bytestructures 315 guile-parted guile-bytestructures
316 guile-json guile-git guix) 316 guile-json-3 guile-git guix)
317 (with-imported-modules `(,@(source-module-closure 317 (with-imported-modules `(,@(source-module-closure
318 `(,@modules 318 `(,@modules
319 (gnu services herd) 319 (gnu services herd)
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 13f3a1e881c..ccffb6d8ef5 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -134,16 +134,18 @@ ISO639-3 and ISO639-5 files."
134 (lambda (port-iso639-5) 134 (lambda (port-iso639-5)
135 (filter-map 135 (filter-map
136 (lambda (hash) 136 (lambda (hash)
137 (let ((alpha2 (hash-ref hash "alpha_2")) 137 (let ((alpha2 (assoc-ref hash "alpha_2"))
138 (alpha3 (hash-ref hash "alpha_3")) 138 (alpha3 (assoc-ref hash "alpha_3"))
139 (name (hash-ref hash "name"))) 139 (name (assoc-ref hash "name")))
140 (and (supported-locale? locales alpha2 alpha3) 140 (and (supported-locale? locales alpha2 alpha3)
141 `((alpha2 . ,alpha2) 141 `((alpha2 . ,alpha2)
142 (alpha3 . ,alpha3) 142 (alpha3 . ,alpha3)
143 (name . ,name))))) 143 (name . ,name)))))
144 (append 144 (append
145 (hash-ref (json->scm port-iso639-3) "639-3") 145 (vector->list
146 (hash-ref (json->scm port-iso639-5) "639-5")))))))) 146 (assoc-ref (json->scm port-iso639-3) "639-3"))
147 (vector->list
148 (assoc-ref (json->scm port-iso639-5) "639-5")))))))))
147 149
148(define (language-code->language-name languages language-code) 150(define (language-code->language-name languages language-code)
149 "Using LANGUAGES as a list of ISO639 association lists, return the language 151 "Using LANGUAGES as a list of ISO639 association lists, return the language
@@ -179,10 +181,11 @@ ISO3166 file."
179 (call-with-input-file iso3166 181 (call-with-input-file iso3166
180 (lambda (port) 182 (lambda (port)
181 (map (lambda (hash) 183 (map (lambda (hash)
182 `((alpha2 . ,(hash-ref hash "alpha_2")) 184 `((alpha2 . ,(assoc-ref hash "alpha_2"))
183 (alpha3 . ,(hash-ref hash "alpha_3")) 185 (alpha3 . ,(assoc-ref hash "alpha_3"))
184 (name . ,(hash-ref hash "name")))) 186 (name . ,(assoc-ref hash "name"))))
185 (hash-ref (json->scm port) "3166-1"))))) 187 (vector->list
188 (assoc-ref (json->scm port) "3166-1"))))))
186 189
187(define (territory-code->territory-name territories territory-code) 190(define (territory-code->territory-name territories territory-code)
188 "Using TERRITORIES as a list of ISO3166 association lists return the 191 "Using TERRITORIES as a list of ISO3166 association lists return the
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index e7f7d8ca519..ac6e4ded92f 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -514,7 +514,7 @@ system."
514 (name (string-append name ".tar.gz")) 514 (name (string-append name ".tar.gz"))
515 (graph "system-graph")) 515 (graph "system-graph"))
516 (define build 516 (define build
517 (with-extensions (cons guile-json ;for (guix docker) 517 (with-extensions (cons guile-json-3 ;for (guix docker)
518 gcrypt-sqlite3&co) ;for (guix store database) 518 gcrypt-sqlite3&co) ;for (guix store database)
519 (with-imported-modules `(,@(source-module-closure 519 (with-imported-modules `(,@(source-module-closure
520 '((guix docker) 520 '((guix docker)
diff --git a/guix/docker.scm b/guix/docker.scm
index b1bd226fa1a..c598a073f6b 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -62,9 +62,9 @@
62 62
63(define (manifest path id) 63(define (manifest path id)
64 "Generate a simple image manifest." 64 "Generate a simple image manifest."
65 `(((Config . "config.json") 65 `#(((Config . "config.json")
66 (RepoTags . (,(generate-tag path))) 66 (RepoTags . #(,(generate-tag path)))
67 (Layers . (,(string-append id "/layer.tar")))))) 67 (Layers . #(,(string-append id "/layer.tar"))))))
68 68
69;; According to the specifications this is required for backwards 69;; According to the specifications this is required for backwards
70;; compatibility. It duplicates information provided by the manifest. 70;; compatibility. It duplicates information provided by the manifest.
@@ -81,17 +81,18 @@
81 `((architecture . ,arch) 81 `((architecture . ,arch)
82 (comment . "Generated by GNU Guix") 82 (comment . "Generated by GNU Guix")
83 (created . ,time) 83 (created . ,time)
84 (config . ,`((env . ,(map (match-lambda 84 (config . ,`((env . ,(list->vector
85 ((name . value) 85 (map (match-lambda
86 (string-append name "=" value))) 86 ((name . value)
87 environment)) 87 (string-append name "=" value)))
88 environment)))
88 ,@(if entry-point 89 ,@(if entry-point
89 `((entrypoint . ,entry-point)) 90 `((entrypoint . ,(list->vector entry-point)))
90 '()))) 91 '())))
91 (container_config . #nil) 92 (container_config . #nil)
92 (os . "linux") 93 (os . "linux")
93 (rootfs . ((type . "layers") 94 (rootfs . ((type . "layers")
94 (diff_ids . (,(layer-diff-id layer))))))) 95 (diff_ids . #(,(layer-diff-id layer)))))))
95 96
96(define %tar-determinism-options 97(define %tar-determinism-options
97 ;; GNU tar options to produce archives deterministically. 98 ;; GNU tar options to produce archives deterministically.
diff --git a/guix/git-download.scm b/guix/git-download.scm
index f904d11c25e..8f84681d468 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org> 3;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
4;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> 4;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
5;;; 5;;;
@@ -85,7 +85,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
85 (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) 85 (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
86 86
87 (define guile-json 87 (define guile-json
88 (module-ref (resolve-interface '(gnu packages guile)) 'guile-json)) 88 (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
89 89
90 (define gnutls 90 (define gnutls
91 (module-ref (resolve-interface '(gnu packages tls)) 'gnutls)) 91 (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index d4bea84353d..ec86f117435 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -76,8 +76,8 @@
76 ;; ssleay 76 ;; ssleay
77 ;; sun 77 ;; sun
78 ("zlib" 'zlib) 78 ("zlib" 'zlib)
79 ((x) (string->license x)) 79 (#(x) (string->license x))
80 ((lst ...) `(list ,@(map string->license lst))) 80 (#(lst ...) `(list ,@(map string->license lst)))
81 (_ #f))) 81 (_ #f)))
82 82
83(define (module->name module) 83(define (module->name module)
@@ -88,10 +88,10 @@
88 "Return the base distribution module for a given module. E.g. the 'ok' 88 "Return the base distribution module for a given module. E.g. the 'ok'
89module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would 89module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
90return \"Test-Simple\"" 90return \"Test-Simple\""
91 (assoc-ref (json-fetch-alist (string-append 91 (assoc-ref (json-fetch (string-append
92 "https://fastapi.metacpan.org/v1/module/" 92 "https://fastapi.metacpan.org/v1/module/"
93 module 93 module
94 "?fields=distribution")) 94 "?fields=distribution"))
95 "distribution")) 95 "distribution"))
96 96
97(define (package->upstream-name package) 97(define (package->upstream-name package)
@@ -114,7 +114,7 @@ return \"Test-Simple\""
114 "Return an alist representation of the CPAN metadata for the perl module MODULE, 114 "Return an alist representation of the CPAN metadata for the perl module MODULE,
115or #f on failure. MODULE should be e.g. \"Test::Script\"" 115or #f on failure. MODULE should be e.g. \"Test::Script\""
116 ;; This API always returns the latest release of the module. 116 ;; This API always returns the latest release of the module.
117 (json-fetch-alist (string-append "https://fastapi.metacpan.org/v1/release/" name))) 117 (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name)))
118 118
119(define (cpan-home name) 119(define (cpan-home name)
120 (string-append "https://metacpan.org/release/" name)) 120 (string-append "https://metacpan.org/release/" name))
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 29318aac0ed..52c5cb1c306 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -51,7 +51,7 @@
51 (define (crate-kind-predicate kind) 51 (define (crate-kind-predicate kind)
52 (lambda (dep) (string=? (assoc-ref dep "kind") kind))) 52 (lambda (dep) (string=? (assoc-ref dep "kind") kind)))
53 53
54 (and-let* ((crate-json (json-fetch-alist (string-append crate-url crate-name))) 54 (and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
55 (crate (assoc-ref crate-json "crate")) 55 (crate (assoc-ref crate-json "crate"))
56 (name (assoc-ref crate "name")) 56 (name (assoc-ref crate "name"))
57 (version (assoc-ref crate "max_version")) 57 (version (assoc-ref crate "max_version"))
@@ -63,8 +63,8 @@
63 string->license) 63 string->license)
64 '())) ;missing license info 64 '())) ;missing license info
65 (path (string-append "/" version "/dependencies")) 65 (path (string-append "/" version "/dependencies"))
66 (deps-json (json-fetch-alist (string-append crate-url name path))) 66 (deps-json (json-fetch (string-append crate-url name path)))
67 (deps (assoc-ref deps-json "dependencies")) 67 (deps (vector->list (assoc-ref deps-json "dependencies")))
68 (dep-crates (filter (crate-kind-predicate "normal") deps)) 68 (dep-crates (filter (crate-kind-predicate "normal") deps))
69 (dev-dep-crates 69 (dev-dep-crates
70 (filter (lambda (dep) 70 (filter (lambda (dep)
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index ea576b5e4a9..0bf9ff25527 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -40,7 +40,7 @@
40(define (rubygems-fetch name) 40(define (rubygems-fetch name)
41 "Return an alist representation of the RubyGems metadata for the package NAME, 41 "Return an alist representation of the RubyGems metadata for the package NAME,
42or #f on failure." 42or #f on failure."
43 (json-fetch-alist 43 (json-fetch
44 (string-append "https://rubygems.org/api/v1/gems/" name ".json"))) 44 (string-append "https://rubygems.org/api/v1/gems/" name ".json")))
45 45
46(define (ruby-package-name name) 46(define (ruby-package-name name)
@@ -130,14 +130,18 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
130 (assoc-ref package "info"))) 130 (assoc-ref package "info")))
131 (home-page (assoc-ref package "homepage_uri")) 131 (home-page (assoc-ref package "homepage_uri"))
132 (dependencies-names (map (lambda (dep) (assoc-ref dep "name")) 132 (dependencies-names (map (lambda (dep) (assoc-ref dep "name"))
133 (assoc-ref* package "dependencies" "runtime"))) 133 (vector->list
134 (assoc-ref* package
135 "dependencies"
136 "runtime"))))
134 (dependencies (map (lambda (dep) 137 (dependencies (map (lambda (dep)
135 (if (string=? dep "bundler") 138 (if (string=? dep "bundler")
136 "bundler" ; special case, no prefix 139 "bundler" ; special case, no prefix
137 (ruby-package-name dep))) 140 (ruby-package-name dep)))
138 dependencies-names)) 141 dependencies-names))
139 (licenses (map string->license 142 (licenses (map string->license
140 (assoc-ref package "licenses")))) 143 (vector->list
144 (assoc-ref package "licenses")))))
141 (values (make-gem-sexp name version hash home-page synopsis 145 (values (make-gem-sexp name version hash home-page synopsis
142 description dependencies licenses) 146 description dependencies licenses)
143 dependencies-names))))) 147 dependencies-names)))))
diff --git a/guix/import/github.scm b/guix/import/github.scm
index cdac70420aa..fa23fa4c067 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> 2;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
3;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
4;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> 4;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
5;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> 5;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
6;;; 6;;;
@@ -130,7 +130,7 @@ repository separated by a forward slash, from a string URL of the form
130 130
131(define (fetch-releases-or-tags url) 131(define (fetch-releases-or-tags url)
132 "Fetch the list of \"releases\" or, if it's empty, the list of tags for the 132 "Fetch the list of \"releases\" or, if it's empty, the list of tags for the
133repository at URL. Return the corresponding JSON dictionaries (hash tables), 133repository at URL. Return the corresponding JSON dictionaries (alists),
134or #f if the information could not be retrieved. 134or #f if the information could not be retrieved.
135 135
136We look at both /releases and /tags because the \"release\" feature of GitHub 136We look at both /releases and /tags because the \"release\" feature of GitHub
@@ -172,11 +172,11 @@ empty list."
172'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of 172'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
173the package e.g. 'bedtools2'. Return #f if there is no releases" 173the package e.g. 'bedtools2'. Return #f if there is no releases"
174 (define (pre-release? x) 174 (define (pre-release? x)
175 (hash-ref x "prerelease")) 175 (assoc-ref x "prerelease"))
176 176
177 (define (release->version release) 177 (define (release->version release)
178 (let ((tag (or (hash-ref release "tag_name") ;a "release" 178 (let ((tag (or (assoc-ref release "tag_name") ;a "release"
179 (hash-ref release "name"))) ;a tag 179 (assoc-ref release "name"))) ;a tag
180 (name-length (string-length package-name))) 180 (name-length (string-length package-name)))
181 (cond 181 (cond
182 ;; some tags include the name of the package e.g. "fdupes-1.51" 182 ;; 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"
197 tag) 197 tag)
198 (else #f)))) 198 (else #f))))
199 199
200 (let* ((json (fetch-releases-or-tags url))) 200 (let* ((json (and=> (fetch-releases-or-tags url)
201 vector->list)))
201 (if (eq? json #f) 202 (if (eq? json #f)
202 (if (%github-token) 203 (if (%github-token)
203 (error "Error downloading release information through the GitHub 204 (error "Error downloading release information through the GitHub
diff --git a/guix/import/json.scm b/guix/import/json.scm
index 81ea5e7b31b..8900724dcdf 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -1,7 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 David Thompson <davet@gnu.org> 2;;; Copyright © 2014 David Thompson <davet@gnu.org>
3;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org> 3;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
4;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> 4;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
5;;; 5;;;
6;;; This file is part of GNU Guix. 6;;; This file is part of GNU Guix.
7;;; 7;;;
@@ -23,8 +23,7 @@
23 #:use-module (guix http-client) 23 #:use-module (guix http-client)
24 #:use-module (guix import utils) 24 #:use-module (guix import utils)
25 #:use-module (srfi srfi-34) 25 #:use-module (srfi srfi-34)
26 #:export (json-fetch 26 #:export (json-fetch))
27 json-fetch-alist))
28 27
29(define* (json-fetch url 28(define* (json-fetch url
30 ;; Note: many websites returns 403 if we omit a 29 ;; Note: many websites returns 403 if we omit a
@@ -43,9 +42,3 @@ the query."
43 (result (json->scm port))) 42 (result (json->scm port)))
44 (close-port port) 43 (close-port port)
45 result))) 44 result)))
46
47(define (json-fetch-alist url)
48 "Return an alist representation of the JSON resource URL, or #f if URL
49returns 403 or 404."
50 (and=> (json-fetch url)
51 hash-table->alist))
diff --git a/guix/import/launchpad.scm b/guix/import/launchpad.scm
index ffd5e9221e6..1a15f280770 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."
87 ;; example, "5.1.0-rc1") are assumed to be pre-releases. 87 ;; example, "5.1.0-rc1") are assumed to be pre-releases.
88 (not (string-every (char-set-union (char-set #\.) 88 (not (string-every (char-set-union (char-set #\.)
89 char-set:digit) 89 char-set:digit)
90 (hash-ref x "version")))) 90 (assoc-ref x "version"))))
91 91
92 (hash-ref 92 (assoc-ref
93 (last (remove 93 (last (remove
94 pre-release? 94 pre-release?
95 (hash-ref (json-fetch 95 (vector->list
96 (string-append "https://api.launchpad.net/1.0/" 96 (assoc-ref (json-fetch
97 package-name "/releases")) 97 (string-append "https://api.launchpad.net/1.0/"
98 "entries"))) 98 package-name "/releases"))
99 "entries"))))
99 "version")) 100 "version"))
100 101
101(define (latest-release pkg) 102(define (latest-release pkg)
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index ab7a024ee0f..9b3d80a02e1 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -1,7 +1,7 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 David Thompson <davet@gnu.org> 2;;; Copyright © 2014 David Thompson <davet@gnu.org>
3;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com> 3;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
4;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> 4;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
5;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> 5;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
6;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> 6;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
7;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> 7;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -56,7 +56,7 @@
56(define (pypi-fetch name) 56(define (pypi-fetch name)
57 "Return an alist representation of the PyPI metadata for the package NAME, 57 "Return an alist representation of the PyPI metadata for the package NAME,
58or #f on failure." 58or #f on failure."
59 (json-fetch-alist (string-append "https://pypi.org/pypi/" name "/json"))) 59 (json-fetch (string-append "https://pypi.org/pypi/" name "/json")))
60 60
61;; For packages found on PyPI that lack a source distribution. 61;; For packages found on PyPI that lack a source distribution.
62(define-condition-type &missing-source-error &error 62(define-condition-type &missing-source-error &error
@@ -69,7 +69,7 @@ or #f on failure."
69 (assoc-ref* pypi-package "info" "version")))) 69 (assoc-ref* pypi-package "info" "version"))))
70 (or (find (lambda (release) 70 (or (find (lambda (release)
71 (string=? "sdist" (assoc-ref release "packagetype"))) 71 (string=? "sdist" (assoc-ref release "packagetype")))
72 releases) 72 (vector->list releases))
73 (raise (condition (&missing-source-error 73 (raise (condition (&missing-source-error
74 (package pypi-package))))))) 74 (package pypi-package)))))))
75 75
@@ -80,7 +80,7 @@ or #f if there isn't any."
80 (assoc-ref* pypi-package "info" "version")))) 80 (assoc-ref* pypi-package "info" "version"))))
81 (or (find (lambda (release) 81 (or (find (lambda (release)
82 (string=? "bdist_wheel" (assoc-ref release "packagetype"))) 82 (string=? "bdist_wheel" (assoc-ref release "packagetype")))
83 releases) 83 (vector->list releases))
84 #f))) 84 #f)))
85 85
86(define (python->package-name name) 86(define (python->package-name name)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 1c1e73a723d..194bea633e4 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -60,7 +60,7 @@
60 (let* ((url (if (string=? "" version) 60 (let* ((url (if (string=? "" version)
61 (string-append %stackage-url "/lts") 61 (string-append %stackage-url "/lts")
62 (string-append %stackage-url "/lts-" version))) 62 (string-append %stackage-url "/lts-" version)))
63 (lts-info (json-fetch-alist url))) 63 (lts-info (json-fetch url)))
64 (if lts-info 64 (if lts-info
65 (reverse lts-info) 65 (reverse lts-info)
66 (leave-with-message "LTS release version not found: ~a" version)))))) 66 (leave-with-message "LTS release version not found: ~a" version))))))
@@ -74,7 +74,7 @@
74(define (lts-package-version pkgs-info name) 74(define (lts-package-version pkgs-info name)
75 "Return the version of the package with upstream NAME included in PKGS-INFO." 75 "Return the version of the package with upstream NAME included in PKGS-INFO."
76 (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name)) 76 (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
77 pkgs-info))) 77 (vector->list pkgs-info))))
78 (stackage-package-version pkg))) 78 (stackage-package-version pkg)))
79 79
80 80
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 84503ab9075..2a3b7341fb3 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -45,7 +45,6 @@
45 #:use-module (srfi srfi-41) 45 #:use-module (srfi srfi-41)
46 #:export (factorize-uri 46 #:export (factorize-uri
47 47
48 hash-table->alist
49 flatten 48 flatten
50 assoc-ref* 49 assoc-ref*
51 50
@@ -100,21 +99,6 @@ of the string VERSION is replaced by the symbol 'version."
100 '() 99 '()
101 indices)))))) 100 indices))))))
102 101
103(define (hash-table->alist table)
104 "Return an alist represenation of TABLE."
105 (map (match-lambda
106 ((key . (lst ...))
107 (cons key
108 (map (lambda (x)
109 (if (hash-table? x)
110 (hash-table->alist x)
111 x))
112 lst)))
113 ((key . (? hash-table? table))
114 (cons key (hash-table->alist table)))
115 (pair pair))
116 (hash-map->list cons table)))
117
118(define (flatten lst) 102(define (flatten lst)
119 "Return a list that recursively concatenates all sub-lists of LST." 103 "Return a list that recursively concatenates all sub-lists of LST."
120 (fold-right 104 (fold-right
@@ -330,11 +314,14 @@ the expected fields of an <origin> object."
330 (lookup-build-system-by-name 314 (lookup-build-system-by-name
331 (string->symbol (assoc-ref meta "build-system")))) 315 (string->symbol (assoc-ref meta "build-system"))))
332 (native-inputs 316 (native-inputs
333 (specs->package-lists (or (assoc-ref meta "native-inputs") '()))) 317 (specs->package-lists
318 (vector->list (or (assoc-ref meta "native-inputs") '#()))))
334 (inputs 319 (inputs
335 (specs->package-lists (or (assoc-ref meta "inputs") '()))) 320 (specs->package-lists
321 (vector->list (or (assoc-ref meta "inputs") '#()))))
336 (propagated-inputs 322 (propagated-inputs
337 (specs->package-lists (or (assoc-ref meta "propagated-inputs") '()))) 323 (specs->package-lists
324 (vector->list (or (assoc-ref meta "propagated-inputs") '#()))))
338 (home-page 325 (home-page
339 (assoc-ref meta "home-page")) 326 (assoc-ref meta "home-page"))
340 (synopsis 327 (synopsis
diff --git a/guix/scripts/import/json.scm b/guix/scripts/import/json.scm
index 8771e7b0eb7..c9daf65479e 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"))
93 (let ((json (json-string->scm 93 (let ((json (json-string->scm
94 (with-input-from-file file-name read-string)))) 94 (with-input-from-file file-name read-string))))
95 ;; TODO: also print define-module boilerplate 95 ;; TODO: also print define-module boilerplate
96 (package->code (alist->package (hash-table->alist json))))) 96 (package->code (alist->package json))))
97 (lambda _ 97 (lambda _
98 (leave (G_ "invalid JSON in file '~a'~%") file-name)))) 98 (leave (G_ "invalid JSON in file '~a'~%") file-name))))
99 (() 99 (()
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 01472d9768c..fdb98983bff 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -479,7 +479,7 @@ the image."
479 479
480 (define build 480 (define build
481 ;; Guile-JSON and Guile-Gcrypt are required by (guix docker). 481 ;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
482 (with-extensions (list guile-json guile-gcrypt) 482 (with-extensions (list guile-json-3 guile-gcrypt)
483 (with-imported-modules `(((guix config) => ,(make-config.scm)) 483 (with-imported-modules `(((guix config) => ,(make-config.scm))
484 ,@(source-module-closure 484 ,@(source-module-closure
485 `((guix docker) 485 `((guix docker)
diff --git a/guix/self.scm b/guix/self.scm
index 838ede76902..f03fe01d0c9 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -50,7 +50,7 @@
50 (module-ref (resolve-interface module) variable)))) 50 (module-ref (resolve-interface module) variable))))
51 (match-lambda 51 (match-lambda
52 ("guile" (ref '(gnu packages commencement) 'guile-final)) 52 ("guile" (ref '(gnu packages commencement) 'guile-final))
53 ("guile-json" (ref '(gnu packages guile) 'guile-json)) 53 ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
54 ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) 54 ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh))
55 ("guile-git" (ref '(gnu packages guile) 'guile-git)) 55 ("guile-git" (ref '(gnu packages guile) 'guile-git))
56 ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) 56 ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
diff --git a/guix/swh.scm b/guix/swh.scm
index d692f81806b..df2a138f048 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -138,16 +138,16 @@ following SPEC, a series of field specifications."
138 (json->scm input)) 138 (json->scm input))
139 ((string? input) 139 ((string? input)
140 (json-string->scm input)) 140 (json-string->scm input))
141 ((hash-table? input) 141 ((or (null? input) (pair? input))
142 input)))) 142 input))))
143 (let-syntax ((extract-field (syntax-rules () 143 (let-syntax ((extract-field (syntax-rules ()
144 ((_ table (field key json->value)) 144 ((_ table (field key json->value))
145 (json->value (hash-ref table key))) 145 (json->value (assoc-ref table key)))
146 ((_ table (field key)) 146 ((_ table (field key))
147 (hash-ref table key)) 147 (assoc-ref table key))
148 ((_ table (field)) 148 ((_ table (field))
149 (hash-ref table 149 (assoc-ref table
150 (symbol->string 'field)))))) 150 (symbol->string 'field))))))
151 (ctor (extract-field table spec) ...))))) 151 (ctor (extract-field table spec) ...)))))
152 152
153(define-syntax-rule (define-json-mapping rtd ctor pred json->record 153(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."
257 (target-url branch-target-url)) 257 (target-url branch-target-url))
258 258
259(define (json->branches branches) 259(define (json->branches branches)
260 (hash-map->list (lambda (key value) 260 (map (match-lambda
261 (make-branch key 261 ((key . value)
262 (string->symbol 262 (make-branch key
263 (hash-ref value "target_type")) 263 (string->symbol
264 (hash-ref value "target_url"))) 264 (assoc-ref value "target_type"))
265 branches)) 265 (assoc-ref value "target_url"))))
266 branches))
266 267
267;; <https://archive.softwareheritage.org/api/1/release/1f44934fb6e2cefccbecd4fa347025349fa9ff76/> 268;; <https://archive.softwareheritage.org/api/1/release/1f44934fb6e2cefccbecd4fa347025349fa9ff76/>
268(define-json-mapping <release> make-release release? 269(define-json-mapping <release> make-release release?
@@ -292,9 +293,10 @@ FALSE-IF-404? is true, return #f upon 404 responses."
292 (license-url content-license-url "license_url")) 293 (license-url content-license-url "license_url"))
293 294
294(define (json->checksums checksums) 295(define (json->checksums checksums)
295 (hash-map->list (lambda (key value) 296 (map (match-lambda
296 (cons key (base16-string->bytevector value))) 297 ((key . value)
297 checksums)) 298 (cons key (base16-string->bytevector value))))
299 checksums))
298 300
299;; <https://archive.softwareheritage.org/api/1/directory/27c69c5d298a43096a53affbf881e7b13f17bdcd/> 301;; <https://archive.softwareheritage.org/api/1/directory/27c69c5d298a43096a53affbf881e7b13f17bdcd/>
300(define-json-mapping <directory-entry> make-directory-entry directory-entry? 302(define-json-mapping <directory-entry> make-directory-entry directory-entry?
@@ -365,14 +367,15 @@ FALSE-IF-404? is true, return #f upon 404 responses."
365 json->directory-entries) 367 json->directory-entries)
366 368
367(define (json->directory-entries port) 369(define (json->directory-entries port)
368 (map json->directory-entry (json->scm port))) 370 (map json->directory-entry
371 (vector->list (json->scm port))))
369 372
370(define (origin-visits origin) 373(define (origin-visits origin)
371 "Return the list of visits of ORIGIN, a record as returned by 374 "Return the list of visits of ORIGIN, a record as returned by
372'lookup-origin'." 375'lookup-origin'."
373 (call (swh-url (origin-visits-url origin)) 376 (call (swh-url (origin-visits-url origin))
374 (lambda (port) 377 (lambda (port)
375 (map json->visit (json->scm port))))) 378 (map json->visit (vector->list (json->scm port))))))
376 379
377(define (visit-snapshot visit) 380(define (visit-snapshot visit)
378 "Return the snapshot corresponding to VISIT." 381 "Return the snapshot corresponding to VISIT."
diff --git a/m4/guix.m4 b/m4/guix.m4
index d0c5ec0f083..716bfb08ec8 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -174,6 +174,27 @@ AC_DEFUN([GUIX_CHECK_GUILE_SQLITE3], [
174 fi]) 174 fi])
175]) 175])
176 176
177dnl GUIX_CHECK_GUILE_JSON
178dnl
179dnl Check whether a recent-enough Guile-JSON is available.
180AC_DEFUN([GUIX_CHECK_GUILE_JSON], [
181 dnl Check whether we're using Guile-JSON 3.x, which uses a JSON-to-Scheme
182 dnl mapping different from that of earlier versions.
183 AC_CACHE_CHECK([whether Guile-JSON is available and recent enough],
184 [guix_cv_have_recent_guile_json],
185 [GUILE_CHECK([retval],
186 [(use-modules (json) (ice-9 match))
187 (match (json-string->scm \"[[] { \\\"a\\\": 42 } []]\")
188 (#(("a" . 42)) #t)
189 (_ #f))])
190 if test "$retval" = 0; then
191 guix_cv_have_recent_guile_json="yes"
192 else
193 guix_cv_have_recent_guile_json="no"
194 fi])
195])
196
197
177dnl GUIX_TEST_ROOT_DIRECTORY 198dnl GUIX_TEST_ROOT_DIRECTORY
178AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ 199AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [
179 AC_CACHE_CHECK([for unit test root directory], 200 AC_CACHE_CHECK([for unit test root directory],
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 5c0c041360f..c3ab25d7883 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -23,6 +23,7 @@
23 #:use-module ((guix licenses) #:prefix license:) 23 #:use-module ((guix licenses) #:prefix license:)
24 #:use-module (guix packages) 24 #:use-module (guix packages)
25 #:use-module (guix build-system) 25 #:use-module (guix build-system)
26 #:use-module (gnu packages)
26 #:use-module (srfi srfi-64)) 27 #:use-module (srfi srfi-64))
27 28
28(test-begin "import-utils") 29(test-begin "import-utils")
@@ -98,4 +99,25 @@
98 (or (package-license (alist->package meta)) 99 (or (package-license (alist->package meta))
99 'license-is-false))) 100 'license-is-false)))
100 101
102(test-equal "alist->package with dependencies"
103 `(("gettext" ,(specification->package "gettext")))
104 (let* ((meta '(("name" . "hello")
105 ("version" . "2.10")
106 ("source" . (("method" . "url-fetch")
107 ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
108 ("sha256" .
109 (("base32" .
110 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
111 ("build-system" . "gnu")
112 ("home-page" . "https://gnu.org")
113 ("synopsis" . "Say hi")
114 ("description" . "This package says hi.")
115 ;
116 ;; Note: As with Guile-JSON 3.x, JSON arrays are represented
117 ;; by vectors.
118 ("native-inputs" . #("gettext"))
119
120 ("license" . #f))))
121 (package-native-inputs (alist->package meta))))
122
101(test-end "import-utils") 123(test-end "import-utils")