GNU bug report logs - #40629
Build and install packages from JSON definitions

Previous Next

Full log

Message #32 received at 40629 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: 40629 <at> debbugs.gnu.org
Cc: Ricardo Wurmus <rekado <at> elephly.net>
Subject: [PATCH 9/9] import/json: json->code: Handle files with more than one
 definition.
Date: Wed, 15 Apr 2020 00:48:17 +0200

* guix/import/json.scm (json->code): Convert JSON arrays to lists of package
definitions.
(json->scheme-file): Write all expressions to the target file.
---
 guix/import/json.scm | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

diff --git a/guix/import/json.scm b/guix/import/json.scm
index 8f8dbbd05d..de35984211 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 (list
+                                       (package->code (alist->package pkg names))
+                                       (string->symbol (assoc-ref pkg "name")))
+                                      result)))))
+                        (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*))
-- 
2.25.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.