diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-07-21 23:05:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-07-25 00:16:41 +0200 |
| commit | 81c3dc32244a17241d74eea9fa265edfcb326f6d (patch) | |
| tree | f480f5cb7728612aab25f2ff89da0fa7a249763a | |
| parent | a0efa069a147f0e7b3bb305ae546609e9dd77045 (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.ac | 4 | ||||
| -rw-r--r-- | doc/guix.texi | 2 | ||||
| -rw-r--r-- | gnu/installer.scm | 4 | ||||
| -rw-r--r-- | gnu/installer/locale.scm | 21 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 2 | ||||
| -rw-r--r-- | guix/docker.scm | 19 | ||||
| -rw-r--r-- | guix/git-download.scm | 4 | ||||
| -rw-r--r-- | guix/import/cpan.scm | 14 | ||||
| -rw-r--r-- | guix/import/crate.scm | 6 | ||||
| -rw-r--r-- | guix/import/gem.scm | 10 | ||||
| -rw-r--r-- | guix/import/github.scm | 13 | ||||
| -rw-r--r-- | guix/import/json.scm | 11 | ||||
| -rw-r--r-- | guix/import/launchpad.scm | 13 | ||||
| -rw-r--r-- | guix/import/pypi.scm | 8 | ||||
| -rw-r--r-- | guix/import/stackage.scm | 4 | ||||
| -rw-r--r-- | guix/import/utils.scm | 25 | ||||
| -rw-r--r-- | guix/scripts/import/json.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 2 | ||||
| -rw-r--r-- | guix/self.scm | 2 | ||||
| -rw-r--r-- | guix/swh.scm | 35 | ||||
| -rw-r--r-- | m4/guix.m4 | 21 | ||||
| -rw-r--r-- | tests/import-utils.scm | 22 |
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 | |||
| 119 | fi | 119 | fi |
| 120 | 120 | ||
| 121 | dnl Check for Guile-JSON. | 121 | dnl Check for Guile-JSON. |
| 122 | GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) | 122 | GUIX_CHECK_GUILE_JSON |
| 123 | if test "x$have_guile_json" != "xyes"; then | 123 | if 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.]) |
| 125 | fi | 125 | fi |
| 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 |
| 752 | 2017 or later; | 752 | 2017 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' |
| 89 | module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would | 89 | module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would |
| 90 | return \"Test-Simple\"" | 90 | return \"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, |
| 115 | or #f on failure. MODULE should be e.g. \"Test::Script\"" | 115 | or #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, |
| 42 | or #f on failure." | 42 | or #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 |
| 133 | repository at URL. Return the corresponding JSON dictionaries (hash tables), | 133 | repository at URL. Return the corresponding JSON dictionaries (alists), |
| 134 | or #f if the information could not be retrieved. | 134 | or #f if the information could not be retrieved. |
| 135 | 135 | ||
| 136 | We look at both /releases and /tags because the \"release\" feature of GitHub | 136 | We 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 |
| 173 | the package e.g. 'bedtools2'. Return #f if there is no releases" | 173 | the 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 | ||
| 49 | returns 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, |
| 58 | or #f on failure." | 58 | or #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 | ||
| 177 | dnl GUIX_CHECK_GUILE_JSON | ||
| 178 | dnl | ||
| 179 | dnl Check whether a recent-enough Guile-JSON is available. | ||
| 180 | AC_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 | |||
| 177 | dnl GUIX_TEST_ROOT_DIRECTORY | 198 | dnl GUIX_TEST_ROOT_DIRECTORY |
| 178 | AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ | 199 | AC_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") |
