[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/01: build: Add node-build-system.
|
From: |
guix-commits |
|
Subject: |
01/01: build: Add node-build-system. |
|
Date: |
Sun, 14 Jul 2019 06:21:28 -0400 (EDT) |
roptat pushed a commit to branch master
in repository guix.
commit 09a1f92f61d1ab11d2cf9f7a0983f4fc9f436f57
Author: Jelle Licht <address@hidden>
Date: Tue Aug 23 05:23:55 2016 +0200
build: Add node-build-system.
* guix/build/node-build-system.scm: New file.
* guix/build-system/node.scm: New file.
* guix/build/json.scm: New file.
* doc/guix.texi: Document it.
* Makefile.am: Added new files.
Co-Authored-By: Julien Lepiller <address@hidden>
---
Makefile.am | 3 +
doc/guix.texi | 11 ++
guix/build-system/node.scm | 135 ++++++++++++++
guix/build/json.scm | 387 +++++++++++++++++++++++++++++++++++++++
guix/build/node-build-system.scm | 166 +++++++++++++++++
5 files changed, 702 insertions(+)
diff --git a/Makefile.am b/Makefile.am
index 82eda60..9839bf2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -125,6 +125,7 @@ MODULES = \
guix/build-system/guile.scm \
guix/build-system/haskell.scm \
guix/build-system/linux-module.scm \
+ guix/build-system/node.scm \
guix/build-system/perl.scm \
guix/build-system/python.scm \
guix/build-system/ocaml.scm \
@@ -170,6 +171,7 @@ MODULES = \
guix/build/gnu-build-system.scm \
guix/build/gnu-dist.scm \
guix/build/guile-build-system.scm \
+ guix/build/node-build-system.scm \
guix/build/perl-build-system.scm \
guix/build/python-build-system.scm \
guix/build/ocaml-build-system.scm \
@@ -182,6 +184,7 @@ MODULES = \
guix/build/haskell-build-system.scm \
guix/build/linux-module-build-system.scm \
guix/build/store-copy.scm \
+ guix/build/json.scm \
guix/build/utils.scm \
guix/build/union.scm \
guix/build/profiles.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 458fca2..6ed77fe 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6346,6 +6346,17 @@ the module (in the "arguments" form of a package using
the
linux-module-build-system, use the key #:linux to specify it).
@end defvr
+@defvr {Scheme Variable} node-build-system
+This variable is exported by @code{(guix build-system node)}. It
+implements the build procedure used by @uref{http://nodejs.org,
+Node.js}, which implements an approximation of the @code{npm install}
+command, followed by an @code{npm test} command.
+
+Which Node.js package is used to interpret the @code{npm} commands can
+be specified with the @code{#:node} parameter which defaults to
+@code{node}.
+@end defvr
+
Lastly, for packages that do not need anything as sophisticated, a
``trivial'' build system is provided. It is trivial in the sense that
it provides basically no support: it does not pull any implicit inputs,
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
new file mode 100644
index 0000000..05c24c4
--- /dev/null
+++ b/guix/build-system/node.scm
@@ -0,0 +1,135 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Jelle Licht <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; 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 build json)
+ #:use-module (guix build union)
+ #:use-module (guix utils)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
+ #:use-module (guix search-paths)
+ #:use-module (guix build-system)
+ #:use-module (guix build-system gnu)
+ #:use-module (ice-9 match)
+ #:export (npm-meta-uri
+ %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
+
+(define (default-node)
+ "Return the default Node package."
+ ;; Lazily resolve the binding to avoid a circular dependency.
+ (let ((node (resolve-interface '(gnu packages node))))
+ (module-ref node 'node)))
+
+(define* (lower name
+ #:key source inputs native-inputs outputs system target
+ (node (default-node))
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME."
+ (define private-keywords
+ '(#:source #:target #:node #:inputs #:native-inputs))
+
+ (and (not target) ;XXX: no cross-compilation
+ (bag
+ (name name)
+ (system system)
+ (host-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@inputs
+
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (build-inputs `(("node" ,node)
+ ,@native-inputs))
+ (outputs outputs)
+ (build node-build)
+ (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (node-build store name inputs
+ #:key
+ (npm-flags ''())
+ (tests? #t)
+ (phases '(@ (guix build node-build-system)
+ %standard-phases))
+ (outputs '("out"))
+ (search-paths '())
+ (system (%current-system))
+ (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
+ `(begin
+ (use-modules ,@modules)
+ (node-build #:name ,name
+ #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
+ #:system ,system
+ #:npm-flags ,npm-flags
+ #:tests? ,tests?
+ #:phases ,phases
+ #:outputs %outputs
+ #:search-paths ',(map search-path-specification->sexp
+ search-paths)
+ #:inputs %build-inputs)))
+
+ (define guile-for-build
+ (match guile
+ ((? package?)
+ (package-derivation store guile system #:graft? #f))
+ (#f
+ (let* ((distro (resolve-interface '(gnu packages commencement)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system #:graft? #f)))))
+
+ (build-expression->derivation store name builder
+ #:inputs inputs
+ #:system system
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
+
+(define node-build-system
+ (build-system
+ (name 'node)
+ (description "The standard Node build system")
+ (lower lower)))
diff --git a/guix/build/json.scm b/guix/build/json.scm
new file mode 100644
index 0000000..361ea76
--- /dev/null
+++ b/guix/build/json.scm
@@ -0,0 +1,387 @@
+;;;; json.scm --- JSON reader/writer
+;;;; Copyright (C) 2015 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (guix build json) ;; originally (ice-9 json)
+ #:use-module (ice-9 match)
+ #:export (read-json write-json))
+
+;; Snarfed from
+;;
https://github.com/cwebber/activitystuff/blob/master/activitystuff/contrib/json.scm
+;;
+
+;;;
+;;; Reader
+;;;
+
+(define (json-error port)
+ (throw 'json-error port))
+
+(define (assert-char port char)
+ "Read a character from PORT and throw an invalid JSON error if the
+character is not CHAR."
+ (unless (eqv? (read-char port) char)
+ (json-error port)))
+
+(define (whitespace? char)
+ "Return #t if CHAR is a whitespace character."
+ (char-set-contains? char-set:whitespace char))
+
+(define (consume-whitespace port)
+ "Discard characters from PORT until a non-whitespace character is
+encountered.."
+ (match (peek-char port)
+ ((? eof-object?) *unspecified*)
+ ((? whitespace?)
+ (read-char port)
+ (consume-whitespace port))
+ (_ *unspecified*)))
+
+(define (make-keyword-reader keyword value)
+ "Parse the keyword symbol KEYWORD as VALUE."
+ (let ((str (symbol->string keyword)))
+ (lambda (port)
+ (let loop ((i 0))
+ (cond
+ ((= i (string-length str)) value)
+ ((eqv? (string-ref str i) (read-char port))
+ (loop (1+ i)))
+ (else (json-error port)))))))
+
+(define read-true (make-keyword-reader 'true #t))
+(define read-false (make-keyword-reader 'false #f))
+(define read-null (make-keyword-reader 'null #nil))
+
+(define (read-hex-digit port)
+ "Read a hexadecimal digit from PORT."
+ (match (read-char port)
+ (#\0 0)
+ (#\1 1)
+ (#\2 2)
+ (#\3 3)
+ (#\4 4)
+ (#\5 5)
+ (#\6 6)
+ (#\7 7)
+ (#\8 8)
+ (#\9 9)
+ ((or #\A #\a) 10)
+ ((or #\B #\b) 11)
+ ((or #\C #\c) 12)
+ ((or #\D #\d) 13)
+ ((or #\E #\e) 14)
+ ((or #\F #\f) 15)
+ (_ (json-error port))))
+
+(define (read-utf16-character port)
+ "Read a hexadecimal encoded UTF-16 character from PORT."
+ (integer->char
+ (+ (* (read-hex-digit port) (expt 16 3))
+ (* (read-hex-digit port) (expt 16 2))
+ (* (read-hex-digit port) 16)
+ (read-hex-digit port))))
+
+(define (read-escape-character port)
+ "Read escape character from PORT."
+ (match (read-char port)
+ (#\" #\")
+ (#\\ #\\)
+ (#\/ #\/)
+ (#\b #\backspace)
+ (#\f #\page)
+ (#\n #\newline)
+ (#\r #\return)
+ (#\t #\tab)
+ (#\u (read-utf16-character port))
+ (_ (json-error port))))
+
+(define (read-string port)
+ "Read a JSON encoded string from PORT."
+ (assert-char port #\")
+ (let loop ((result '()))
+ (match (read-char port)
+ ((? eof-object?) (json-error port))
+ (#\" (list->string (reverse result)))
+ (#\\ (loop (cons (read-escape-character port) result)))
+ (char (loop (cons char result))))))
+
+(define char-set:json-digit
+ (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+
+(define (digit? char)
+ (char-set-contains? char-set:json-digit char))
+
+(define (read-digit port)
+ "Read a digit 0-9 from PORT."
+ (match (read-char port)
+ (#\0 0)
+ (#\1 1)
+ (#\2 2)
+ (#\3 3)
+ (#\4 4)
+ (#\5 5)
+ (#\6 6)
+ (#\7 7)
+ (#\8 8)
+ (#\9 9)
+ (else (json-error port))))
+
+(define (read-digits port)
+ "Read a sequence of digits from PORT."
+ (let loop ((result '()))
+ (match (peek-char port)
+ ((? eof-object?)
+ (reverse result))
+ ((? digit?)
+ (loop (cons (read-digit port) result)))
+ (else (reverse result)))))
+
+(define (list->integer digits)
+ "Convert the list DIGITS to an integer."
+ (let loop ((i (1- (length digits)))
+ (result 0)
+ (digits digits))
+ (match digits
+ (() result)
+ ((n . tail)
+ (loop (1- i)
+ (+ result (* n (expt 10 i)))
+ tail)))))
+
+(define (read-positive-integer port)
+ "Read a positive integer with no leading zeroes from PORT."
+ (match (read-digits port)
+ ((0 . _)
+ (json-error port)) ; no leading zeroes allowed
+ ((digits ...)
+ (list->integer digits))))
+
+(define (read-exponent port)
+ "Read exponent from PORT."
+ (define (read-expt)
+ (list->integer (read-digits port)))
+
+ (unless (memv (read-char port) '(#\e #\E))
+ (json-error port))
+
+ (match (peek-char port)
+ ((? eof-object?)
+ (json-error port))
+ (#\-
+ (read-char port)
+ (- (read-expt)))
+ (#\+
+ (read-char port)
+ (read-expt))
+ ((? digit?)
+ (read-expt))
+ (_ (json-error port))))
+
+(define (read-fraction port)
+ "Read fractional number part from PORT as an inexact number."
+ (let* ((digits (read-digits port))
+ (numerator (list->integer digits))
+ (denomenator (expt 10 (length digits))))
+ (/ numerator denomenator)))
+
+(define (read-positive-number port)
+ "Read a positive number from PORT."
+ (let* ((integer (match (peek-char port)
+ ((? eof-object?)
+ (json-error port))
+ (#\0
+ (read-char port)
+ 0)
+ ((? digit?)
+ (read-positive-integer port))
+ (_ (json-error port))))
+ (fraction (match (peek-char port)
+ (#\.
+ (read-char port)
+ (read-fraction port))
+ (_ 0)))
+ (exponent (match (peek-char port)
+ ((or #\e #\E)
+ (read-exponent port))
+ (_ 0)))
+ (n (* (+ integer fraction) (expt 10 exponent))))
+
+ ;; Keep integers as exact numbers, but convert numbers encoded as
+ ;; floating point numbers to an inexact representation.
+ (if (zero? fraction)
+ n
+ (exact->inexact n))))
+
+(define (read-number port)
+ "Read a number from PORT"
+ (match (peek-char port)
+ ((? eof-object?)
+ (json-error port))
+ (#\-
+ (read-char port)
+ (- (read-positive-number port)))
+ ((? digit?)
+ (read-positive-number port))
+ (_ (json-error port))))
+
+(define (read-object port)
+ "Read key/value map from PORT."
+ (define (read-key+value-pair)
+ (let ((key (read-string port)))
+ (consume-whitespace port)
+ (assert-char port #\:)
+ (consume-whitespace port)
+ (let ((value (read-value port)))
+ (cons key value))))
+
+ (assert-char port #\{)
+ (consume-whitespace port)
+
+ (if (eqv? #\} (peek-char port))
+ (begin
+ (read-char port)
+ '(@)) ; empty object
+ (let loop ((result (list (read-key+value-pair))))
+ (consume-whitespace port)
+ (match (peek-char port)
+ (#\, ; read another value
+ (read-char port)
+ (consume-whitespace port)
+ (loop (cons (read-key+value-pair) result)))
+ (#\} ; end of object
+ (read-char port)
+ (cons '@ (reverse result)))
+ (_ (json-error port))))))
+
+(define (read-array port)
+ "Read array from PORT."
+ (assert-char port #\[)
+ (consume-whitespace port)
+
+ (if (eqv? #\] (peek-char port))
+ (begin
+ (read-char port)
+ '()) ; empty array
+ (let loop ((result (list (read-value port))))
+ (consume-whitespace port)
+ (match (peek-char port)
+ (#\, ; read another value
+ (read-char port)
+ (consume-whitespace port)
+ (loop (cons (read-value port) result)))
+ (#\] ; end of array
+ (read-char port)
+ (reverse result))
+ (_ (json-error port))))))
+
+(define (read-value port)
+ "Read a JSON value from PORT."
+ (consume-whitespace port)
+ (match (peek-char port)
+ ((? eof-object?) (json-error port))
+ (#\" (read-string port))
+ (#\{ (read-object port))
+ (#\[ (read-array port))
+ (#\t (read-true port))
+ (#\f (read-false port))
+ (#\n (read-null port))
+ ((or #\- (? digit?))
+ (read-number port))
+ (_ (json-error port))))
+
+(define (read-json port)
+ "Read JSON text from port and return an s-expression representation."
+ (let ((result (read-value port)))
+ (consume-whitespace port)
+ (unless (eof-object? (peek-char port))
+ (json-error port))
+ result))
+
+
+;;;
+;;; Writer
+;;;
+
+(define (write-string str port)
+ "Write STR to PORT in JSON string format."
+ (define (escape-char char)
+ (display (match char
+ (#\" "\\\"")
+ (#\\ "\\\\")
+ (#\/ "\\/")
+ (#\backspace "\\b")
+ (#\page "\\f")
+ (#\newline "\\n")
+ (#\return "\\r")
+ (#\tab "\\t")
+ (_ char))
+ port))
+
+ (display "\"" port)
+ (string-for-each escape-char str)
+ (display "\"" port))
+
+(define (write-object alist port)
+ "Write ALIST to PORT in JSON object format."
+ ;; Keys may be strings or symbols.
+ (define key->string
+ (match-lambda
+ ((? string? key) key)
+ ((? symbol? key) (symbol->string key))))
+
+ (define (write-pair pair)
+ (match pair
+ ((key . value)
+ (write-string (key->string key) port)
+ (display ":" port)
+ (write-json value port))))
+
+ (display "{" port)
+ (match alist
+ (() #f)
+ ((front ... end)
+ (for-each (lambda (pair)
+ (write-pair pair)
+ (display "," port))
+ front)
+ (write-pair end)))
+ (display "}" port))
+
+(define (write-array lst port)
+ "Write LST to PORT in JSON array format."
+ (display "[" port)
+ (match lst
+ (() #f)
+ ((front ... end)
+ (for-each (lambda (val)
+ (write-json val port)
+ (display "," port))
+ front)
+ (write-json end port)))
+ (display "]" port))
+
+(define (write-json exp port)
+ "Write EXP to PORT in JSON format."
+ (match exp
+ (#t (display "true" port))
+ (#f (display "false" port))
+ ;; Differentiate #nil from '().
+ ((and (? boolean? ) #nil) (display "null" port))
+ ((? string? s) (write-string s port))
+ ((? real? n) (display n port))
+ (('@ . alist) (write-object alist port))
+ ((vals ...) (write-array vals port))))
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
new file mode 100644
index 0000000..3c0ac2a
--- /dev/null
+++ b/guix/build/node-build-system.scm
@@ -0,0 +1,166 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <address@hidden>
+;;; Copyright © 2016 Jelle Licht <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(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 (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.
+;;
+;; Code:
+
+(define* (read-package-data #:key (filename "package.json"))
+ (call-with-input-file filename
+ (lambda (port)
+ (read-json port))))
+
+(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")))
+ #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))
+ #t))
+
+(define configure link-npm-dependencies)
+
+(define* (check #:key tests? #:allow-other-keys)
+ "Run 'npm test' if TESTS?"
+ (if tests?
+ ;; Should only be enabled once we know that there are tests
+ (invoke "npm" "test"))
+ #t)
+
+(define (node-package? name)
+ "Check if NAME correspond to the name of an Node package."
+ (string-prefix? "node-" name))
+
+(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))
+ (else
+ (symlink (string-append target "/node_modules/" modulename "/bin")
+ binaries)))
+ (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))
+ #t))
+
+
+(define %standard-phases
+ (modify-phases gnu:%standard-phases
+ (replace 'configure configure)
+ (replace 'build build)
+ (replace 'install install)
+ (delete 'check)
+ (add-after 'install 'check check)
+ (delete 'strip)))
+
+(define* (node-build #:key inputs (phases %standard-phases)
+ #:allow-other-keys #:rest args)
+ (apply gnu:gnu-build #:inputs inputs #:phases phases args))