bug#40710: node-build-system should not install tests

bug#40710: node-build-system should not install tests

[goodoldpaul]

As discussed here [0], node-build-system right now installs all the 
contents of a package's root node_modules directory, including i.e. 
tests.
We should investigate how exactly npm decides what to install and try to 
replicate that inside node-build-system. It seems likely that it uses 
the "files" array from the package.json file (see [1-2]).

[0]: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36599
[1]: https://github.com/colorjs/color-name/blob/master/package.json#L6
[2]: https://github.com/npm/node-semver/blob/master/package.json#L21

bug#40710: WIP solution

[goodoldpaul]

[-- Attachment #1: Type: text/plain, Size: 1106 bytes --]

Hello everybody,
I'm attempting to implement the discussed changes. I think these patches 
come pretty close but being my first contribution to Guix's core I would 
like to ask some feedback before submitting these patches with some 
trivial mistake. I tried to base my implementation on [0].

The first patch adds "globstar" support to (guix glob), namely the 
ability of recursively matching subdirectories in a glob pattern (i.e. 
"foo/**/bar.scm" matches both "foo/bar.scm" and "foo/baz/bar.scm").

The second patch adds (guix glob) to the imported modules of 
node-build-system and uses that to parse glob patterns in the "files" 
array of a package.json and then install all the matching files.

I tested the patches by verifying that

./pre-inst-env guix build -K node-semver node-util-deprecate 
node-statsd-parser node-stack-trace node-oop node-mersenne 
node-long-stack-traces node-far node-env-variable node-color-name

runs without error and by running make check TESTS="tests/glob.scm" .

Do you have any feedback/advice?

Thanks,

Giacomo

[0]: https://docs.npmjs.com/files/package.json#files

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-guix-Add-globstar-support.patch --]
[-- Type: text/x-diff; name=0001-guix-Add-globstar-support.patch, Size: 2965 bytes --]

From 2aaed4af3f171fa0a5d1817d9e0902cf1088b1a7 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi <goodoldpaul@autistici.org>
Date: Wed, 29 Apr 2020 15:59:48 +0200
Subject: [PATCH 1/2] guix: Add globstar support.

* guix/glob.scm (string->sglob)
(glob-match?): Add globstar support.
* tests/glob.scm: Update accordingly.
---
 guix/glob.scm  | 13 +++++++++++++
 tests/glob.scm |  8 ++++++--
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/guix/glob.scm b/guix/glob.scm
index a9fc744802..9b796ffd8f 100644
--- a/guix/glob.scm
+++ b/guix/glob.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,6 +62,11 @@ STR, a glob pattern such as \"foo*\" or \"foo??bar\"."
        (flatten (reverse (if (null? pending)
                              result
                              (cons-string pending result)))))
