diff mbox series

[bug#41219,2/2] guix: Enforce package.json "files" directive.

Message ID 20200512213131.28873-2-goodoldpaul@autistici.org
State Accepted
Headers show
Series [bug#41219,1/2] guix: Add globstar support. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job

Commit Message

Giacomo Leidi May 12, 2020, 9:31 p.m. UTC 
This fixes https://issues.guix.gnu.org/40710 by implementing support for the
"files" directive from https://docs.npmjs.com/files/package.json#files .

* 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 | 68 ++++++++++++++++++++++++++------
 2 files changed, 58 insertions(+), 14 deletions(-)

Comments

Giacomo Leidi June 5, 2020, 11:09 p.m. UTC | #1 
Hi Guixers!
Did someone managed to have a look at these patches? No rush, just to 
have feedback :) .

Thanks,

Giacomo
Giacomo Leidi Sept. 19, 2020, 3:15 p.m. UTC | #2 
Hello Guix,

have you managed to go through these patches?

Thank you,

Giacomo
Jelle Licht Sept. 20, 2020, 7:51 p.m. UTC | #3 
Hey Giacomo, 

Apologies for the delay! Better late than never, a review just for you.
The other patch seems fine to me, but I'm not a 'guix glob' expert.

Giacomo Leidi <goodoldpaul@autistici.org> writes:

> [snip]
> --- 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,60 @@ 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-list) patrn-list)
                                  ^
Perhaps 'pattern-list'? I keep reading this as patron-list. We could
also build the patterns here. Mapping over the pattern-list + 'default
patterns' here might also be a wee bit faster.

> +                     (#f #f)))
> +         (main (match (assoc-ref data "main")
> +                     ("" #f)
> +                     ((? string? main-module) main-module)
> +                     (#f #f)))
> +         (install-dir (string-append target "/node_modules/" modulename))
> +         (install-files (lambda (files directory)
                                          ^
You only use install-dir here: you could hard-code it in the lambda.

> +                          (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"
> +                           ;; These files get installed no
> +                           ;; matter the case or extension.
> +                           "[rR][eE][aA][dD][mM][eE]*"
> +                           "[cC][hH][aA][nN][gG][eE][sS]*"
> +                           "[cC][hH][aA][nN][gG][eE][lL][oO][gG]*"
> +                           "[hH][iI][sS][tT][oO][rR][yY]*"
> +                           "[nN][oO][tT][iI][cC][eE]*"))))
> +                 (map (lambda (path)
> +                        (string-drop path 2))
                           ^
                         If this is meant to drop the "./" prefix, you
                         should be able to leave it out.

> +                      (find-files ".")))
`find-files' accepts an optional second argument called PRED, so you can
do that instead of the earlier 'filter'.

> +         install-dir)
> +        (begin
> +          (copy-recursively "." install-dir)
> +          ;; Remove references to dependencies
> +          (delete-file-recursively
> +           (string-append install-dir "/node_modules"))))
> +    (if (and main
> +             (not (file-exists?
> +                   (string-append
> +                    install-dir "/" (dirname main)))))
> +        (install-files (list main) install-dir))
           ^

This should not be needed if we use the 'old' (=non-files) approach of
installing. Do you think it makes sense to pull it into the previous
block that only runs on using the 'files' directive?

Thanks for you patience, and thanks again for working on this.

HTH,

 - Jelle
diff mbox series

Patch

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..befcbbeb75 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,60 @@  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-list) patrn-list)
+                     (#f #f)))
+         (main (match (assoc-ref data "main")
+                     ("" #f)
+                     ((? string? main-module) main-module)
+                     (#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"
+                           ;; These files get installed no
+                           ;; matter the case or extension.
+                           "[rR][eE][aA][dD][mM][eE]*"
+                           "[cC][hH][aA][nN][gG][eE][sS]*"
+                           "[cC][hH][aA][nN][gG][eE][lL][oO][gG]*"
+                           "[hH][iI][sS][tT][oO][rR][yY]*"
+                           "[nN][oO][tT][iI][cC][eE]*"))))
+                 (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"))))
+    (if (and main
+             (not (file-exists?
+                   (string-append
+                    install-dir "/" (dirname main)))))
+        (install-files (list main) install-dir))
     (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 +174,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))