tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00
Code Activity

build-system: node: Rewrite phase 'patch-dependencies.

Browse Source 
* guix/build/node-build-system.scm (alist-update): Remove procedure.
(patch-dependencies): Rewrite using modify-json and higher-order
function resolve.

Change-Id: I6a3e30526d5523b559d48317f0e052f2b1dcf04c
Signed-off-by: Jelle Licht <jlicht@fsfe.org>
This commit is contained in:
Nicolas Graves
2025-09-11 23:03:54 +02:00
committed by Jelle Licht
parent 709c37f4db
commit 0987ec2b82
1 changed files with 26 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
guix/build/node-build-system.scm
View File

@@ -42,18 +42,6 @@
replace-fields
with-atomic-json-file-replacement))
(define* (alist-update alist key proc #:optional (= equal?))
"Return an association list like ALIST, but with KEY mapped to the result of
PROC applied to the first value found under the comparison (= KEY ALISTCAR).
If no such value exists, return the list unchanged."
(map
(match-lambda
(((? (cut = key <>)) . value)
(cons key (proc value)))
(pair
pair))
alist))
;;;
;;; package.json modification procedures
;;;
@@ -232,37 +220,35 @@ only after the 'patch-dependencies' phase."
index))
(define* (patch-dependencies #:key inputs #:allow-other-keys)
"Replace versions by paths when found among INPUTS in `package.json'."
(define index (index-modules (map cdr inputs)))
(define resolve-dependencies
(let ((index (index-modules (map cdr inputs))))
(cut map
(match-lambda
((dependency . version)
(cons dependency (hash-ref index dependency version))))
<>)))
(define (resolve-dependencies dependencies)
(map
(match-lambda
((dependency . version)
(cons dependency (hash-ref index dependency version))))
dependencies))
(with-atomic-json-file-replacement
(define (resolve key getter)
(lambda (pkg-meta)
(fold
(lambda (proc pkg-meta) (proc pkg-meta))
pkg-meta
(list
(lambda (pkg-meta)
(alist-update pkg-meta "devDependencies" resolve-dependencies))
(lambda (pkg-meta)
(assoc-set!
pkg-meta
"dependencies"
(resolve-dependencies
; Combined "peerDependencies" and "dependencies" dependencies
; with "dependencies" taking precedent.
(fold
(lambda (dependency dependencies)
(assoc-set! dependencies (car dependency) (cdr dependency)))
(or (assoc-ref pkg-meta "peerDependencies") '())
(or (assoc-ref pkg-meta "dependencies") '())))))))))
#t)
(assoc-set! pkg-meta key
(resolve-dependencies (getter pkg-meta)))))
(modify-json
(resolve "devDependencies"
(lambda (pkg-meta)
(or (assoc-ref pkg-meta "devDependencies") '())))
(resolve "dependencies"
;; Combined "peerDependencies" and "dependencies" dependencies
;; with "dependencies" taking precedent.
(lambda (pkg-meta)
(fold
(lambda (dependency dependencies)
(assoc-set! dependencies
(car dependency) (cdr dependency)))
(or (assoc-ref pkg-meta "peerDependencies") '())
(or (assoc-ref pkg-meta "dependencies") '()))))))
(define* (delete-lockfiles #:key lockfiles #:allow-other-keys)
"Delete LOCKFILES if they exist."