+      ((#\* #\* #\/ . rest)
+       (if (zero? brackets)
+           (loop rest '() 0
+                 (cons* '**/ (cons-string pending result)))
+           (loop rest (cons '**/ pending) brackets result)))
       (((and chr (or #\? #\*)) . rest)
        (let ((wildcard (match chr
                          (#\? '?)
@@ -121,6 +127,13 @@ STR, a glob pattern such as \"foo*\" or \"foo??bar\"."
       (string-null? str))
      (('*)
       #t)
+     (('**/ suffix . rest)
+      (let ((rest (if (eq? '* suffix) (cdr rest) rest))
+              (suffix (if (eq? '* suffix) (car rest) suffix)))
+          (match (string-contains str suffix)
+            (#f    #f)
+            (index (loop rest (string-drop str
+                                           (+ index (string-length suffix))))))))
      (('* suffix . rest)
       (match (string-contains str suffix)
         (#f    #f)
diff --git a/tests/glob.scm b/tests/glob.scm
index 3134069789..2a5a40c3c6 100644
--- a/tests/glob.scm
+++ b/tests/glob.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,7 +54,8 @@
  "foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
  "foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
  "[123]x" => '((set #\1 #\2 #\3) "x")
- "[a-z]" => '((range #\a #\z)))
+ "[a-z]" => '((range #\a #\z))
+ "**/*.scm" => '(**/ * ".scm"))
 
 (test-glob-match
  ("foo" matches "foo" (and not "foobar" "barfoo"))
@@ -64,6 +66,8 @@
  ("ab[0-9]c" matches "ab0c" "ab7c" "ab9c"
   (and not "ab-c" "ab00c" "ab3"))
  ("ab[cdefg]" matches "abc" "abd" "abg"
-  (and not "abh" "abcd" "ab[")))
+  (and not "abh" "abcd" "ab["))
+ ("foo/**/*.scm" matches "foo/bar/baz.scm" "foo/bar.scm" "foo/bar/baz/zab.scm"
+  (and not "foo/bar/baz.java" "foo/bar.smc")))
 
 (test-end "glob")
-- 
2.26.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-guix-Enforce-package.json-files-directive.patch --]
[-- Type: text/x-diff; name=0002-guix-Enforce-package.json-files-directive.patch, Size: 5457 bytes --]

From 0a3f6a52fde940116112e348a86d76a9017de757 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi <goodoldpaul@autistici.org>
Date: Wed, 29 Apr 2020 16:07:28 +0200
Subject: [PATCH 2/2] guix: Enforce package.json "files" directive.

* guix/build/node-build-system.scm (install): Enforce package.json "files" directive.
* guix/build-system/node.scm (%node-build-system-modules)
(node-build)[modules]: Add (guix glob).
---
 guix/build-system/node.scm       |  4 ++-
 guix/build/node-build-system.scm | 57 ++++++++++++++++++++++++--------
 2 files changed, 47 insertions(+), 14 deletions(-)

diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 05c24c47d5..05bc9f2087 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -42,6 +42,7 @@ registry."
   `((guix build node-build-system)
     (guix build json)
     (guix build union)
+    (guix glob)
     ,@%gnu-build-system-modules)) ;; TODO: Might be not needed
 
 (define (default-node)
@@ -90,7 +91,8 @@ registry."
                      (modules '((guix build node-build-system)
 				(guix build json)
 				(guix build union)
-                                (guix build utils))))
+                                (guix build utils)
+                                (guix glob))))
   "Build SOURCE using NODE and INPUTS."
   (define builder
     `(begin
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 7799f03595..8599c16be5 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@
   #:use-module (guix build json)
   #:use-module (guix build union)
   #:use-module (guix build utils)
+  #:use-module (guix glob)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 regex)
@@ -110,18 +112,49 @@ the @file{bin} directory."
 				 (#f #f)))
          (dependencies (match (assoc-ref data "dependencies")
                          (('@ deps ...) deps)
-                         (#f #f))))
+                         (#f #f)))
+         (patterns (match (assoc-ref data "files")
+                     (() #f)
+                     ((? list? patrn) patrn)
+                     (#f #f)))
+         (install-dir (string-append target "/node_modules/" modulename))
+         (install-files (lambda (files directory)
+                          (for-each (lambda (file)
+                                      (install-file
+                                       file
+                                       (string-append directory "/"
+                                                      (dirname file))))
+                                    files))))
     (mkdir-p target)
-    (copy-recursively "." (string-append target "/node_modules/" modulename))
-    ;; Remove references to dependencies
-    (delete-file-recursively
-      (string-append target "/node_modules/" modulename "/node_modules"))
+    (if patterns
+        (install-files
+         (filter
+          (lambda (file)
+            (any
+             (lambda (pattern)
+               (glob-match?
+                (string->compiled-sglob pattern)
+                file))
+             (append
+              patterns
+              '("package.json" "README*"
+                "CHANGES*" "CHANGELOG*"
+                "HISTORY*" "NOTICE*"))))
+          (map (lambda (path)
+                 (string-drop path 2))
+               (find-files ".")))
+         install-dir)
+        (begin
+          (copy-recursively "." install-dir)
+          ;; Remove references to dependencies
+          (delete-file-recursively
+           (string-append install-dir "/node_modules"))))
+
     (cond
       ((string? binary-configuration)
        (begin
          (mkdir-p binaries)
-         (symlink (string-append target "/node_modules/" modulename "/"
-				 binary-configuration)
+         (symlink (string-append install-dir "/" binary-configuration)
                   (string-append binaries "/" modulename))))
       ((list? binary-configuration)
        (for-each
@@ -130,21 +163,19 @@ the @file{bin} directory."
              ((key . value)
               (begin
                 (mkdir-p (dirname (string-append binaries "/" key)))
-                (symlink (string-append target "/node_modules/" modulename "/"
-					value)
+                (symlink (string-append install-dir "/" value)
                          (string-append binaries "/" key))))))
-         binary-configuration)))
+        binary-configuration)))
     (when dependencies
       (mkdir-p
-        (string-append target "/node_modules/" modulename "/node_modules"))
+        (string-append install-dir "/node_modules"))
       (for-each
         (lambda (dependency)
           (let ((dependency (car dependency)))
             (symlink
               (string-append (assoc-ref inputs (string-append "node-" dependency))
                              "/lib/node_modules/" dependency)
-              (string-append target "/node_modules/" modulename
-                             "/node_modules/" dependency))))
+              (string-append install-dir "/node_modules/" dependency))))
         dependencies))
     #t))
 
-- 
2.26.2

bug#40710: node-build-system should not install tests

[paul via Bug reports for GNU Guix]

close 40710