[bug#36602] Add node-build-system.
diff mbox series

Message ID 20190711184653.3f6956b8@sybil.lepiller.eu
State New
Headers show
Series
  • [bug#36602] Add node-build-system.
Related show

Commit Message

Julien Lepiller July 11, 2019, 4:46 p.m. UTC
Hi Guix!

This patch adds a node-build-system. I wasn't sure if it was ready yet,
but I think, since I didn't change it in the last months, that it might
actually be :)

The patch was initially made by Jelle Licht, and I improved a bit on
it. Note that packages built with this build system will embed symlinks
to their dependencies, but not devDependencies (build-only
dependencies) according to the information in the metadata. Each
package is installed in lib/node_modules/package-name and symlinks are
added to lib/node_modules/package-name/node_modules. This allows us to
use only inputs instead of propagated inputs. Executables are installed
in bin according to metadata, and they should work even if called
directly from their store path.

Comments

Jelle Licht July 11, 2019, 6:25 p.m. UTC | #1
Hello Julien,

Julien Lepiller <julien@lepiller.eu> writes:

> Hi Guix!
>
> This patch adds a node-build-system. I wasn't sure if it was ready yet,
> but I think, since I didn't change it in the last months, that it might
> actually be :)
>
> The patch was initially made by Jelle Licht, and I improved a bit on
> it. Note that packages built with this build system will embed symlinks
> to their dependencies, but not devDependencies (build-only
> dependencies) according to the information in the metadata. Each
> package is installed in lib/node_modules/package-name and symlinks are
> added to lib/node_modules/package-name/node_modules. This allows us to
> use only inputs instead of propagated inputs. Executables are installed
> in bin according to metadata, and they should work even if called
> directly from their store path.

I am probably a bit of a hypocrite for the following nitpicks, as I am
quite sure I was the one that introduced pretty much all of them them,
so I offer my apologies in advance :-).

> From 38158940be0ef4780cdbb553cfa039d21fcdda9b Mon Sep 17 00:00:00 2001
> From: Jelle Licht <jlicht@fsfe.org>
> Date: Tue, 23 Aug 2016 05:23:55 +0200
> Subject: [PATCH] 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 <julien@lepiller.eu>
> ---
>  Makefile.am                      |   2 +
>  doc/guix.texi                    |  11 +
>  guix/build-system/node.scm       | 139 +++++++++++
>  guix/build/json.scm              | 387 +++++++++++++++++++++++++++++++
>  guix/build/node-build-system.scm | 159 +++++++++++++
>  5 files changed, 698 insertions(+)
>  create mode 100644 guix/build-system/node.scm
>  create mode 100644 guix/build/json.scm
>  create mode 100644 guix/build/node-build-system.scm
>
> diff --git a/Makefile.am b/Makefile.am
> index 82eda6042a..38f2d7e690 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		\

We are missing the `json.scm' file in this listing.

> [snip]

> +(define* (node-build store name inputs
> +                     #:key
> +                     (npm-flags ''())
> +                     (global? #f)
I am not quite sure if this is needed. Put another way: would we not
want all package builds to have `global? #t' in Guix?

> +                     (test-target "test")
This one is no longer in use. 

