diff mbox series

[bug#77231,2/6] import: npm-binary: Improve npm-package->package-sexp.

Message ID 20250324072925.19588-2-ngraves@ngraves.fr
State New
Headers
Series Improve importer and build-system. |

Commit Message

Nicolas Graves March 24, 2025, 7:29 a.m. UTC 
  * guix/import/npm-binary.scm (npm-package->package-sexp): Use record
matching.
---
 guix/import/npm-binary.scm | 121 ++++++++++++++++++-------------------
 1 file changed, 58 insertions(+), 63 deletions(-)
diff mbox series

Patch

diff --git a/guix/import/npm-binary.scm b/guix/import/npm-binary.scm
index c43b84f3d5..f095651c34 100644
--- a/guix/import/npm-binary.scm
+++ b/guix/import/npm-binary.scm
@@ -196,69 +196,64 @@  (define resolve-spec
       (($ <versioned-package> name version)
        (resolve-package name (string->semver-range version)))))
 
-  (if (package-revision? npm-package)
-      (let ((name (package-revision-name npm-package))
-            (version (package-revision-version npm-package))
-            (home-page (package-revision-home-page npm-package))
-            (dependencies (package-revision-dependencies npm-package))
-            (dev-dependencies (package-revision-dev-dependencies npm-package))
-            (peer-dependencies (package-revision-peer-dependencies npm-package))
-            (license (package-revision-license npm-package))
-            (description (package-revision-description npm-package))
-            (dist (package-revision-dist npm-package)))
-        (let* ((name (npm-name->name name))
-               (url (dist-tarball dist))
-               (home-page (if (string? home-page)
-                              home-page
-                              (string-append %default-page "/" (uri-encode name))))
-               (synopsis description)
-               (resolved-deps (map resolve-spec
-                                   (append dependencies peer-dependencies)))
-               (peer-names (map versioned-package-name peer-dependencies))
-               ;; lset-difference for treating peer-dependencies as dependencies,
-               ;; which leads to dependency cycles.  lset-union for treating them as
-               ;; (ignored) dev-dependencies, which leads to broken packages.
-               (dev-names
-                (lset-union string=
-                            (map versioned-package-name dev-dependencies)
-                            peer-names))
-               (extra-phases
-                (match dev-names
-                  (() '())
-                  ((dev-names ...)
-                   `((add-after 'patch-dependencies 'delete-dev-dependencies
-                       (lambda _
-                         (modify-json
-                          (delete-dependencies '(,@(reverse dev-names)))))))))))
-          (values
-           `(package
-              (name ,name)
-              (version ,(semver->string (package-revision-version npm-package)))
-              (source (origin
-                        (method url-fetch)
-                        (uri ,url)
-                        (sha256 (base32 ,(hash-url url)))))
-              (build-system node-build-system)
-              (arguments
-               (list
-                #:tests? #f
-                #:phases
-                #~(modify-phases %standard-phases
-                    (delete 'build)
-                    ,@extra-phases)))
-              ,@(match dependencies
-                  (() '())
-                  ((dependencies ...)
-                   `((inputs
-                      (list ,@(map package-revision->symbol resolved-deps))))))
-              (home-page ,home-page)
-              (synopsis ,synopsis)
-              (description ,description)
-              (license ,license))
-           (map (match-lambda (($ <package-revision> name version)
-                               (list name (semver->string version))))
-                resolved-deps))))
-      (values #f '())))
+  (match npm-package
+    (($ <package-revision>
+        name version home-page dependencies dev-dependencies
+        peer-dependencies license description dist)
+     (let* ((name (npm-name->name name))
+            (url (dist-tarball dist))
+            (home-page (if (string? home-page)
+                           home-page
+                           (string-append %default-page "/" (uri-encode name))))
+            (synopsis description)
+            (resolved-deps (map resolve-spec
+                                (append dependencies peer-dependencies)))
+            (peer-names (map versioned-package-name peer-dependencies))
+            ;; lset-difference for treating peer-dependencies as dependencies,
+            ;; which leads to dependency cycles.  lset-union for treating them as
+            ;; (ignored) dev-dependencies, which leads to broken packages.
+            (dev-names
+             (lset-union string=
+                         (map versioned-package-name dev-dependencies)
+                         peer-names))
+            (extra-phases
+             (match dev-names
+               (() '())
+               ((dev-names ...)
+                `((add-after 'patch-dependencies 'delete-dev-dependencies
+                    (lambda _
+                      (modify-json
+                       (delete-dependencies '(,@(reverse dev-names)))))))))))
+       (values
+        `(package
+           (name ,name)
+           (version ,(semver->string (package-revision-version npm-package)))
+           (source (origin
+                     (method url-fetch)
+                     (uri ,url)
+                     (sha256 (base32 ,(hash-url url)))))
+           (build-system node-build-system)
+           (arguments
+            (list
+             #:tests? #f
+             #:phases
+             #~(modify-phases %standard-phases
+                 (delete 'build)
+                 ,@extra-phases)))
+           ,@(match dependencies
+               (() '())
+               ((dependencies ...)
+                `((inputs
+                   (list ,@(map package-revision->symbol resolved-deps))))))
+           (home-page ,home-page)
+           (synopsis ,synopsis)
+           (description ,description)
+           (license ,license))
+        (map (match-lambda (($ <package-revision> name version)
+                            (list name (semver->string version))))
+             resolved-deps))))
+    (_
+     (values #f '()))))
 
 
 ;;;