From: Timothy Sample <samplet@ngyro.com>
To: 47282@debbugs.gnu.org
Cc: Timothy Sample <samplet@ngyro.com>, Jelle Licht <jlicht@fsfe.org>
Subject: [bug#47282] [PATCH v2 01/13] build-system: Rewrite node build system.
Date: Tue, 30 Mar 2021 01:27:31 -0400 [thread overview]
Message-ID: <20210330052743.575-1-samplet@ngyro.com> (raw)
In-Reply-To: <87k0pprz6n.fsf@ngyro.com>
From: Jelle Licht <jlicht@fsfe.org>
* guix/build/node-build-system.scm: Rewrite it.
* guix/build-system/node.scm: Adjust accordingly.
* gnu/packages/node-xyz.scm (node-semver): Likewise.
Co-authored-by: Timothy Sample <samplet@ngyro.com>
---
gnu/packages/node-xyz.scm | 6 +-
guix/build-system/node.scm | 27 ++--
guix/build/node-build-system.scm | 207 +++++++++++++++----------------
3 files changed, 110 insertions(+), 130 deletions(-)
diff --git a/gnu/packages/node-xyz.scm b/gnu/packages/node-xyz.scm
index b1d6d4ce59..60cc005ea4 100644
--- a/gnu/packages/node-xyz.scm
+++ b/gnu/packages/node-xyz.scm
@@ -261,7 +261,11 @@ function with browser support.")
"06biknqb05r9xsmcflm3ygh50pjvdk84x6r79w43kmck4fn3qn5p"))))
(build-system node-build-system)
(arguments
- `(#:tests? #f)) ;; FIXME: Tests depend on node-tap
+ '(#:tests? #f ; FIXME: Tests depend on node-tap
+ #:phases
+ (modify-phases %standard-phases
+ ;; The only dependency to check for is tap, which we don't have.
+ (delete 'configure))))
(home-page "https://github.com/npm/node-semver")
(synopsis "Parses semantic versions strings")
(description
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index a8c5eed09b..4991ed53a5 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,7 +18,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system node)
- #:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix derivations)
@@ -25,22 +25,15 @@
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (ice-9 match)
- #:export (npm-meta-uri
- %node-build-system-modules
+ #:export (%node-build-system-modules
node-build
node-build-system))
-(define (npm-meta-uri name)
- "Return a URI string for the metadata of node module NAME found in the npm
-registry."
- (string-append "https://registry.npmjs.org/" name))
-
(define %node-build-system-modules
;; Build-side modules imported by default.
`((guix build node-build-system)
(guix build json)
- (guix build union)
- ,@%gnu-build-system-modules)) ;; TODO: Might be not needed
+ ,@%gnu-build-system-modules))
(define (default-node)
"Return the default Node package."
@@ -76,7 +69,7 @@ registry."
(define* (node-build store name inputs
#:key
- (npm-flags ''())
+ (test-target "test")
(tests? #t)
(phases '(@ (guix build node-build-system)
%standard-phases))
@@ -86,8 +79,6 @@ registry."
(guile #f)
(imported-modules %node-build-system-modules)
(modules '((guix build node-build-system)
- (guix build json)
- (guix build union)
(guix build utils))))
"Build SOURCE using NODE and INPUTS."
(define builder
@@ -97,12 +88,10 @@ registry."
#:source ,(match (assoc-ref inputs "source")
(((? derivation? source))
(derivation->output-path source))
- ((source)
- source)
- (source
- source))
+ ((source) source)
+ (source source))
#:system ,system
- #:npm-flags ,npm-flags
+ #:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
@@ -129,5 +118,5 @@ registry."
(define node-build-system
(build-system
(name 'node)
- (description "The standard Node build system")
+ (description "The Node build system")
(lower lower)))
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 7799f03595..a55cab237c 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 © 2016, 2020 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2019, 2021 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,144 +20,130 @@
(define-module (guix build node-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
- #:use-module (guix build json)
- #:use-module (guix build union)
#:use-module (guix build utils)
+ #:use-module (guix build json)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 match)
- #:use-module (ice-9 popen)
- #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
#:export (%standard-phases
node-build))
;; Commentary:
;;
-;; Builder-side code of the standard Node/npm package build procedure.
+;; Builder-side code of the standard Node/NPM package install procedure.
;;
;; Code:
-(define* (read-package-data #:key (filename "package.json"))
- (call-with-input-file filename
- (lambda (port)
- (read-json port))))
+(define (set-home . _)
+ (with-directory-excursion ".."
+ (let loop ((i 0))
+ (let ((dir (string-append "npm-home-" (number->string i))))
+ (if (directory-exists? dir)
+ (loop (1+ i))
+ (begin
+ (mkdir dir)
+ (setenv "HOME" (string-append (getcwd) "/" dir))
+ (format #t "set HOME to ~s~%" (getenv "HOME")))))))
+ #t)
-(define* (build #:key inputs #:allow-other-keys)
- (define (build-from-package-json? package-file)
- (let* ((package-data (read-package-data #:filename package-file))
- (scripts (assoc-ref package-data "scripts")))
- (assoc-ref scripts "build")))
- "Build a new node module using the appropriate build system."
- ;; XXX: Develop a more robust heuristic, allow override
- (cond ((file-exists? "gulpfile.js")
- (invoke "gulp"))
- ((file-exists? "gruntfile.js")
- (invoke "grunt"))
- ((file-exists? "Makefile")
- (invoke "make"))
- ((and (file-exists? "package.json")
- (build-from-package-json? "package.json"))
- (invoke "npm" "run" "build")))
+(define (module-name module)
+ (let* ((package.json (string-append module "/package.json"))
+ (package-meta (call-with-input-file package.json read-json)))
+ (assoc-ref package-meta "name")))
+
+(define (index-modules input-paths)
+ (define (list-modules directory)
+ (append-map (lambda (x)
+ (if (string-prefix? "@" x)
+ (list-modules (string-append directory "/" x))
+ (list (string-append directory "/" x))))
+ (filter (lambda (x)
+ (not (member x '("." ".."))))
+ (or (scandir directory) '()))))
+ (let ((index (make-hash-table (* 2 (length input-paths)))))
+ (for-each (lambda (dir)
+ (let ((nm (string-append dir "/lib/node_modules")))
+ (for-each (lambda (module)
+ (hash-set! index (module-name module) module))
+ (list-modules nm))))
+ input-paths)
+ index))
+
+(define* (patch-dependencies #:key inputs #:allow-other-keys)
+
+ (define index (index-modules (map cdr inputs)))
+
+ (define (resolve-dependencies package-meta meta-key)
+ (fold (lambda (key+value acc)
+ (match key+value
+ ('@ acc)
+ ((key . value) (acons key (hash-ref index key value) acc))))
+ '()
+ (or (assoc-ref package-meta meta-key) '())))
+
+ (with-atomic-file-replacement "package.json"
+ (lambda (in out)
+ (let ((package-meta (read-json in)))
+ (assoc-set! package-meta "dependencies"
+ (append
+ '(@)
+ (resolve-dependencies package-meta "dependencies")
+ (resolve-dependencies package-meta "peerDependencies")))
+ (assoc-set! package-meta "devDependencies"
+ (append
+ '(@)
+ (resolve-dependencies package-meta "devDependencies")))
+ (write-json package-meta out))))
#t)
-(define* (link-npm-dependencies #:key inputs #:allow-other-keys)
- (define (inputs->node-inputs inputs)
- "Filter the directory part from INPUTS."
- (filter (lambda (input)
- (match input
- ((name . _) (node-package? name))))
- inputs))
- (define (inputs->directories inputs)
- "Extract the directory part from INPUTS."
- (match inputs
- (((names . directories) ...)
- directories)))
- (define (make-node-path root)
- (string-append root "/lib/node_modules/"))
-
- (let ((input-node-directories (inputs->directories
- (inputs->node-inputs inputs))))
- (union-build "node_modules"
- (map make-node-path input-node-directories))
+(define* (configure #:key outputs inputs #:allow-other-keys)
+ (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+ (invoke npm "--offline" "--ignore-scripts" "install")
#t))
-(define configure link-npm-dependencies)
+(define* (build #:key inputs #:allow-other-keys)
+ (let ((package-meta (call-with-input-file "package.json" read-json)))
+ (if (and=> (assoc-ref package-meta "scripts")
+ (lambda (scripts)
+ (assoc-ref scripts "build")))
+ (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+ (invoke npm "run" "build"))
+ (format #t "there is no build script to run~%"))
+ #t))
-(define* (check #:key tests? #:allow-other-keys)
+(define* (check #:key tests? inputs #:allow-other-keys)
"Run 'npm test' if TESTS?"
(if tests?
- ;; Should only be enabled once we know that there are tests
- (invoke "npm" "test"))
+ (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+ (invoke npm "test"))
+ (format #t "test suite not run~%"))
#t)
-(define (node-package? name)
- "Check if NAME correspond to the name of an Node package."
- (string-prefix? "node-" name))
+(define* (repack #:key inputs #:allow-other-keys)
+ (invoke "tar" "-czf" "../package.tgz" ".")
+ #t)
(define* (install #:key outputs inputs #:allow-other-keys)
- "Install the node module to the output store item. The module itself is
-installed in a subdirectory of @file{node_modules} and its runtime dependencies
-as defined by @file{package.json} are symlinked into a @file{node_modules}
-subdirectory of the module's directory. Additionally, binaries are installed in
-the @file{bin} directory."
- (let* ((out (assoc-ref outputs "out"))
- (target (string-append out "/lib"))
- (binaries (string-append out "/bin"))
- (data (read-package-data))
- (modulename (assoc-ref data "name"))
- (binary-configuration (match (assoc-ref data "bin")
- (('@ configuration ...) configuration)
- ((? string? configuration) configuration)
- (#f #f)))
- (dependencies (match (assoc-ref data "dependencies")
- (('@ deps ...) deps)
- (#f #f))))
- (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"))
- (cond
- ((string? binary-configuration)
- (begin
- (mkdir-p binaries)
- (symlink (string-append target "/node_modules/" modulename "/"
- binary-configuration)
- (string-append binaries "/" modulename))))
- ((list? binary-configuration)
- (for-each
- (lambda (conf)
- (match conf
- ((key . value)
- (begin
- (mkdir-p (dirname (string-append binaries "/" key)))
- (symlink (string-append target "/node_modules/" modulename "/"
- value)
- (string-append binaries "/" key))))))
- binary-configuration)))
- (when dependencies
- (mkdir-p
- (string-append target "/node_modules/" modulename "/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))))
- dependencies))
+ "Install the node module to the output store item."
+ (let ((out (assoc-ref outputs "out"))
+ (npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+ (invoke npm "--prefix" out
+ "--global"
+ "--offline"
+ "--loglevel" "info"
+ "--production"
+ "install" "../package.tgz")
#t))
-
(define %standard-phases
(modify-phases gnu:%standard-phases
+ (add-after 'unpack 'set-home set-home)
+ (add-before 'configure 'patch-dependencies patch-dependencies)
(replace 'configure configure)
(replace 'build build)
- (replace 'install install)
- (delete 'check)
- (add-after 'install 'check check)
- (delete 'strip)))
+ (replace 'check check)
+ (add-before 'install 'repack repack)
+ (replace 'install install)))
(define* (node-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
--
2.31.0
next prev parent reply other threads:[~2021-03-30 5:57 UTC|newest]
Thread overview: 37+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-20 14:57 [bug#47282] [PATCH 00/13] node going forward Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 01/13] build-system: Rewrite node build system Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 02/13] gnu: Add libuv-node Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 03/13] gnu: node: Use license prefix Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 04/13] gnu: node: Add node-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 05/13] gnu: node: Add node-semver-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 06/13] gnu: node: Add node-ms-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 07/13] gnu: node: Add node-binary-search-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 08/13] gnu: node: Add node-debug-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 09/13] gnu: node: Add node-llparse-builder-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 10/13] gnu: node: Add node-llparse-frontend-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 11/13] gnu: node: Add node-llparse-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 12/13] gnu: node: Add llhttp-bootstrap Jelle Licht
2021-03-20 14:59 ` [bug#47282] [PATCH 13/13] gnu: node: Add node-lts Jelle Licht
2021-03-23 9:05 ` [bug#47282] [PATCH 00/13] node going forward Lars-Dominik Braun
2021-03-25 15:51 ` Léo Le Bouter via Guix-patches via
2021-03-25 16:14 ` Lars-Dominik Braun
2021-03-30 5:24 ` Timothy Sample
2021-03-30 5:27 ` Timothy Sample [this message]
2021-03-30 5:27 ` [bug#47282] [PATCH v2 02/13] gnu: Add libuv-for-node Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 03/13] gnu: node: Use license prefix Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 04/13] gnu: Add node-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 05/13] gnu: Add node-semver-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 06/13] gnu: Add node-ms-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 07/13] gnu: Add node-binary-search-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 08/13] gnu: Add node-debug-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 09/13] gnu: Add node-llparse-builder-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 10/13] gnu: Add node-llparse-frontend-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 11/13] gnu: Add node-llparse-bootstrap Timothy Sample
2021-03-30 5:27 ` [bug#47282] [PATCH v2 12/13] gnu: Add llhttp-bootstrap Timothy Sample
2021-03-30 6:59 ` Efraim Flashner
2021-04-02 13:17 ` Jelle Licht
2021-03-30 5:27 ` [bug#47282] [PATCH v2 13/13] gnu: Add node-lts Timothy Sample
2021-03-30 7:04 ` Efraim Flashner
2021-04-02 13:20 ` Jelle Licht
2021-04-02 16:18 ` bug#47282: [PATCH 00/13] node going forward Jelle Licht
2021-04-03 1:19 ` [bug#47282] " Timothy Sample
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210330052743.575-1-samplet@ngyro.com \
--to=samplet@ngyro.com \
--cc=47282@debbugs.gnu.org \
--cc=jlicht@fsfe.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).