amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
1 changed files with 58 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

121
guix/import/npm-binary.scm
View file

@ -196,69 +196,64 @@
(($ <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 '()))))
;;;