diff options
| -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 3918550a79..689b28d984 100644 --- a/configure.ac +++ b/configure.ac @@ -119,8 +119,8 @@ if test "x$have_guile_git" != "xyes"; then fi dnl Check for Guile-JSON. -GUILE_MODULE_AVAILABLE([have_guile_json], [(json)]) -if test "x$have_guile_json" != "xyes"; then +GUIX_CHECK_GUILE_JSON +if test "x$guix_cv_have_recent_guile_json" != "xyes"; then AC_MSG_ERROR([Guile-JSON is missing; please install it.]) fi diff --git a/doc/guix.texi b/doc/guix.texi index f6d9718f59..c2da4ce173 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 1452c4dc7e..15d971dfc4 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -69,7 +69,7 @@ version of this file." (setlocale LC_ALL "en_US.utf8"))) (define builder - (with-extensions (list guile-json) + (with-extensions (list guile-json-3) (with-imported-modules (source-module-closure '((gnu installer locale))) #~(begin @@ -313,7 +313,7 @@ selected keymap." ;; packages …), etc. modules. (with-extensions (list guile-gcrypt guile-newt guile-parted guile-bytestructures - guile-json guile-git guix) + guile-json-3 guile-git guix) (with-imported-modules `(,@(source-module-closure `(,@modules (gnu services herd) diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm index 13f3a1e881..ccffb6d8ef 100644 --- a/gnu/installer/locale.scm +++ b/gnu/installer/locale.scm @@ -134,16 +134,18 @@ ISO639-3 and ISO639-5 files." (lambda (port-iso639-5) (filter-map (lambda (hash) - (let ((alpha2 (hash-ref hash "alpha_2")) - (alpha3 (hash-ref hash "alpha_3")) - (name (hash-ref hash "name"))) + (let ((alpha2 (assoc-ref hash "alpha_2")) + (alpha3 (assoc-ref hash "alpha_3")) + (name (assoc-ref hash "name"))) (and (supported-locale? locales alpha2 alpha3) `((alpha2 . ,alpha2) (alpha3 . ,alpha3) (name . ,name))))) (append - (hash-ref (json->scm port-iso639-3) "639-3") - (hash-ref (json->scm port-iso639-5) "639-5")))))))) + (vector->list + (assoc-ref (json->scm port-iso639-3) "639-3")) + (vector->list + (assoc-ref (json->scm port-iso639-5) "639-5"))))))))) (define (language-code->language-name languages language-code) "Using LANGUAGES as a list of ISO639 association lists, return the language @@ -179,10 +181,11 @@ ISO3166 file." (call-with-input-file iso3166 (lambda (port) (map (lambda (hash) - `((alpha2 . ,(hash-ref hash "alpha_2")) - (alpha3 . ,(hash-ref hash "alpha_3")) - (name . ,(hash-ref hash "name")))) - (hash-ref (json->scm port) "3166-1"))))) + `((alpha2 . ,(assoc-ref hash "alpha_2")) + (alpha3 . ,(assoc-ref hash "alpha_3")) + (name . ,(assoc-ref hash "name")))) + (vector->list + (assoc-ref (json->scm port) "3166-1")))))) (define (territory-code->territory-name territories territory-code) "Using TERRITORIES as a list of ISO3166 association lists return the diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index e7f7d8ca51..ac6e4ded92 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -514,7 +514,7 @@ system." (name (string-append name ".tar.gz")) (graph "system-graph")) (define build - (with-extensions (cons guile-json ;for (guix docker) + (with-extensions (cons guile-json-3 ;for (guix docker) gcrypt-sqlite3&co) ;for (guix store database) (with-imported-modules `(,@(source-module-closure '((guix docker) diff --git a/guix/docker.scm b/guix/docker.scm index b1bd226fa1..c598a073f6 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -62,9 +62,9 @@ (define (manifest path id) "Generate a simple image manifest." - `(((Config . "config.json") - (RepoTags . (,(generate-tag path))) - (Layers . (,(string-append id "/layer.tar")))))) + `#(((Config . "config.json") + (RepoTags . #(,(generate-tag path))) + (Layers . #(,(string-append id "/layer.tar")))))) ;; According to the specifications this is required for backwards ;; compatibility. It duplicates information provided by the manifest. @@ -81,17 +81,18 @@ `((architecture . ,arch) (comment . "Generated by GNU Guix") (created . ,time) - (config . ,`((env . ,(map (match-lambda - ((name . value) - (string-append name "=" value))) - environment)) + (config . ,`((env . ,(list->vector + (map (match-lambda + ((name . value) + (string-append name "=" value))) + environment))) ,@(if entry-point - `((entrypoint . ,entry-point)) + `((entrypoint . ,(list->vector entry-point))) '()))) (container_config . #nil) (os . "linux") (rootfs . ((type . "layers") - (diff_ids . (,(layer-diff-id layer))))))) + (diff_ids . #(,(layer-diff-id layer))))))) (define %tar-determinism-options ;; GNU tar options to produce archives deterministically. diff --git a/guix/git-download.scm b/guix/git-download.scm index f904d11c25..8f84681d46 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; @@ -85,7 +85,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) (define guile-json - (module-ref (resolve-interface '(gnu packages guile)) 'guile-json)) + (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3)) (define gnutls (module-ref (resolve-interface '(gnu packages tls)) 'gnutls)) diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index d4bea84353..ec86f11743 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -76,8 +76,8 @@ ;; ssleay ;; sun ("zlib" 'zlib) - ((x) (string->license x)) - ((lst ...) `(list ,@(map string->license lst))) + (#(x) (string->license x)) + (#(lst ...) `(list ,@(map string->license lst))) (_ #f))) (define (module->name module) @@ -88,10 +88,10 @@ "Return the base distribution module for a given module. E.g. the 'ok' module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" - (assoc-ref (json-fetch-alist (string-append - "https://fastapi.metacpan.org/v1/module/" - module - "?fields=distribution")) + (assoc-ref (json-fetch (string-append + "https://fastapi.metacpan.org/v1/module/" + module + "?fields=distribution")) "distribution")) (define (package->upstream-name package) @@ -114,7 +114,7 @@ return \"Test-Simple\"" "Return an alist representation of the CPAN metadata for the perl module MODULE, or #f on failure. MODULE should be e.g. \"Test::Script\"" ;; This API always returns the latest release of the module. - (json-fetch-alist (string-append "https://fastapi.metacpan.org/v1/release/" name))) + (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name))) (define (cpan-home name) (string-append "https://metacpan.org/release/" name)) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 29318aac0e..52c5cb1c30 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -51,7 +51,7 @@ (define (crate-kind-predicate kind) (lambda (dep) (string=? (assoc-ref dep "kind") kind))) - (and-let* ((crate-json (json-fetch-alist (string-append crate-url crate-name))) + (and-let* ((crate-json (json-fetch (string-append crate-url crate-name))) (crate (assoc-ref crate-json "crate")) (name (assoc-ref crate "name")) (version (assoc-ref crate "max_version")) @@ -63,8 +63,8 @@ string->license) '())) ;missing license info (path (string-append "/" version "/dependencies")) - (deps-json (json-fetch-alist (string-append crate-url name path))) - (deps (assoc-ref deps-json "dependencies")) + (deps-json (json-fetch (string-append crate-url name path))) + (deps (vector->list (assoc-ref deps-json "dependencies"))) (dep-crates (filter (crate-kind-predicate "normal") deps)) (dev-dep-crates (filter (lambda (dep) diff --git a/guix/import/gem.scm b/guix/import/gem.scm index ea576b5e4a..0bf9ff2552 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -40,7 +40,7 @@ (define (rubygems-fetch name) "Return an alist representation of the RubyGems metadata for the package NAME, or #f on failure." - (json-fetch-alist + (json-fetch (string-append "https://rubygems.org/api/v1/gems/" name ".json"))) (define (ruby-package-name name) @@ -130,14 +130,18 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." (assoc-ref package "info"))) (home-page (assoc-ref package "homepage_uri")) (dependencies-names (map (lambda (dep) (assoc-ref dep "name")) - (assoc-ref* package "dependencies" "runtime"))) + (vector->list + (assoc-ref* package + "dependencies" + "runtime")))) (dependencies (map (lambda (dep) (if (string=? dep "bundler") "bundler" ; special case, no prefix (ruby-package-name dep))) dependencies-names)) (licenses (map string->license - (assoc-ref package "licenses")))) + (vector->list + (assoc-ref package "licenses"))))) (values (make-gem-sexp name version hash home-page synopsis description dependencies licenses) dependencies-names))))) diff --git a/guix/import/github.scm b/guix/import/github.scm index cdac70420a..fa23fa4c06 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 <donttrustben@gmail.com> -;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; @@ -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 81ea5e7b31..8900724dcd 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,8 +23,7 @@ #:use-module (guix http-client) #:use-module (guix import utils) #:use-module (srfi srfi-34) - #:export (json-fetch - json-fetch-alist)) + #:export (json-fetch)) (define* (json-fetch url ;; Note: many websites returns 403 if we omit a @@ -43,9 +42,3 @@ the query." (result (json->scm port))) (close-port port) result))) - -(define (json-fetch-alist url) - "Return an alist representation of the JSON resource URL, or #f if URL -returns 403 or 404." - (and=> (json-fetch url) - hash-table->alist)) diff --git a/guix/import/launchpad.scm b/guix/import/launchpad.scm index ffd5e9221e..1a15f28077 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 ab7a024ee0..9b3d80a02e 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com> -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> @@ -56,7 +56,7 @@ (define (pypi-fetch name) "Return an alist representation of the PyPI metadata for the package NAME, or #f on failure." - (json-fetch-alist (string-append "https://pypi.org/pypi/" name "/json"))) + (json-fetch (string-append "https://pypi.org/pypi/" name "/json"))) ;; For packages found on PyPI that lack a source distribution. (define-condition-type &missing-source-error &error @@ -69,7 +69,7 @@ or #f on failure." (assoc-ref* pypi-package "info" "version")))) (or (find (lambda (release) (string=? "sdist" (assoc-ref release "packagetype"))) - releases) + (vector->list releases)) (raise (condition (&missing-source-error (package pypi-package))))))) @@ -80,7 +80,7 @@ or #f if there isn't any." (assoc-ref* pypi-package "info" "version")))) (or (find (lambda (release) (string=? "bdist_wheel" (assoc-ref release "packagetype"))) - releases) + (vector->list releases)) #f))) (define (python->package-name name) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 1c1e73a723..194bea633e 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -60,7 +60,7 @@ (let* ((url (if (string=? "" version) (string-append %stackage-url "/lts") (string-append %stackage-url "/lts-" version))) - (lts-info (json-fetch-alist url))) + (lts-info (json-fetch url))) (if lts-info (reverse lts-info) (leave-with-message "LTS release version not found: ~a" version)))))) @@ -74,7 +74,7 @@ (define (lts-package-version pkgs-info name) "Return the version of the package with upstream NAME included in PKGS-INFO." (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name)) - pkgs-info))) + (vector->list pkgs-info)))) (stackage-package-version pkg))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 84503ab907..2a3b7341fb 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -45,7 +45,6 @@ #:use-module (srfi srfi-41) #:export (factorize-uri - hash-table->alist flatten assoc-ref* @@ -100,21 +99,6 @@ of the string VERSION is replaced by the symbol 'version." '() indices)))))) -(define (hash-table->alist table) - "Return an alist represenation of TABLE." - (map (match-lambda - ((key . (lst ...)) - (cons key - (map (lambda (x) - (if (hash-table? x) - (hash-table->alist x) - x)) - lst))) - ((key . (? hash-table? table)) - (cons key (hash-table->alist table))) - (pair pair)) - (hash-map->list cons table))) - (define (flatten lst) "Return a list that recursively concatenates all sub-lists of LST." (fold-right @@ -330,11 +314,14 @@ the expected fields of an <origin> object." (lookup-build-system-by-name (string->symbol (assoc-ref meta "build-system")))) (native-inputs - (specs->package-lists (or (assoc-ref meta "native-inputs") '()))) + (specs->package-lists + (vector->list (or (assoc-ref meta "native-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 8771e7b0eb..c9daf65479 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 01472d9768..fdb98983bf 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 838ede7690..f03fe01d0c 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 d692f81806..df2a138f04 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 d0c5ec0f08..716bfb08ec 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 5c0c041360..c3ab25d788 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") |