05/07: import: crate: Define dependencies as arguments.

[guix-commits]

marusich pushed a commit to branch master
in repository guix.

commit 5a9ef8a960706a55764f5bbc67ac83dd48516016
Author: Ivan Petkov <address@hidden>
Date:   Fri May 17 00:26:07 2019 -0700

    import: crate: Define dependencies as arguments.
    
    * guix/import/crate.scm:
    (crate-fetch)[input-crates]: Rename to dev-crates.
    [native-input-crates]: Rename to dev-dep-crates.
    [inputs]: Rename to cargo-inputs.
    [native-inputs]: Rename to cargo-development-inputs.
    (maybe-cargo-inputs, maybe-cargo-development-inputs, maybe-arguments): Add
    them.
    (make-crate-sexp)[inputs]: Rename to cargo-inputs.
    [native-inputs]: Rename to cargo-development-inputs.
    [maybe-native-inputs, maybe-inputs]: Replace with maybe-arguments.
    * guix/import/utils.scm: (package-names->package-inputs): Make public.  Add
    docstring.
    * tests/crate.scm (crate->guix-package): Update the match pattern.
    
    Signed-off-by: Chris Marusich <address@hidden>
---
 guix/import/crate.scm | 47 ++++++++++++++++++++++++++++++++++++-----------
 guix/import/utils.scm |  4 ++++
 tests/crate.scm       |  4 ++--
 3 files changed, 42 insertions(+), 13 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index e0b400d..9a73d9f 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -65,29 +65,53 @@
              (path (string-append "/" version "/dependencies"))
              (deps-json (json-fetch-alist (string-append crate-url name path)))
              (deps (assoc-ref deps-json "dependencies"))
-             (input-crates (filter (crate-kind-predicate "normal") deps))
-             (native-input-crates
+             (dep-crates (filter (crate-kind-predicate "normal") deps))
+             (dev-dep-crates
               (filter (lambda (dep)
                         (not ((crate-kind-predicate "normal") dep))) deps))
-             (inputs (crates->inputs input-crates))
-             (native-inputs (crates->inputs native-input-crates))
+             (cargo-inputs (crates->inputs dep-crates))
+             (cargo-development-inputs (crates->inputs dev-dep-crates))
              (home-page (match homepage
                           (() repository)
                           (_ homepage))))
     (callback #:name name #:version version
-              #:inputs inputs #:native-inputs native-inputs
+              #:cargo-inputs cargo-inputs
+              #:cargo-development-inputs cargo-development-inputs
               #:home-page home-page #:synopsis synopsis
               #:description description #:license license)))
 
-(define* (make-crate-sexp #:key name version inputs native-inputs
+(define (maybe-cargo-inputs package-names)
+  (match (package-names->package-inputs package-names)
+    (()
+     '())
+    ((package-inputs ...)
+     `((#:cargo-inputs ,package-inputs)))))
+
+(define (maybe-cargo-development-inputs package-names)
+  (match (package-names->package-inputs package-names)
+    (()
+     '())
+    ((package-inputs ...)
+     `((#:cargo-development-inputs ,package-inputs)))))
+
+(define (maybe-arguments arguments)
+  (match arguments
+    (()
+     '())
+    ((args ...)
+     `((arguments (,'quasiquote ,args))))))
+
+(define* (make-crate-sexp #:key name version cargo-inputs 
cargo-development-inputs
                           home-page synopsis description license
                           #:allow-other-keys)
   "Return the `package' s-expression for a rust package with the given NAME,
-VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
+VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, 
DESCRIPTION,
+and LICENSE."
   (let* ((port (http-fetch (crate-uri name version)))
          (guix-name (crate-name->package-name name))
-         (inputs (map crate-name->package-name inputs))
-         (native-inputs (map crate-name->package-name native-inputs))
+         (cargo-inputs (map crate-name->package-name cargo-inputs))
+         (cargo-development-inputs (map crate-name->package-name
+                                        cargo-development-inputs))
          (pkg `(package
                    (name ,guix-name)
                    (version ,version)
@@ -99,8 +123,9 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, 
DESCRIPTION, and LICENSE."
                               (base32
                                ,(bytevector->nix-base32-string (port-sha256 
port))))))
                    (build-system cargo-build-system)
-                   ,@(maybe-native-inputs native-inputs "src")
-                   ,@(maybe-inputs inputs "src")
+                   ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
+                                              (maybe-cargo-development-inputs
+                                                cargo-development-inputs)))
                    (home-page ,(match home-page
                                  (() "")
                                  (_ home-page)))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 63fc9bb..84503ab 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -52,6 +52,7 @@
             url-fetch
             guix-hash-url
 
+            package-names->package-inputs
             maybe-inputs
             maybe-native-inputs
             package->definition
@@ -236,6 +237,9 @@ into a proper sentence and by using two spaces between 
sentences."
                               cleaned 'pre ".  " 'post)))
 
 (define* (package-names->package-inputs names #:optional (output #f))
+  "Given a list of PACKAGE-NAMES, and an optional OUTPUT, tries to generate a
+quoted list of inputs, as suitable to use in an 'inputs' field of a package
+definition."
   (map (lambda (input)
          (cons* input (list 'unquote (string->symbol input))
                             (or (and output (list output))
diff --git a/tests/crate.scm b/tests/crate.scm
index a1dcfd5..a4a328d 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -89,9 +89,9 @@
                      ('base32
                       (? string? hash)))))
          ('build-system 'cargo-build-system)
-         ('inputs
+         ('arguments
           ('quasiquote
-           (("rust-bar" ('unquote 'rust-bar) "src"))))
+           (('#:cargo-inputs (("rust-bar" ('unquote rust-bar)))))))
          ('home-page "http://example.com";)
          ('synopsis "summary")
          ('description "summary")