[bug#40629] Build and install packages from JSON definitions

[bug#40629] Build and install packages from JSON definitions

[Ricardo Wurmus]

Hi Guix,

did you know that we have JSON importer?  Admittedly, it’s not very
useful because people don’t generally use JSON syntax to define Guix
packages.  Not even Guix lets you build and install packages from JSON
definitions, so what’s the point really?

Well, fret not!  This patch set adds support for JSON package
definitions to “guix package -f” and “guix build -f”.  You can now dump
this into a file “hello.json”:

--8<---------------cut here---------------start------------->8---
{
  "name": "hello",
  "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"]
}
--8<---------------cut here---------------end--------------->8---

and then install the hello package with “guix package -f hello.json”
without having to first run the JSON importer.

Since the JSON importer doesn’t know how to work with more than one
definition you can’t have more than one custom definition in your JSON
file, but if there’s interest we can easily add support for this.

(My patch set does not come with documentation changes for “guix
package” or “guix build”.)

What do you think?

--
Ricardo

[bug#40629] [PATCH 1/5] import/print: Return license with prefix.

[Ricardo Wurmus]

* guix/import/print.scm (license->code): Prepend license: prefix.
---
 guix/import/print.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 4c2a91fa4f..b819e7cf90 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,7 +57,7 @@ when evaluated."
   ;; Print either license variable name or the code for a license object
   (define (license->code lic)
     (let ((var (variable-name lic '(guix licenses))))
-      (or var
+      (or (symbol-append 'license: var)
           `(license
             (name ,(license-name lic))
             (uri ,(license-uri lic))
-- 
2.25.1

[bug#40629] [PATCH 2/5] import/print: package->code: Wrap build system value in module reference.

[Ricardo Wurmus]

* guix/import/print.scm (package->code): Return build system value with
corresponding module.
---
 guix/import/print.scm | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index b819e7cf90..4529a79b23 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -131,8 +131,9 @@ when evaluated."
        ,@(if replacement
              `((replacement ,replacement))
              '())
-       (build-system ,(symbol-append (build-system-name build-system)
-                                     '-build-system))
+       (build-system (@ (guix build-system ,(build-system-name build-system))
+                        ,(symbol-append (build-system-name build-system)
+                                        '-build-system)))
        ,@(match arguments
            (() '())
            (args `((arguments ,(list 'quasiquote args)))))
-- 
2.25.1

[bug#40629] [PATCH 3/5] import/json: Add json->scheme-file.

[Ricardo Wurmus]

* guix/import/json.scm (json->code, json->scheme-file): New procedures.
---
 guix/import/json.scm | 35 ++++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/guix/import/json.scm b/guix/import/json.scm
index 8900724dcd..16dc2ad5cb 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,8 +23,12 @@
   #:use-module (json)
   #:use-module (guix http-client)
   #:use-module (guix import utils)
+  #:use-module (guix import print)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-34)
-  #:export (json-fetch))
+  #:export (json-fetch
+            json->scheme-file))
 
 (define* (json-fetch url
                      ;; Note: many websites returns 403 if we omit a
@@ -42,3 +47,31 @@ the query."
            (result (json->scm port)))
       (close-port port)
       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."
+  (catch 'json-invalid
+    (lambda ()
+      (let ((json (json-string->scm
+                   (with-input-from-file file-name read-string))))
+        (package->code (alist->package json))))
+    (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))
+             (file* (let* ((tempdir (or (getenv "TMPDIR") "/tmp"))
+                           (template (string-append tempdir "/guix-XXXXXX"))
+                           (port     (mkstemp! template)))
+                      (close-port port)
+                      template)))
+    (call-with-output-file file*
+      (lambda (port)
+        (write '(use-modules (gnu)
+                             (guix)
+                             ((guix licenses) #:prefix license:))
+               port)
+        (write json port)))
+    file*))
-- 
2.25.1

[bug#40629] [PATCH 4/5] scripts/build: options->things-to-build: Handle .json files.

[Ricardo Wurmus]

* guix/scripts/build.scm (options->things-to-build): Handle files that end on
.json.
---
 guix/scripts/build.scm | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 79bd84a1a0..8ff2fd1910 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
 (define-module (guix scripts build)
   #:use-module (guix ui)
   #:use-module (guix scripts)
+  #:use-module (guix import json)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
@@ -834,7 +836,10 @@ build---packages, gexps, derivations, and so on."
                        (else
                         (list (specification->package spec)))))
                 (('file . file)
-                 (ensure-list (load* file (make-user-module '()))))
+                 (let ((file (or (and (string-suffix? ".json" file)
+                                      (json->scheme-file file))
+                                 file)))
+                   (ensure-list (load* file (make-user-module '())))))
                 (('manifest . manifest)
                  (map manifest-entry-item
                       (manifest-entries
-- 
2.25.1

[bug#40629] [PATCH 4/5] scripts/build: options->things-to-build: Handle .json files.

[Ludovic Courtès]

Hello!

Ricardo Wurmus <rekado@elephly.net> skribis:

> +                 (let ((file (or (and (string-suffix? ".json" file)
> +                                      (json->scheme-file file))
> +                                 file)))
> +                   (ensure-list (load* file (make-user-module '())))))

It would be nice if we could avoid writing to a file and then reading it
back, perhaps by having a variant of ‘load*’ that takes an sexp instead
of a file name.  (That could also allow us to improve error reporting
because we could attach source properties to the sexp that match the
original JSON file.)

Ludo’.

[bug#40629] [PATCH 4/5] scripts/build: options->things-to-build: Handle .json files.

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> +                 (let ((file (or (and (string-suffix? ".json" file)
> +                                      (json->scheme-file file))
> +                                 file)))
> +                   (ensure-list (load* file (make-user-module '())))))

Actually, perhaps we could have a file handler alist, like:

  `((".json" ,load-json)
    (_ ,(cute load* <> (make-user-module '()))))

That could be shared with (guix scripts package), and ‘load-json’ could
do something that avoids going through a file.

Late feedback, nightly thoughts.  :-)

Ludo’.

[bug#40629] [PATCH 5/5] scripts/package: Handle JSON files.

[Ricardo Wurmus]

* guix/scripts/package.scm (%options): Support loading from JSON files when
"install-from-file" is used.
---
 guix/scripts/package.scm | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index badb1dcd38..40445832aa 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,7 @@
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix search-paths)
+  #:use-module (guix import json)
   #:use-module (guix monads)
   #:use-module (guix utils)
   #:use-module (guix config)
@@ -418,7 +420,10 @@ Install, remove, or upgrade packages in a single transaction.\n"))
          (option '(#\f "install-from-file") #t #f
                  (lambda (opt name arg result arg-handler)
                    (values (alist-cons 'install
-                                       (load* arg (make-user-module '()))
+                                       (let ((file (or (and (string-suffix? ".json" arg)
+                                                            (json->scheme-file arg))
+                                                       arg)))
+                                         (load* file (make-user-module '())))
                                        result)
                            #f)))
          (option '(#\r "remove") #f #t
-- 
2.25.1

[bug#40629] [PATCH 6/9] import/json: Use json->code.

[Ricardo Wurmus]

* guix/import/json.scm (json->code): Export procedure.
* guix/scripts/import/json.scm (guix-import-json): Use json->code.
---
 guix/import/json.scm         |  1 +
 guix/scripts/import/json.scm | 12 +++---------
 2 files changed, 4 insertions(+), 9 deletions(-)

diff --git a/guix/import/json.scm b/guix/import/json.scm
index 16dc2ad5cb..8f8dbbd05d 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-34)
   #:export (json-fetch
+            json->code
             json->scheme-file))
 
 (define* (json-fetch url
diff --git a/guix/scripts/import/json.scm b/guix/scripts/import/json.scm
index c9daf65479..778e5f4bc5 100644
--- a/guix/scripts/import/json.scm
+++ b/guix/scripts/import/json.scm
@@ -23,7 +23,7 @@
   #:use-module (guix utils)
   #:use-module (guix scripts)
   #:use-module (guix import utils)
-  #:use-module (guix import print)
+  #:use-module (guix import json)
   #:use-module (guix scripts import)
   #:use-module (guix packages)
   #:use-module (srfi srfi-1)
@@ -88,14 +88,8 @@ Import and convert the JSON package definition in PACKAGE-FILE.\n"))
                            (reverse opts))))
     (match args
       ((file-name)
-       (catch 'json-invalid
-         (lambda ()
-           (let ((json (json-string->scm
-                        (with-input-from-file file-name read-string))))
-             ;; TODO: also print define-module boilerplate
-             (package->code (alist->package json))))
-         (lambda _
-           (leave (G_ "invalid JSON in file '~a'~%") file-name))))
+       (or (json->code file-name)
+           (leave (G_ "invalid JSON in file '~a'~%") file-name)))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
-- 
2.25.1

[bug#40629] [PATCH 7/9] import/print: package->code: Wrap S-expression in definition.

[Ricardo Wurmus]

* guix/import/print.scm (package->code): Return a definition, not just a
package expression.
---
 guix/import/print.scm | 87 ++++++++++++++++++++++---------------------
 1 file changed, 44 insertions(+), 43 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 4529a79b23..08f3ec9c34 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -121,46 +121,47 @@ when evaluated."
         (home-page           (package-home-page package))
         (supported-systems   (package-supported-systems package))
         (properties          (package-properties package)))
-    `(package
-       (name ,name)
-       (version ,version)
-       (source ,(source->code source version))
-       ,@(match properties
-           (() '())
-           (_  `((properties ,properties))))
-       ,@(if replacement
-             `((replacement ,replacement))
-             '())
-       (build-system (@ (guix build-system ,(build-system-name build-system))
-                        ,(symbol-append (build-system-name build-system)
-                                        '-build-system)))
-       ,@(match arguments
-           (() '())
-           (args `((arguments ,(list 'quasiquote args)))))
-       ,@(match outputs
-           (("out") '())
-           (outs `((outputs (list ,@outs)))))
-       ,@(match native-inputs
-           (() '())
-           (pkgs `((native-inputs ,(package-lists->code pkgs)))))
-       ,@(match inputs
-           (() '())
-           (pkgs `((inputs ,(package-lists->code pkgs)))))
-       ,@(match propagated-inputs
-           (() '())
-           (pkgs `((propagated-inputs ,(package-lists->code pkgs)))))
-       ,@(if (lset= string=? supported-systems %supported-systems)
-             '()
-             `((supported-systems (list ,@supported-systems))))
-       ,@(match (map search-path-specification->code native-search-paths)
-           (() '())
-           (paths `((native-search-paths (list ,@paths)))))
-       ,@(match (map search-path-specification->code search-paths)
-           (() '())
-           (paths `((search-paths (list ,@paths)))))
-       (home-page ,home-page)
-       (synopsis ,synopsis)
-       (description ,description)
-       (license ,(if (list? license)
-                     `(list ,@(map license->code license))
-                     (license->code license))))))
+    `(define-public ,(string->symbol name)
+       (package
+         (name ,name)
+         (version ,version)
+         (source ,(source->code source version))
+         ,@(match properties
+             (() '())
+             (_  `((properties ,properties))))
+         ,@(if replacement
+               `((replacement ,replacement))
+               '())
+         (build-system (@ (guix build-system ,(build-system-name build-system))
+                          ,(symbol-append (build-system-name build-system)
+                                          '-build-system)))
+         ,@(match arguments
+             (() '())
+             (args `((arguments ,(list 'quasiquote args)))))
+         ,@(match outputs
+             (("out") '())
+             (outs `((outputs (list ,@outs)))))
+         ,@(match native-inputs
+             (() '())
+             (pkgs `((native-inputs ,(package-lists->code pkgs)))))
+         ,@(match inputs
+             (() '())
+             (pkgs `((inputs ,(package-lists->code pkgs)))))
+         ,@(match propagated-inputs
+             (() '())
+             (pkgs `((propagated-inputs ,(package-lists->code pkgs)))))
+         ,@(if (lset= string=? supported-systems %supported-systems)
+               '()
+               `((supported-systems (list ,@supported-systems))))
+         ,@(match (map search-path-specification->code native-search-paths)
+             (() '())
+             (paths `((native-search-paths (list ,@paths)))))
+         ,@(match (map search-path-specification->code search-paths)
+             (() '())
+             (paths `((search-paths (list ,@paths)))))
+         (home-page ,home-page)
+         (synopsis ,synopsis)
+         (description ,description)
+         (license ,(if (list? license)
+                       `(list ,@(map license->code license))
+                       (license->code license)))))))
-- 
2.25.1

[bug#40629] [PATCH 8/9] import/utils: alist->package: Ignore known inputs.

[Ricardo Wurmus]

* guix/import/utils.scm (alist->package): Accept optional list of known
inputs, which are excluded from the specification lookup.
* guix/import/print.scm (package->code)[package-lists->code]: Handle inputs
which are just symbols.
---
 guix/import/print.scm |  2 ++
 guix/import/utils.scm | 27 ++++++++++++++++-----------
 2 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 08f3ec9c34..fd297798da 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -92,6 +92,8 @@ when evaluated."
   (define (package-lists->code lsts)
     (list 'quasiquote
           (map (match-lambda
+                 ((? symbol? s)
+                  (cons (symbol->string s) (list 'unquote s)))
                  ((label pkg . out)
                   (let ((mod (package-module-name pkg)))
                     (cons* label
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 94c8cb040b..5fb1322535 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2012, 2013, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
 ;;;
@@ -310,7 +310,18 @@ the expected fields of an <origin> object."
               (uri (assoc-ref orig "uri"))
               (sha256 sha))))))
 
-(define (alist->package meta)
+(define* (alist->package meta #:optional (known-inputs '()))
+  "Return a package value generated from the alist META.  If the list of
+strings KNOWN-INPUTS is provided, do not treat the mentioned inputs as
+specifications to look up and replace them with plain symbols instead."
+  (define (process-inputs which)
+    (let-values (((regular known)
+                  (lset-diff+intersection
+                   string=?
+                   (vector->list (or (assoc-ref meta which) #()))
+                   known-inputs)))
+      (append (specs->package-lists regular)
+              (map string->symbol known))))
   (package
     (name (assoc-ref meta "name"))
     (version (assoc-ref meta "version"))
@@ -318,15 +329,9 @@ the expected fields of an <origin> object."
     (build-system
       (lookup-build-system-by-name
        (string->symbol (assoc-ref meta "build-system"))))
-    (native-inputs
-     (specs->package-lists
-      (vector->list (or (assoc-ref meta "native-inputs") '#()))))
-    (inputs
-     (specs->package-lists
-      (vector->list (or (assoc-ref meta "inputs") '#()))))
-    (propagated-inputs
-     (specs->package-lists
-      (vector->list (or (assoc-ref meta "propagated-inputs") '#()))))
+    (native-inputs (process-inputs "native-inputs"))
+    (inputs (process-inputs "inputs"))
+    (propagated-inputs (process-inputs "propagated-inputs"))
     (home-page
      (assoc-ref meta "home-page"))
     (synopsis
-- 
2.25.1

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

[Ricardo Wurmus]

* 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

[bug#40629] [PATCH v2 8/9] import/utils: alist->package: Ignore known inputs.

[Ricardo Wurmus]

* guix/import/utils.scm (alist->package): Accept optional list of known
inputs, which are excluded from the specification lookup.
* guix/import/print.scm (package->code)[package-lists->code]: Handle inputs
which are just symbols.
---
 guix/import/print.scm |  2 ++
 guix/import/utils.scm | 27 ++++++++++++++++-----------
 2 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 08f3ec9c34..471687c0ff 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -92,6 +92,8 @@ when evaluated."
   (define (package-lists->code lsts)
     (list 'quasiquote
           (map (match-lambda
+                 ((? symbol? s)
+                  (list (symbol->string s) (list 'unquote s)))
                  ((label pkg . out)
                   (let ((mod (package-module-name pkg)))
                     (cons* label
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 94c8cb040b..5fb1322535 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2012, 2013, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
 ;;;
@@ -310,7 +310,18 @@ the expected fields of an <origin> object."
               (uri (assoc-ref orig "uri"))
               (sha256 sha))))))
 
-(define (alist->package meta)
+(define* (alist->package meta #:optional (known-inputs '()))
+  "Return a package value generated from the alist META.  If the list of
+strings KNOWN-INPUTS is provided, do not treat the mentioned inputs as
+specifications to look up and replace them with plain symbols instead."
+  (define (process-inputs which)
+    (let-values (((regular known)
+                  (lset-diff+intersection
+                   string=?
+                   (vector->list (or (assoc-ref meta which) #()))
+                   known-inputs)))
+      (append (specs->package-lists regular)
+              (map string->symbol known))))
   (package
     (name (assoc-ref meta "name"))
     (version (assoc-ref meta "version"))
@@ -318,15 +329,9 @@ the expected fields of an <origin> object."
     (build-system
       (lookup-build-system-by-name
        (string->symbol (assoc-ref meta "build-system"))))
-    (native-inputs
-     (specs->package-lists
-      (vector->list (or (assoc-ref meta "native-inputs") '#()))))
-    (inputs
-     (specs->package-lists
-      (vector->list (or (assoc-ref meta "inputs") '#()))))
-    (propagated-inputs
-     (specs->package-lists
-      (vector->list (or (assoc-ref meta "propagated-inputs") '#()))))
+    (native-inputs (process-inputs "native-inputs"))
+    (inputs (process-inputs "inputs"))
+    (propagated-inputs (process-inputs "propagated-inputs"))
     (home-page
      (assoc-ref meta "home-page"))
     (synopsis
-- 
2.25.1

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

[Ricardo Wurmus]

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

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

[Ricardo Wurmus]

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

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

[Jan Nieuwenhuizen]

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

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

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

[Ricardo Wurmus]

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

-- 
Ricardo

[bug#40629] Build and install packages from JSON definitions

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1637 bytes --]


Ricardo Wurmus <rekado@elephly.net> writes:

> did you know that we have JSON importer?  Admittedly, it’s not very
> useful because people don’t generally use JSON syntax to define Guix
> packages.  Not even Guix lets you build and install packages from JSON
> definitions, so what’s the point really?
>
> Well, fret not!  This patch set adds support for JSON package
> definitions to “guix package -f” and “guix build -f”.  You can now dump
> this into a file “hello.json”:
>
> --8<---------------cut here---------------start------------->8---
> {
>   "name": "hello",
>   "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"]
> }
> --8<---------------cut here---------------end--------------->8---
>
> and then install the hello package with “guix package -f hello.json”
> without having to first run the JSON importer.
>
> Since the JSON importer doesn’t know how to work with more than one
> definition you can’t have more than one custom definition in your JSON
> file, but if there’s interest we can easily add support for this.
>
> (My patch set does not come with documentation changes for “guix
> package” or “guix build”.)
>
> What do you think?

I haven't played with the JSON importer, but this sounds cool. Did you
have any ideas for using this in mind?

Thanks,

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#40629] Build and install packages from JSON definitions

[Ricardo Wurmus]

Christopher Baines <mail@cbaines.net> writes:

> Ricardo Wurmus <rekado@elephly.net> writes:
>
>> did you know that we have JSON importer?  Admittedly, it’s not very
>> useful because people don’t generally use JSON syntax to define Guix
>> packages.  Not even Guix lets you build and install packages from JSON
>> definitions, so what’s the point really?
>>
>> Well, fret not!  This patch set adds support for JSON package
>> definitions to “guix package -f” and “guix build -f”.  You can now dump
>> this into a file “hello.json”:
>>
>> --8<---------------cut here---------------start------------->8---
>> {
>>   "name": "hello",
>>   "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"]
>> }
>> --8<---------------cut here---------------end--------------->8---
>>
>> and then install the hello package with “guix package -f hello.json”
>> without having to first run the JSON importer.
>>
>> Since the JSON importer doesn’t know how to work with more than one
>> definition you can’t have more than one custom definition in your JSON
>> file, but if there’s interest we can easily add support for this.
>>
>> (My patch set does not come with documentation changes for “guix
>> package” or “guix build”.)
>>
>> What do you think?
>
> I haven't played with the JSON importer, but this sounds cool. Did you
> have any ideas for using this in mind?

When I added the JSON importer long ago I also had a commit to extend
“guix build” to install packages from JSON descriptions, but that never
actually made it into the repository.

Even then I didn’t have a grand plan; I just wanted to be able to tell
the Scheme-averse that they could use JSON instead, e.g. for environment
definitions or simple custom packages.

It can be a sneaky way to get people to use Guix even though they are
initially uncomfortable with Scheme.

--
Ricardo

bug#40629: Build and install packages from JSON definitions

[Ricardo Wurmus]

I’ve pushed this to the master branch with documentation and a few minor
changes with commit c9f321e52a.

--
Ricardo

[bug#40629] Build and install packages from JSON definitions

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 2471 bytes --]


Ricardo Wurmus <rekado@elephly.net> writes:

> Christopher Baines <mail@cbaines.net> writes:
>
>> Ricardo Wurmus <rekado@elephly.net> writes:
>>
>>> did you know that we have JSON importer?  Admittedly, it’s not very
>>> useful because people don’t generally use JSON syntax to define Guix
>>> packages.  Not even Guix lets you build and install packages from JSON
>>> definitions, so what’s the point really?
>>>
>>> Well, fret not!  This patch set adds support for JSON package
>>> definitions to “guix package -f” and “guix build -f”.  You can now dump
>>> this into a file “hello.json”:
>>>
>>> --8<---------------cut here---------------start------------->8---
>>> {
>>>   "name": "hello",
>>>   "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"]
>>> }
>>> --8<---------------cut here---------------end--------------->8---
>>>
>>> and then install the hello package with “guix package -f hello.json”
>>> without having to first run the JSON importer.
>>>
>>> Since the JSON importer doesn’t know how to work with more than one
>>> definition you can’t have more than one custom definition in your JSON
>>> file, but if there’s interest we can easily add support for this.
>>>
>>> (My patch set does not come with documentation changes for “guix
>>> package” or “guix build”.)
>>>
>>> What do you think?
>>
>> I haven't played with the JSON importer, but this sounds cool. Did you
>> have any ideas for using this in mind?
>
> When I added the JSON importer long ago I also had a commit to extend
> “guix build” to install packages from JSON descriptions, but that never
> actually made it into the repository.
>
> Even then I didn’t have a grand plan; I just wanted to be able to tell
> the Scheme-averse that they could use JSON instead, e.g. for environment
> definitions or simple custom packages.
>
> It can be a sneaky way to get people to use Guix even though they are
> initially uncomfortable with Scheme.

Cool, I think it's nice to be able to use a more "data" format if that's
useful. I'm sure there will be some useful applications eventually!

Thanks,

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#40629] Build and install packages from JSON definitions

[Ludovic Courtès]

Hey!

Ricardo Wurmus <rekado@elephly.net> skribis:

> did you know that we have JSON importer?  Admittedly, it’s not very
> useful because people don’t generally use JSON syntax to define Guix
> packages.  Not even Guix lets you build and install packages from JSON
> definitions, so what’s the point really?
>
> Well, fret not!  This patch set adds support for JSON package
> definitions to “guix package -f” and “guix build -f”.  You can now dump
> this into a file “hello.json”:
>
> {
>   "name": "hello",
>   "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"]
> }
>
> and then install the hello package with “guix package -f hello.json”
> without having to first run the JSON importer.

I think that’s pretty cool!

In a way, it also looks like a special case of the import-on-the-fly use
case we discussed.  Namely, if you could write:

  guix build json:./foo.json
  guix install pypi:itsdangerous
  …

and have the relevant importer automatically invoked, that’d be sweet.

But… that’s somewhat ambitious and shouldn’t block this improvement!

Ludo’.

[bug#40629] Build and install packages from JSON definitions

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

>> Well, fret not!  This patch set adds support for JSON package
>> definitions to “guix package -f” and “guix build -f”.  You can now dump
>> this into a file “hello.json”:
>>
>> {
>>   "name": "hello",
>>   "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"]
>> }
>>
>> and then install the hello package with “guix package -f hello.json”
>> without having to first run the JSON importer.
>
> I think that’s pretty cool!
>
> In a way, it also looks like a special case of the import-on-the-fly use
> case we discussed.  Namely, if you could write:
>
>   guix build json:./foo.json
>   guix install pypi:itsdangerous
>   …
>
> and have the relevant importer automatically invoked, that’d be sweet.

Yes, that was the original goal that motivated writing alist->package
(instead of making this specific to JSON).  I remember vaguely that I
ran into an obstacle back then.  I think this may have predated the
existence of recursive importers, which meant that I couldn’t generate
package objects for packages that had as yet unpackaged inputs.

Perhaps this is no longer a problem and we could take a stab at these
on-the-fly imports.  Infinite packages! :)

--
Ricardo