[PATCH] Add node-build-system.

DoneSubmitted by Julien Lepiller.
Details
6 participants
  • goodoldpaul
  • Jelle Licht
  • Julien Lepiller
  • Ludovic Courtès
  • Robert Vollmert
  • swedebugia
Owner
unassigned
Severity
normal
J
J
Julien Lepiller wrote on 11 Jul 2019 18:46
(address . guix-patches@gnu.org)
20190711184653.3f6956b8@sybil.lepiller.eu
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 mightactually be :)
The patch was initially made by Jelle Licht, and I improved a bit onit. Note that packages built with this build system will embed symlinksto their dependencies, but not devDependencies (build-onlydependencies) according to the information in the metadata. Eachpackage is installed in lib/node_modules/package-name and symlinks areadded to lib/node_modules/package-name/node_modules. This allows us touse only inputs instead of propagated inputs. Executables are installedin bin according to metadata, and they should work even if calleddirectly from their store path.
From 38158940be0ef4780cdbb553cfa039d21fcdda9b Mon Sep 17 00:00:00 2001From: Jelle Licht <jlicht@fsfe.org>Date: Tue, 23 Aug 2016 05:23:55 +0200Subject: [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
Toggle diff (747 lines)diff --git a/Makefile.am b/Makefile.amindex 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.texiindex 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.scmnew file mode 100644index 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.scmnew file mode 100644index 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.scmnew file mode 100644index 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
J
J
Jelle Licht wrote on 11 Jul 2019 20:25
87ef2wsa2l.fsf@jlicht.xyz
Hello Julien,
Julien Lepiller <julien@lepiller.eu> writes:
Toggle quote (16 lines)> 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 amquite sure I was the one that introduced pretty much all of them them,so I offer my apologies in advance :-).
Toggle quote (41 lines)> 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.
Toggle quote (6 lines)> [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 notwant all package builds to have `global? #t' in Guix?
Toggle quote (1 lines)> + (test-target "test")
This one is no longer in use.
Toggle quote (1 lines)> + (tests? #f)
I know that for most modules we will not even be able to run tests, butit seems silly to disable them by default, as that would hide the issue.
Toggle quote (16 lines)> [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 thesenames. I think we could also move `modulename' one line lower, so it canbecome `(modulename (assoc-ref data "name"))'.
If you want me to tidy up these things, let me know; I can do it firstthing after the weekend.
Thanks
Jelle
L
L
Ludovic Courtès wrote on 13 Jul 2019 14:42
(name . Jelle Licht)(address . jlicht@fsfe.org)
87a7di9kch.fsf@gnu.org
Hello!
Nice work! I wonder if this could be used for the ‘node-semver’ packagethat arrived at about the same time: https://issues.guix.gnu.org/issue/36599.
Jelle Licht <jlicht@fsfe.org> skribis:
Toggle quote (14 lines)>> +(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 matchthe @ symbol?
Toggle quote (5 lines)>> + (#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 outnames 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’.
G
G
goodoldpaul wrote on 13 Jul 2019 17:32
Re: [PATCH] Add node-build-system.
(address . 36602@debbugs.gnu.org)
4ea27e7ea72e7effbd3cb8e63a75e834@autistici.org
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
J
J
Julien Lepiller wrote on 13 Jul 2019 22:20
Re: [bug#36602] [PATCH] Add node-build-system.
(name . Ludovic Courtès)(address . ludo@gnu.org)
20190713221952.0de23569@sybil.lepiller.eu
Le Sat, 13 Jul 2019 14:42:38 +0200,Ludovic Courtès <ludo@gnu.org> a écrit :
Toggle quote (41 lines)> 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’.
Hopefully, the attached patch fixes your (and Jelle's) points. I alsofixed the default node package (it was node-lts, but that doesn't existanymore), made the configure phase return #t and fixed thebinary-configuration. I tested again on a few packages and they builtwithout issue.
From cb1f067cdf8dcfae23e01f86a12da032bc7d9fbb Mon Sep 17 00:00:00 2001From: Jelle Licht <jlicht@fsfe.org>Date: Tue, 23 Aug 2016 05:23:55 +0200Subject: [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 | 3 + doc/guix.texi | 11 + guix/build-system/node.scm | 135 +++++++++++ guix/build/json.scm | 387 +++++++++++++++++++++++++++++++ guix/build/node-build-system.scm | 164 +++++++++++++ 5 files changed, 700 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
Toggle diff (756 lines)diff --git a/Makefile.am b/Makefile.amindex 82eda6042a..9839bf27cc 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.texiindex 5a8ad7ebda..4a9832d9e6 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.scmnew file mode 100644index 0000000000..05c24c47d5--- /dev/null+++ b/guix/build-system/node.scm@@ -0,0 +1,135 @@+;;; 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)))++(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.scmnew file mode 100644index 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.scmnew file mode 100644index 0000000000..201664c5c1--- /dev/null+++ b/guix/build/node-build-system.scm@@ -0,0 +1,164 @@+;;; 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))+ #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. 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"))+ (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))-- 2.22.0
J
J
Jelle Licht wrote on 13 Jul 2019 23:30
(address . 36602@debbugs.gnu.org)
87a7dhsjvf.fsf@jlicht.xyz
Julien Lepiller <julien@lepiller.eu> writes:
Toggle quote (6 lines)> [...]> +(define* (install #:key outputs inputs #: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."
`global?' is no longer , so it could probably be removed from thedocstring as well. LGTM otherwise :-).
J
J
Julien Lepiller wrote on 14 Jul 2019 12:34
(name . Jelle Licht)(address . jlicht@fsfe.org)
20190714123453.55c6d1b1@sybil.lepiller.eu
Le Sat, 13 Jul 2019 23:30:12 +0200,Jelle Licht <jlicht@fsfe.org> a écrit :
Toggle quote (11 lines)> Julien Lepiller <julien@lepiller.eu> writes:> > > [...]> > +(define* (install #:key outputs inputs #: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." > > `global?' is no longer , so it could probably be removed from the> docstring as well. LGTM otherwise :-).
I've reworked that docstring and pushed as09a1f92f61d1ab11d2cf9f7a0983f4fc9f436f57, thank you!
Closed
R
R
Robert Vollmert wrote on 14 Jul 2019 13:09
guix/build/json.scm
(address . 36602@debbugs.gnu.org)
055006A2-DA0C-4570-A9D0-4A9FFD5A6037@vllmrt.net
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?
CheersRobert
S
S
swedebugia wrote on 14 Jul 2019 14:46
Re: bug#36602: [PATCH] Add node-build-system.
(address . guix-patches@gnu.org)
b9f60f61-ef4f-c099-53d1-e2b53ae7d521@riseup.net
On 2019-07-14 12:34, Julien Lepiller wrote:
Toggle quote (3 lines)> I've reworked that docstring and pushed as> 09a1f92f61d1ab11d2cf9f7a0983f4fc9f436f57, thank you!
Wohoo! First small step to working node applications.
-- CheersSwedebugia
J
J
Julien Lepiller wrote on 14 Jul 2019 14:59
Re: [bug#36602] guix/build/json.scm
(name . Robert Vollmert)(address . rob@vllmrt.net)(address . 36602@debbugs.gnu.org)
20190714145945.65841b36@sybil.lepiller.eu
Le Sun, 14 Jul 2019 13:09:18 +0200,Robert Vollmert <rob@vllmrt.net> a écrit :
Toggle quote (17 lines)> 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 alreadyuse it in the cargo build system, I removed (guix build json) and fixedthe node-build-system to use (json parser) instead. I tested a fewpackages, so it should be working. I pushed the changes in8eb0ba532ebbebef23180e666e0607ea735f9c1a.
?
Your comment

This issue is archived.

To comment on this conversation send email to 36602@debbugs.gnu.org