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
From 2aaed4af3f171fa0a5d1817d9e0902cf1088b1a7 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi <goodoldp...@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 <l...@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldp...@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 <l...@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldp...@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
From 0a3f6a52fde940116112e348a86d76a9017de757 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi <goodoldp...@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 <da...@gnu.org>
;;; Copyright © 2016 Jelle Licht <jli...@fsfe.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldp...@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
