import: npm-binary: Improve npm-package->package-sexp.

* guix/import/npm-binary.scm (npm-package->package-sexp): Use record
matching.

Change-Id: If4e60162a84cb8d9694882eab933afa7028b02d7
Signed-off-by: Jelle Licht <jlicht@fsfe.org>
This commit is contained in:
Nicolas Graves via Guix-patches via 2025-03-24 08:29:13 +01:00 committed by Andreas Enge
parent 4b47728a6b
commit 23e001d9cb
No known key found for this signature in database
GPG key ID: F7D5C9BF765C61E3

View file

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