ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 06:18:07 -05: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
Show stats Download patch file Download diff file Expand all files Collapse all files

35
guix/import/json.scm
View file

@ -24,8 +24,11 @@ (define-module (guix import json)
#: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 @@ (define* (json-fetch url
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 @@ (define (json->scheme-file file)
(guix)
((guix licenses) #:prefix license:))
port)
(write json port)))
(for-each (cut write <> port) sexprs)))
file*))