diff mbox series

[bug#40629,v2,9/9] import/json: json->code: Handle files with more than one definition.

Message ID 20200414225903.10862-2-rekado@elephly.net
State Accepted
Headers show
Series None | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch fail View Laminar job

Commit Message

Ricardo Wurmus April 14, 2020, 10:59 p.m. UTC 
* 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(-)

Comments

Ricardo Wurmus April 14, 2020, 11:01 p.m. UTC | #1 
With these last few changes it’s now possible to have multiple
definitions in a JSON array:

--8<---------------cut here---------------start------------->8---
[
  {
    "name": "myhello",
    "version": "2.10",
    "source": "mirror://gnu/hello/hello-2.10.tar.gz",
    "build-system": "gnu",
    "home-page": "https://www.gnu.org/software/hello/",
    "synopsis": "Hello, GNU world: An example GNU package",
    "description": "GNU Hello prints a greeting.",
    "license": "GPL-3.0+",
    "native-inputs": ["gettext"]
  },
  {
    "name": "hello2",
    "version": "2.10",
    "source": "mirror://gnu/hello/hello-2.10.tar.gz",
    "build-system": "gnu",
    "home-page": "https://www.gnu.org/software/hello/",
    "synopsis": "Hello, GNU world: An example GNU package",
    "description": "GNU Hello prints a greeting.",
    "license": "GPL-3.0+",
    "inputs": ["myhello"],
    "native-inputs": ["gettext"]
  }
]
--8<---------------cut here---------------end--------------->8---

“hello2” has “myhello” as an input.  When this file is passed to “guix
install -f” both packages will be built and “hello2” will be installed
into the profile as it is the last package in the list.

--
Ricardo
Janneke Nieuwenhuizen April 17, 2020, 5:32 a.m. UTC | #2 
Ricardo Wurmus writes:

> With these last few changes it’s now possible to have multiple
> definitions in a JSON array:
>
> [
>   {
>     "name": "myhello",
>     "version": "2.10",
>     "source": "mirror://gnu/hello/hello-2.10.tar.gz",
>     "build-system": "gnu",
>     "home-page": "https://www.gnu.org/software/hello/",
>     "synopsis": "Hello, GNU world: An example GNU package",
>     "description": "GNU Hello prints a greeting.",
>     "license": "GPL-3.0+",
>     "native-inputs": ["gettext"]
>   },
>   {
>     "name": "hello2",
>     "version": "2.10",
>     "source": "mirror://gnu/hello/hello-2.10.tar.gz",
>     "build-system": "gnu",
>     "home-page": "https://www.gnu.org/software/hello/",
>     "synopsis": "Hello, GNU world: An example GNU package",
>     "description": "GNU Hello prints a greeting.",
>     "license": "GPL-3.0+",
>     "inputs": ["myhello"],
>     "native-inputs": ["gettext"]
>   }
> ]
>
> “hello2” has “myhello” as an input.  When this file is passed to “guix
> install -f” both packages will be built and “hello2” will be installed
> into the profile as it is the last package in the list.

Great!  I am imagining this as an s-expression, maybe something like

--8<---------------cut here---------------start------------->8---
(define-package
  (alist->package
   '((name          "hello")
     (version       "2.10")
     (build-system  "gnu")
     (home-page     "https://www.gnu.org/software/hello/")
     (synopsis      "Hello, GNU world: An example GNU package")
     (description   "GNU Hello prints a greeting.")
     (license       "GPL-3.0+")
     (native-inputs "gettext"))))
--8<---------------cut here---------------end--------------->8---

We may need some dots, or (native-inputs #("gettext")) if we are using
json->scm in the process; just dreaming out loud here.

Greetings,
janneke
Ricardo Wurmus April 18, 2020, 8:23 p.m. UTC | #3 
Jan Nieuwenhuizen <janneke@gnu.org> writes:

> Ricardo Wurmus writes:
>
>> With these last few changes it’s now possible to have multiple
>> definitions in a JSON array:
>>
>> [
>>   {
>>     "name": "myhello",
>>     "version": "2.10",
>>     "source": "mirror://gnu/hello/hello-2.10.tar.gz",
>>     "build-system": "gnu",
>>     "home-page": "https://www.gnu.org/software/hello/",
>>     "synopsis": "Hello, GNU world: An example GNU package",
>>     "description": "GNU Hello prints a greeting.",
>>     "license": "GPL-3.0+",
>>     "native-inputs": ["gettext"]
>>   },
>>   {
>>     "name": "hello2",
>>     "version": "2.10",
>>     "source": "mirror://gnu/hello/hello-2.10.tar.gz",
>>     "build-system": "gnu",
>>     "home-page": "https://www.gnu.org/software/hello/",
>>     "synopsis": "Hello, GNU world: An example GNU package",
>>     "description": "GNU Hello prints a greeting.",
>>     "license": "GPL-3.0+",
>>     "inputs": ["myhello"],
>>     "native-inputs": ["gettext"]
>>   }
>> ]
>>
>> “hello2” has “myhello” as an input.  When this file is passed to “guix
>> install -f” both packages will be built and “hello2” will be installed
>> into the profile as it is the last package in the list.
>
> Great!  I am imagining this as an s-expression, maybe something like
>
> --8<---------------cut here---------------start------------->8---
> (define-package
>   (alist->package
>    '((name          "hello")
>      (version       "2.10")
>      (build-system  "gnu")
>      (home-page     "https://www.gnu.org/software/hello/")
>      (synopsis      "Hello, GNU world: An example GNU package")
>      (description   "GNU Hello prints a greeting.")
>      (license       "GPL-3.0+")
>      (native-inputs "gettext"))))
> --8<---------------cut here---------------end--------------->8---
>
> We may need some dots, or (native-inputs #("gettext")) if we are using
> json->scm in the process; just dreaming out loud here.

Yes, the S-expr equivalent would be:

(define-public my-hello
  (alist->package
    '(("name"          . "hello")
      ("version"       . "2.10")
      ("build-system"  . "gnu")
      ("source"        . "http://example.com")
      ("home-page"     . "https://www.gnu.org/software/hello/")
      ("synopsis"      . "Hello, GNU world: An example GNU package")
      ("description"   . "GNU Hello prints a greeting."")
      ("native-inputs" . #("gettext"))
      ("license"       . "GPL-3.0+"))))

alist->package expects an alist of the kind that json->scm would return;
vectors are used for lists to distinguish them from nested alists (which
would be used for the “arguments” field).
diff mbox series

Patch

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*))