all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Ricardo Wurmus <rekado@elephly.net>
To: 40629@debbugs.gnu.org
Cc: Ricardo Wurmus <rekado@elephly.net>
Subject: [bug#40629] [PATCH 9/9] import/json: json->code: Handle files with more than one definition.
Date: Wed, 15 Apr 2020 00:48:17 +0200	[thread overview]
Message-ID: <20200414224817.3850-4-rekado@elephly.net> (raw)
In-Reply-To: <20200414224817.3850-1-rekado@elephly.net>

* 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

  parent reply	other threads:[~2020-04-14 22:49 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-04-14 15:44 [bug#40629] Build and install packages from JSON definitions Ricardo Wurmus
2020-04-14 17:19 ` [bug#40629] [PATCH 1/5] import/print: Return license with prefix Ricardo Wurmus
2020-04-14 17:19   ` [bug#40629] [PATCH 2/5] import/print: package->code: Wrap build system value in module reference Ricardo Wurmus
2020-04-14 17:19   ` [bug#40629] [PATCH 3/5] import/json: Add json->scheme-file Ricardo Wurmus
2020-04-14 17:19   ` [bug#40629] [PATCH 4/5] scripts/build: options->things-to-build: Handle .json files Ricardo Wurmus
2020-04-16 21:45     ` Ludovic Courtès
2020-04-16 21:53     ` Ludovic Courtès
2020-04-14 17:19   ` [bug#40629] [PATCH 5/5] scripts/package: Handle JSON files Ricardo Wurmus
2020-04-14 22:48 ` [bug#40629] [PATCH 6/9] import/json: Use json->code Ricardo Wurmus
2020-04-14 22:48   ` [bug#40629] [PATCH 7/9] import/print: package->code: Wrap S-expression in definition Ricardo Wurmus
2020-04-14 22:48   ` [bug#40629] [PATCH 8/9] import/utils: alist->package: Ignore known inputs Ricardo Wurmus
2020-04-14 22:48   ` Ricardo Wurmus [this message]
2020-04-14 22:59 ` [bug#40629] [PATCH v2 " Ricardo Wurmus
2020-04-14 22:59   ` [bug#40629] [PATCH v2 9/9] import/json: json->code: Handle files with more than one definition Ricardo Wurmus
2020-04-14 23:01     ` Ricardo Wurmus
2020-04-17  5:32       ` Jan Nieuwenhuizen
2020-04-18 20:23         ` Ricardo Wurmus
2020-04-15 18:26 ` [bug#40629] Build and install packages from JSON definitions Christopher Baines
2020-04-15 22:27   ` Ricardo Wurmus
2020-04-16 21:44     ` bug#40629: " Ricardo Wurmus
2020-04-17 17:45     ` [bug#40629] " Christopher Baines
2020-04-16 21:50 ` Ludovic Courtès
2020-04-17  8:25   ` Ricardo Wurmus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20200414224817.3850-4-rekado@elephly.net \
    --to=rekado@elephly.net \
    --cc=40629@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.