amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

import/json: json->code: Handle files with more than one definition.

Browse source 
* guix/import/json.scm (json->code): Convert JSON arrays to lists of package
definitions.
(json->scheme-file): Write all expressions to the target file.
This commit is contained in:
Ricardo Wurmus 2020-04-15 00:43:39 +02:00
parent 3532fc39ff
commit 7cef499bb0
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
1 changed files with 30 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

35
guix/import/json.scm
View file

@ -24,8 +24,11 @@
#:use-module (guix http-client) #:use-module (guix http-client)
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix import print) #:use-module (guix import print)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:export (json-fetch #:export (json-fetch
json->code json->code
@ -50,19 +53,41 @@ the query."
result))) result)))
(define (json->code file-name) (define (json->code file-name)
"Read FILE-NAME containing a JSON package definition and return an "Read FILE-NAME containing one ore more JSON package definitions and return
S-expression, or return #F when the JSON is invalid." a list of S-expressions, or return #F when the JSON is invalid."
(catch 'json-invalid (catch 'json-invalid
(lambda () (lambda ()
(let ((json (json-string->scm (let ((json (json-string->scm
(with-input-from-file file-name read-string)))) (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))) (const #f)))
(define (json->scheme-file file) (define (json->scheme-file file)
"Convert the FILE containing a JSON package definition to a Scheme "Convert the FILE containing a JSON package definition to a Scheme
representation and return the new file name (or #F on error)." 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")) (file* (let* ((tempdir (or (getenv "TMPDIR") "/tmp"))
(template (string-append tempdir "/guix-XXXXXX")) (template (string-append tempdir "/guix-XXXXXX"))
(port (mkstemp! template))) (port (mkstemp! template)))
@ -74,5 +99,5 @@ representation and return the new file name (or #F on error)."
(guix) (guix)
((guix licenses) #:prefix license:)) ((guix licenses) #:prefix license:))
port) port)
(write json port))) (for-each (cut write <> port) sexprs)))
file*)) file*))