Subject: [PATCH 09/13] import: hackage: Use 'maybe-list-field' procedure.

From: Herman Rimm <[email-masked]>
Date: Mon, 13 May 2024 22:08:06 +0200

* guix/import/hackage.scm (maybe-inputs, maybe-arguments): Delete
procedures.
(hackage-module->sexp): Use 'maybe-list-field' and
'maybe-upstream-inputs' procedures.
* tests/hackage.scm: Fix whitespace and replace 'quasiquote' with
'list'.

Change-Id: I4fe39ff84c9f6a677f810d9e4fe751d762973757
---
 guix/import/hackage.scm | 38 +++++++++++---------------------------
 tests/hackage.scm       | 13 +++++++------
 2 files changed, 18 insertions(+), 33 deletions(-)

diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 79a51d3300..e90f3c932f 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -288,26 +288,6 @@ (define* (hackage-module->sexp cabal cabal-hash
                           #:include-test-dependencies?
                           include-test-dependencies?))
 
-  (define (maybe-inputs input-type inputs)
-    (match inputs
-      (()
-       '())
-      ((inputs ...)
-       (list (list input-type
-                   `(list ,@(map (compose string->symbol
-                                          upstream-input-downstream-name)
-                                 inputs)))))))
-
-  (define (maybe-arguments)
-    (match (append (if (not include-test-dependencies?)
-                       '(#:tests? #f)
-                       '())
-                   (if (not (string-null? revision))
-                       `(#:cabal-revision (,revision ,cabal-hash))
-                       '()))
-      (() '())
-      (args `((arguments (,'quasiquote ,args))))))
-
   (let ((tarball (with-store store
                    (download-to-store store source-url))))
     (values
@@ -324,13 +304,17 @@ (define* (hackage-module->sexp cabal cabal-hash
                          "failed to download tar archive")))))
         (build-system haskell-build-system)
         (properties '((upstream-name . ,name)))
-        ,@(maybe-inputs 'inputs
-                        (filter (upstream-input-type-predicate 'regular)
-                                inputs))
-        ,@(maybe-inputs 'native-inputs
-                        (filter (upstream-input-type-predicate 'native)
-                                inputs))
-        ,@(maybe-arguments)
+        ,@(maybe-upstream-inputs 'inputs
+            (filter (upstream-input-type-predicate 'regular) inputs))
+        ,@(maybe-upstream-inputs 'native-inputs
+            (filter (upstream-input-type-predicate 'native) inputs))
+        ,@(maybe-list-field 'arguments
+            (append (if (not include-test-dependencies?)
+                        '(#:tests? #f)
+                        '())
+                    (if (not (string-null? revision))
+                        `(#:cabal-revision '(,revision ,cabal-hash))
+                        '())))
         (home-page ,(cabal-package-home-page cabal))
         (synopsis ,(cabal-package-synopsis cabal))
         (description ,(beautify-description (cabal-package-description cabal)))
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 403f587c41..f6d91515e2 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -67,7 +67,7 @@ (define test-cabal-3
   if impl(ghc>=7.2&&<7.6)
     Build-depends: ghc-b
   if impl(ghc == 7.8)
-    Build-depends: 
+    Build-depends:
       HTTP       >= 4000.2.5 && < 4000.3,
       mtl        >= 2.0      && < 3
 ")
@@ -86,7 +86,7 @@ (define test-cabal-4
   if impl(ghc>=7.2&&<7.6)
     Build-depends: ghc-b
   if impl(ghc == 7.8)
-    Build-depends: 
+    Build-depends:
       HTTP       >= 4000.2.5 && < 4000.3,
       mtl        >= 2.0      && < 3
 ")
@@ -101,7 +101,7 @@ (define test-cabal-5
 license: BSD3
 library
   if impl(ghc == 7.8)
-    Build-depends: 
+    Build-depends:
       HTTP       >= 4000.2.5 && < 4000.3,
   if impl(ghc -any)
     Build-depends: mtl        >= 2.0      && < 3
@@ -126,7 +126,7 @@ (define test-cabal-6
   if impl(ghc>=7.2&&<7.6)
     Build-depends: ghc-b
   if impl(ghc == 7.8)
-    Build-depends: 
+    Build-depends:
       HTTP       >= 4000.2.5 && < 4000.3,
       mtl        >= 2.0      && < 3
 ")
@@ -524,8 +524,9 @@ (define-package-matcher match-ghc-foo-revision
     ('properties '(quote ((upstream-name . "foo"))))
     ('inputs ('list 'ghc-http))
     ('arguments
-     ('quasiquote
-      ('#:cabal-revision
+     ('list
+      '#:cabal-revision
+      ('quote
        ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
     ('home-page "http://test.org")
     ('synopsis (? string?))
-- 
2.41.0