3 files changed, 141 insertions, 10 deletions

diff --git a/Makefile.am b/Makefile.am
index b8fc38c6f37..26ee98d55c8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -602,6 +602,7 @@ SCM_TESTS =					\
   tests/monads.scm                              \
   tests/nar.scm                         \
   tests/networking.scm                          \
+  tests/node.scm                                \
   tests/openpgp.scm                             \
   tests/packages.scm                            \
   tests/pack.scm                                \
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 60c01094a92..ac7af1a016d 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -36,7 +36,9 @@
   #:use-module (srfi srfi-71)
   #:export (%standard-phases
             delete-dependencies
+            delete-dependencies/except
             delete-dev-dependencies
+            delete-dev-dependencies/except
             delete-fields
             add-fields
             modify-json
@@ -74,26 +76,55 @@ a value to be written as JSON to the replacement FILE."
              modifications))
      file)))
 
-(define (delete-dependencies dependencies-to-remove)
+(define %dependency-keys
+  '("devDependencies"
+    "dependencies"
+    "peerDependencies"
+    "optionalDependencies"))
+
+(define %dev-dependency-keys
+  '("devDependencies"
+    "peerDependencies"))
+
+(define* (delete-dependencies dependencies-to-remove
+                              #:key negate?
+                              (dependency-keys %dependency-keys))
   "Rewrite 'package.json' to allow the build to proceed without packages
-listed in 'dependencies-to-remove', a list of strings naming npm packages.
+listed in 'dependencies-to-remove', a list of strings naming npm packages.  To
+negate its effect, and keep DEPENDENCIES-TO-REMOVE instead of removing them,
+set NEGATE? to #t.  DEPENDENCY-KEYS can be used to adjust which dependency
+fields are targeted.
 
 To prevent the deleted dependencies from being reintroduced, use this function
 only after the 'patch-dependencies' phase."
   (let ((predicate (lambda (dependency)
                      (member (car dependency) dependencies-to-remove)))
-        (dependency? (cut member <> (list "devDependencies"
-                                          "dependencies"
-                                          "peerDependencies"
-                                          "optionalDependencies"))))
+        (dependency? (cut member <> %dependency-keys)))
     (lambda (pkg-meta)
       (map (match-lambda
              (((? dependency? key) . dependencies)
-              (cons key (remove predicate dependencies)))
-             (otherwise
-              otherwise))
+              (let* (((values removed kept)
+                      (partition ((if negate? negate identity)
+                                  predicate)
+                                 dependencies)))
+                (format #t "deleting ~s dependencies: ~y~%" key removed)
+                (cons key kept)))
+             (otherwise otherwise))
            pkg-meta))))
 
+(define* (delete-dependencies/except dependencies-to-preserve
+                                     #:key (dependency-keys %dependency-keys))
+  "Like `delete-dependencies', but deleting all dependencies except those
+listed in DEPENDENCIES-TO-PRESERVE."
+  (delete-dependencies dependencies-to-preserve #:negate? #t
+                       #:dependency-keys dependency-keys))
+
+(define* (delete-dev-dependencies/except dependencies-to-preserve)
+  "Like `delete-dependencies/except' but only acting on development
+dependencies."
+  (delete-dependencies/except dependencies-to-preserve
+                              #:dependency-keys %dev-dependency-keys))
+
 (define* (modify-json-fields fields field-modifier
                              #:key
                              (field-path-mapper identity)
@@ -175,7 +206,7 @@ invalid field value provided, expected string or list of strings, got ~s~%"
    fields
    (lambda (field data key)
      (let ((value (cdr field)))
-       (format #t "setting field ~s to value ~s%" key value)
+       (format #t "setting field ~s to value: ~y~%" key value)
        (assoc-set! data key value)))
    #:field-path-mapper (lambda (field) (car field))
    #:insert? insert?
diff --git a/tests/node.scm b/tests/node.scm
new file mode 100644
index 00000000000..5159d530a12
--- /dev/null
+++ b/tests/node.scm
@@ -0,0 +1,99 @@
+;;; GNU Guix --- Tests for the node-build-system procedures.
+;;; Copyright © 2026 Maxim Cournoyer <maxim@guixotic.coop>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (json)
+             (guix build node-build-system)
+             (guix tests)
+             (srfi srfi-64))
+
+(define (package.json)
+  "Sample package.json file."
+  (call-with-output-string
+    (lambda (out)
+      (scm->json
+       '(("devDependencies"
+          ("typescript-eslint" . "^8.61.0")
+          ("typescript" . "^5.9.3")
+          ("typedoc" . "^0.28.19")
+          ("htmlparser2" . "^10.1.0")
+          ("eslint" . "^10.4.1")
+          ("@types/node" . "^25.9.2"))
+         ("dependencies"
+          ("domelementtype" . "^3.0.0")
+          ("boolbase" . ">=2.0.0"))
+         ("peerDependencies"
+          ("mkdirp" . ">=1.0.0")
+          ("react" . "^16.8.0"))
+         ("engines" ("node" . ">=20.19.0"))
+         ("repository"
+          ("url" . "https://example.com/dummy/dummy.git")
+          ("type" . "git"))
+         ("scripts"
+          ("test" . "npm run test")
+          ("lint" . "eslint .")
+          ("build" . "tsc"))
+         ("files" . #("dist" "src" "!**/*.spec.ts"))
+         ("sideEffects" . #f)
+         ("exports"
+          ("." ("default" . "./dist/index.js") ("types" . "./dist/index.d.ts")))
+         ("types" . "dist/index.d.ts")
+         ("main" . "dist/index.js")
+         ("license" . "GPL-3.0")
+         ("description" . "Dummy package.json")
+         ("version" . "6.0.1")
+         ("name" . "dummy")
+         ("type" . "module"))
+       out #:pretty #t))))
+
+(define* (modify-json* #:rest all-arguments)
+  "Wrap modify-json to use our package.json test sample and avoid file I/O.
+It also returns the data as an alist directly."
+  (mock ((guix build utils) with-atomic-file-replacement
+         (lambda (_ proc)
+           (call-with-input-string (package.json)
+             (lambda (in)
+               (call-with-output-string
+                 (lambda (out)
+                   (proc in out)))))))
+        (json-string->scm (apply modify-json all-arguments)
+                          #:ordered #t)))
+
+
+(test-begin "node related tests")
+
+(test-equal "delete-dependencies"
+  '(("domelementtype" . "^3.0.0"))
+  (assoc-ref (modify-json*
+              (delete-dependencies '("boolbase")))
+             "dependencies"))
+
+(test-equal "delete-dependencies/except"
+  '(("boolbase" . ">=2.0.0"))
+  (assoc-ref (modify-json*
+              (delete-dependencies/except '("boolbase")))
+             "dependencies"))
+
+(test-equal "delete-dev-dependencies/except"
+  '(("@types/node" . "^25.9.2")
+    ("typescript" . "^5.9.3"))
+  (assoc-ref (modify-json*
+              (delete-dev-dependencies/except
+               '("typescript" "@types/node")))
+             "devDependencies"))
+
+(test-end)