diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2020-04-15 00:43:39 +0200 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2020-04-16 23:41:52 +0200 |
| commit | 7cef499bb060aabf3d59cc4eca37350e5c79ff7d (patch) | |
| tree | acf8511d8a652f4249e6a457c75f35bd3dc1ddbc | |
| parent | 3532fc39fff41eabd061370ee36a1d42b9fac0e6 (diff) | |
import/json: json->code: Handle files with more than one definition.
* guix/import/json.scm (json->code): Convert JSON arrays to lists of package
definitions.
(json->scheme-file): Write all expressions to the target file.
| -rw-r--r-- | guix/import/json.scm | 35 |
1 files changed, 30 insertions, 5 deletions
diff --git a/guix/import/json.scm b/guix/import/json.scm index 8f8dbbd05d..0c98bb25b8 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -24,8 +24,11 @@ #:use-module (guix http-client) #:use-module (guix import utils) #:use-module (guix import print) + #:use-module (ice-9 match) #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:export (json-fetch json->code @@ -50,19 +53,41 @@ the query." result))) (define (json->code file-name) - "Read FILE-NAME containing a JSON package definition and return an -S-expression, or return #F when the JSON is invalid." + "Read FILE-NAME containing one ore more JSON package definitions and return +a list of S-expressions, or return #F when the JSON is invalid." (catch 'json-invalid (lambda () (let ((json (json-string->scm (with-input-from-file file-name read-string)))) - (package->code (alist->package json)))) + (match json + (#(packages ...) + ;; To allow definitions to refer to one another, collect references + ;; to local definitions and tell alist->package to ignore them. + (second + (memq #:result + (fold + (lambda (pkg names+result) + (match names+result + ((#:names names #:result result) + (list #:names + (cons (assoc-ref pkg "name") names) + #:result + (append result + (list + (package->code (alist->package pkg names)) + (string->symbol (assoc-ref pkg "name")))))))) + (list #:names '() + #:result '()) + packages)))) + (package + (list (package->code (alist->package json)) + (string->symbol (assoc-ref json "name"))))))) (const #f))) (define (json->scheme-file file) "Convert the FILE containing a JSON package definition to a Scheme representation and return the new file name (or #F on error)." - (and-let* ((json (json->code file)) + (and-let* ((sexprs (json->code file)) (file* (let* ((tempdir (or (getenv "TMPDIR") "/tmp")) (template (string-append tempdir "/guix-XXXXXX")) (port (mkstemp! template))) @@ -74,5 +99,5 @@ representation and return the new file name (or #F on error)." (guix) ((guix licenses) #:prefix license:)) port) - (write json port))) + (for-each (cut write <> port) sexprs))) file*)) |