summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJelle Licht <jlicht@fsfe.org>2021-03-30 01:27:31 -0400
committerJelle Licht <jlicht@fsfe.org>2021-04-02 18:04:22 +0200
commit23ea84cdf07c9b6bd4a61d14e5cb6009060f87cf (patch)
tree140c29221307c0de526c0008110339ab3631235a
parent532c0e745aa81b5ac5ed8cb2b4f9b02aa720d9a9 (diff)
build-system: Rewrite node build system.
* 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>
-rw-r--r--gnu/packages/node-xyz.scm6
-rw-r--r--guix/build-system/node.scm27
-rw-r--r--guix/build/node-build-system.scm207
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)