diff mbox series

[bug#70923,05/13] import: crate: Emit new-style package inputs.

Message ID c8a62db4b34bb7d9a70a39c83c95ef23f77d38c9.1715627497.git.herman@rimm.ee
State New
Headers show
Series Add (guix import utils) procedures. | expand

Commit Message

Herman Rimm May 13, 2024, 8:08 p.m. UTC 
From: Sarah Morgensen <iskarian@mgsn.dev>

* guix/import/crate.scm (maybe-cargo-inputs,
maybe-cargo-development-inputs, maybe-arguments): Delete procedures.
(make-crate-sexp): Add 'unwrap' procedure, use with maybe-packages-field
and fix indentation.
* tests/crate.scm: Adjust accordingly.

Change-Id: Ie8debd2553a338c3c623162b843e0a9827314074
---
 guix/import/crate.scm |  54 +++++++------------
 tests/crate.scm       | 119 +++++++++++++++++-------------------------
 2 files changed, 68 insertions(+), 105 deletions(-)
diff mbox series

Patch

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 7a25b2243c..760c5f0de4 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -7,6 +7,8 @@ 
 ;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2023, 2024 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2023, 2024 David Elsing <david.elsing@posteo.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -141,27 +143,6 @@  (define (crate-version-dependencies version)
 ;;; Converting crates to Guix packages.
 ;;;
 
-(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 (version->semver-prefix version)
   "Return the version up to and including the first non-zero part"
   (first
@@ -185,8 +166,14 @@  (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inpu
 
   (let* ((port (http-fetch (crate-uri name version)))
          (guix-name (crate-name->package-name name))
-         (cargo-inputs (format-inputs cargo-inputs))
-         (cargo-development-inputs (format-inputs cargo-development-inputs))
+         (unwrap (match-lambda
+                   ((lst) lst)
+                   (() '())))
+         (cargo-inputs (maybe-packages-field '#:cargo-inputs
+                         (format-inputs cargo-inputs)))
+         (cargo-development-inputs
+           (maybe-packages-field '#:cargo-development-inputs
+             (format-inputs cargo-development-inputs)))
          (pkg `(package
                    (name ,guix-name)
                    (version ,version)
@@ -204,12 +191,12 @@  (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inpu
                          `((properties '((crate-version-yanked? . #t))))
                          '())
                    (build-system cargo-build-system)
-                   ,@(maybe-arguments (append (if build?
-                                                 '()
-                                                 '(#:skip-build? #t))
-                                              (maybe-cargo-inputs cargo-inputs)
-                                              (maybe-cargo-development-inputs
-                                                cargo-development-inputs)))
+                   ,@(maybe-list-field 'arguments
+                       (append (if build?
+                                   '()
+                                   '(#:skip-build? #t))
+                               (unwrap cargo-inputs)
+                               (unwrap cargo-development-inputs)))
                    (home-page ,home-page)
                    (synopsis ,synopsis)
                    (description ,(beautify-description description))
@@ -218,11 +205,10 @@  (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inpu
                                (#f #f)
                                ((license) license)
                                (_ `(list ,@license)))))))
-         (close-port port)
-         (package->definition pkg
-                              (if yanked?
-                                  (string-append version "-yanked")
-                                  (version->semver-prefix version)))))
+    (close-port port)
+    (package->definition pkg (if yanked?
+                                 (string-append version "-yanked")
+                                 (version->semver-prefix version)))))
 
 (define (string->license string)
   (filter-map (lambda (license)
diff --git a/tests/crate.scm b/tests/crate.scm
index ce2f08aade..7651a5b5bb 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -5,6 +5,8 @@ 
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -497,10 +499,10 @@  (define have-guile-semver?
                            (?  string? hash)))))
                       (build-system 'cargo-build-system)
                       (arguments
-                       ('quasiquote
-                        (#:skip-build? #t
+                       (list
+                         #:skip-build? #t
                          #:cargo-inputs
-                         (("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7))))))
+                         (list rust-leaf-alice-0.7)))
                       (home-page "http://example.com")
                       (synopsis "summary")
                       (description "summary")
@@ -589,7 +591,7 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:skip-build? #t)))
+                 (list #:skip-build? #t))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -608,7 +610,7 @@  (define have-guile-semver?
                     (base32
                      (?  string? hash)))))
                 (build-system cargo-build-system)
-                (arguments ('quasiquote (#:skip-build? #t)))
+                (arguments (list #:skip-build? #t))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -627,7 +629,7 @@  (define have-guile-semver?
                     (base32
                      (?  string? hash)))))
                 (build-system cargo-build-system)
-                (arguments ('quasiquote (#:skip-build? #t)))
+                (arguments (list #:skip-build? #t))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -647,10 +649,9 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:skip-build? #t
-                               #:cargo-inputs
-                               (("rust-leaf-bob"
-                                 ('unquote rust-leaf-bob-3))))))
+                 (list #:skip-build? #t
+                       #:cargo-inputs
+                       (list rust-leaf-bob-3)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -670,14 +671,11 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:skip-build? #t
-                               #:cargo-inputs
-                               (("rust-intermediate-b"
-                                 ('unquote rust-intermediate-b-1))
-                                ("rust-leaf-alice"
-                                 ('unquote 'rust-leaf-alice-0.7))
-                                ("rust-leaf-bob"
-                                 ('unquote rust-leaf-bob-3))))))
+                 (list #:skip-build? #t
+                       #:cargo-inputs
+                       (list rust-intermediate-b-1
+                             rust-leaf-alice-0.7
+                             rust-leaf-bob-3)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -697,18 +695,13 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:cargo-inputs
-                               (("rust-intermediate-a"
-                                 ('unquote rust-intermediate-a-1))
-                                ("rust-intermediate-b"
-                                 ('unquote rust-intermediate-b-1))
-                                ("rust-leaf-alice"
-                                 ('unquote 'rust-leaf-alice-0.7))
-                                ("rust-leaf-bob"
-                                 ('unquote rust-leaf-bob-3)))
-                               #:cargo-development-inputs
-                               (("rust-intermediate-c"
-                                 ('unquote rust-intermediate-c-1))))))
+                 (list #:cargo-inputs
+                       (list rust-intermediate-a-1
+                             rust-intermediate-b-1
+                             rust-leaf-alice-0.7
+                             rust-leaf-bob-3)
+                       #:cargo-development-inputs
+                       ((list rust-intermediate-c-1))))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -735,9 +728,8 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:cargo-development-inputs
-                               (("rust-leaf-alice"
-                                 ('unquote rust-leaf-alice-0.7))))))
+                 (list #:cargo-development-inputs
+                       (list rust-leaf-alice-0.7)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -793,9 +785,8 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:cargo-inputs
-                               (("rust-leaf-bob"
-                                 ('unquote rust-leaf-bob-3))))))
+                 (list #:cargo-inputs
+                       (list rust-leaf-bob-3)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -815,13 +806,10 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:cargo-inputs
-                               (("rust-intermediate-b"
-                                 ('unquote rust-intermediate-b-1))
-                                ("rust-leaf-alice"
-                                 ('unquote 'rust-leaf-alice-0.7))
-                                ("rust-leaf-bob"
-                                 ('unquote rust-leaf-bob-3))))))
+                 (list #:cargo-inputs
+                       (list rust-intermediate-b-1
+                             rust-leaf-alice-0.7
+                             rust-leaf-bob-3)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -841,18 +829,13 @@  (define have-guile-semver?
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:cargo-inputs
-                               (("rust-intermediate-a"
-                                 ('unquote rust-intermediate-a-1))
-                                ("rust-intermediate-b"
-                                 ('unquote rust-intermediate-b-1))
-                                ("rust-leaf-alice"
-                                 ('unquote 'rust-leaf-alice-0.7))
-                                ("rust-leaf-bob"
-                                 ('unquote rust-leaf-bob-3)))
-                               #:cargo-development-inputs
-                               (("rust-intermediate-c"
-                                 ('unquote rust-intermediate-c-1))))))
+                 (list #:cargo-inputs
+                       (list rust-intermediate-a-1
+                             rust-intermediate-b-1
+                             rust-leaf-alice-0.7
+                             rust-leaf-bob-3)
+                       #:cargo-development-inputs
+                       (list rust-intermediate-c-1)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")
@@ -962,14 +945,11 @@  (define rust-leaf-bob-3.0.2-yanked
                  (?  string? hash)))))
             (build-system cargo-build-system)
             (arguments
-             ('quasiquote (#:cargo-inputs
-                           (("rust-leaf-bob"
-                             ('unquote 'rust-leaf-bob-3)))
-                           #:cargo-development-inputs
-                           (("rust-leaf-bob"
-                             ('unquote 'rust-leaf-bob-3.0.2-yanked))
-                            ("rust-leaf-bob"
-                             ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
+             (list #:cargo-inputs
+                   (list rust-leaf-bob-3)
+                   #:cargo-development-inputs
+                   (list rust-leaf-bob-3.0.2-yanked
+                         rust-leaf-bob-4.0.0-yanked)))
             (home-page "http://example.com")
             (synopsis "summary")
             (description "summary")
@@ -1093,14 +1073,11 @@  (define rust-leaf-bob-3.0.2-yanked
                      (?  string? hash)))))
                 (build-system cargo-build-system)
                 (arguments
-                 ('quasiquote (#:cargo-inputs
-                               (("rust-leaf-bob"
-                                 ('unquote 'rust-leaf-bob-3)))
-                               #:cargo-development-inputs
-                               (("rust-leaf-bob"
-                                 ('unquote 'rust-leaf-bob-3.0.2-yanked))
-                                ("rust-leaf-bob"
-                                 ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
+                 (list #:cargo-inputs
+                       (list rust-leaf-bob-3)
+                       #:cargo-development-inputs
+                       (list rust-leaf-bob-3.0.2-yanked
+                             rust-leaf-bob-4.0.0-yanked)))
                 (home-page "http://example.com")
                 (synopsis "summary")
                 (description "summary")