> +                     (tests? #f)
I know that for most modules we will not even be able to run tests, but
it seems silly to disable them by default, as that would hide the issue.

> [snip]

> +(define* (install #:key outputs inputs global? #:allow-other-keys)
> +  "Install the node module to the output store item. MODULENAME defines
> +under which name the module will be installed, GLOBAL? determines whether this
> +is an npm global install."
> +  (let* ((out          (assoc-ref outputs "out"))
> +         (src-dir      (getcwd))
> +         (tgt-dir      (string-append out "/lib"))
> +         (bin-dir      (string-append out "/bin"))
> +         (modulename   (string-append  (assoc-ref (read-package-data) "name")))
> +         (data         (read-package-data))
> +         (bin-conf     (assoc-ref data "bin"))
> +         (dependencies (match (assoc-ref data "dependencies")
> +                         ((@ deps ...) deps)
> +                         (#f #f))))
It might be better to write out most of these
names. I think we could also move `modulename' one line lower, so it can
become `(modulename (assoc-ref data "name"))'.

If you want me to tidy up these things, let me know; I can do it first
thing after the weekend.

Thanks

Jelle
Ludovic Courtès July 13, 2019, 12:42 p.m. UTC | #2
Hello!

Nice work!  I wonder if this could be used for the ‘node-semver’ package
that arrived at about the same time: <https://issues.guix.gnu.org/issue/36599>.

Jelle Licht <jlicht@fsfe.org> skribis:

>> +(define* (install #:key outputs inputs global? #:allow-other-keys)
>> +  "Install the node module to the output store item. MODULENAME defines
>> +under which name the module will be installed, GLOBAL? determines whether this
>> +is an npm global install."
>> +  (let* ((out          (assoc-ref outputs "out"))
>> +         (src-dir      (getcwd))
>> +         (tgt-dir      (string-append out "/lib"))
>> +         (bin-dir      (string-append out "/bin"))
>> +         (modulename   (string-append  (assoc-ref (read-package-data) "name")))
>> +         (data         (read-package-data))
>> +         (bin-conf     (assoc-ref data "bin"))
>> +         (dependencies (match (assoc-ref data "dependencies")
>> +                         ((@ deps ...) deps)

Note that ‘@’ here matches anything.  Did you mean '@, which would match
the @ symbol?

>> +                         (#f #f))))
> It might be better to write out most of these
> names. I think we could also move `modulename' one line lower, so it can
> become `(modulename (assoc-ref data "name"))'.

I’m gratuitously nitpicking as well :-), but I think we should spell out
names in general, so I’d propose s/src-dir/source/, s/tgt-dir/target/,
etc.

  https://www.gnu.org/software/guix/manual/en/html_node/Formatting-Code.html

Anyway, thanks for working on it!

Ludo’.
Giacomo Leidi July 13, 2019, 3:32 p.m. UTC | #3
Hello!

I'm the author of: https://issues.guix.gnu.org/issue/36599 . It should 
be really easy to rewrite the package using this new build system.

I submitted the patch before asking in #guix if someone was already 
working on node's ecosystem, but when I did Julien pointed me to his 
development branch which contains a definition for node-semver using the 
new node-build system: 
https://framagit.org/tyreunom/guix/commit/5c4708bfae0955999bca1edfd459aeb39980ab0e 
.

If this is merged I can refactor my patch (which contains node-semver 
6.2.0), based on Julien's package definition (which contains version 
5.6.0), in no time!

Very cool work by the way,

Giacomo
Robert Vollmert July 14, 2019, 11:09 a.m. UTC | #4
Hi,

just had a look at 09a1f92f61d1ab11d2cf9f7a0983f4fc9f436f57, some questions:

- the link to https://github.com/cwebber/activitystuff/blob/master/activitystuff/contrib/json.scm
  is a 404, and I can’t find (ice-9 json) elsewhere (also, shouldn’t cwebber be listed in the
  copyright line?)
- how does this embedded json parsing module differ from (json parser) as used by the cargo
  build system? wouldn’t it be better to have both use the same json modules?

Cheers
Robert
Julien Lepiller July 14, 2019, 12:59 p.m. UTC | #5
Le Sun, 14 Jul 2019 13:09:18 +0200,
Robert Vollmert <rob@vllmrt.net> a écrit :

> Hi,
> 
> just had a look at 09a1f92f61d1ab11d2cf9f7a0983f4fc9f436f57, some
> questions:
> 
> - the link to
> https://github.com/cwebber/activitystuff/blob/master/activitystuff/contrib/json.scm
> is a 404, and I can’t find (ice-9 json) elsewhere (also, shouldn’t
> cwebber be listed in the copyright line?)
> - how does this embedded json parsing module differ from (json
> parser) as used by the cargo build system? wouldn’t it be better to
> have both use the same json modules?
> 
> Cheers
> Robert
> 

You're right, I thought we didn't use guile-json, but since we already
use it in the cargo build system, I removed (guix build json) and fixed
the node-build-system to use (json parser) instead. I tested a few
packages, so it should be working. I pushed the changes in
8eb0ba532ebbebef23180e666e0607ea735f9c1a.

Patch
diff mbox series

From 38158940be0ef4780cdbb553cfa039d21fcdda9b Mon Sep 17 00:00:00 2001
From: Jelle Licht <jlicht@fsfe.org>
Date: Tue, 23 Aug 2016 05:23:55 +0200
Subject: [PATCH] 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 <julien@lepiller.eu>
---
 Makefile.am                      |   2 +
 doc/guix.texi                    |  11 +
 guix/build-system/node.scm       | 139 +++++++++++
 guix/build/json.scm              | 387 +++++++++++++++++++++++++++++++
 guix/build/node-build-system.scm | 159 +++++++++++++
 5 files changed, 698 insertions(+)
 create mode 100644 guix/build-system/node.scm
 create mode 100644 guix/build/json.scm
 create mode 100644 guix/build/node-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index 82eda6042a..38f2d7e690 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		\
diff --git a/doc/guix.texi b/doc/guix.texi
index 3e0788ed3a..8ef2006d18 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6333,6 +6333,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 0000000000..b6d3629049
--- /dev/null
+++ b/guix/build-system/node.scm
@@ -0,0 +1,139 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
+;;;
+;;; 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-lts)))
+
+(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 ''())
+                     (global? #f)
+                     (test-target "test")
+                     (tests? #f)
+                     (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
+                   #:global? ,global?
+                   #:test-target ,test-target
+                   #: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 0000000000..361ea76728
--- /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 0000000000..588f51fd25
--- /dev/null
+++ b/guix/build/node-build-system.scm
@@ -0,0 +1,159 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
+;;;
+;;; 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))))
+
+(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 global? #:allow-other-keys)
+  "Install the node module to the output store item. MODULENAME defines
+under which name the module will be installed, GLOBAL? determines whether this
+is an npm global install."
+  (let* ((out          (assoc-ref outputs "out"))
+         (src-dir      (getcwd))
+         (tgt-dir      (string-append out "/lib"))
+         (bin-dir      (string-append out "/bin"))
+         (modulename   (string-append  (assoc-ref (read-package-data) "name")))
+         (data         (read-package-data))
+         (bin-conf     (assoc-ref data "bin"))
+         (dependencies (match (assoc-ref data "dependencies")
+                         ((@ deps ...) deps)
+                         (#f #f))))
+    (mkdir-p tgt-dir)
+    (copy-recursively "." (string-append tgt-dir "/node_modules/" modulename))
+    ;; Remove references to dependencies
+    (delete-file-recursively
+      (string-append tgt-dir "/node_modules/" modulename "/node_modules"))
+    (when global?
+      (cond
+        ((string? bin-conf)
+         (begin
+           (mkdir-p bin-dir)
+	   (symlink (string-append tgt-dir "/node_modules/" modulename "/" bin-conf)
+                    (string-append bin-dir "/" modulename))))
+        ((list? bin-conf)
+         (for-each
+           (lambda conf
+             (match conf
+               ((key . value)
+                (begin
+                  (mkdir-p (dirname (string-append bin-dir "/" key)))
+                  (symlink (string-append tgt-dir "/node_modules/" modulename "/" value)
+                           (string-append bin-dir "/" key))))))
+           bin-conf))
+        (else
+          (symlink (string-append tgt-dir "/node_modules/" modulename "/bin") bin-dir))))
+    (when dependencies
+      (mkdir-p
+        (string-append tgt-dir "/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 tgt-dir "/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))
-- 
2.22.0