build-system: Rewrite node build system.
* guix/build/node-build-system.scm: Rewrite it. * guix/build-system/node.scm: Adjust accordingly. * gnu/packages/node-xyz.scm (node-semver): Likewise. Co-authored-by: Timothy Sample <samplet@ngyro.com>
This commit is contained in:
parent
532c0e745a
commit
23ea84cdf0
3 changed files with 112 additions and 132 deletions
|
@ -261,7 +261,11 @@ (define-public node-semver
|
|||
"06biknqb05r9xsmcflm3ygh50pjvdk84x6r79w43kmck4fn3qn5p"))))
|
||||
(build-system node-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f)) ;; FIXME: Tests depend on node-tap
|
||||
'(#:tests? #f ; FIXME: Tests depend on node-tap
|
||||
#:phases
|
||||
(modify-phases %standard-phases
|
||||
;; The only dependency to check for is tap, which we don't have.
|
||||
(delete 'configure))))
|
||||
(home-page "https://github.com/npm/node-semver")
|
||||
(synopsis "Parses semantic versions strings")
|
||||
(description
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
|
||||
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -17,7 +18,6 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix build-system node)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix derivations)
|
||||
|
@ -25,22 +25,15 @@ (define-module (guix build-system node)
|
|||
#:use-module (guix build-system)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (npm-meta-uri
|
||||
%node-build-system-modules
|
||||
#:export (%node-build-system-modules
|
||||
node-build
|
||||
node-build-system))
|
||||
|
||||
(define (npm-meta-uri name)
|
||||
"Return a URI string for the metadata of node module NAME found in the npm
|
||||
registry."
|
||||
(string-append "https://registry.npmjs.org/" name))
|
||||
|
||||
(define %node-build-system-modules
|
||||
;; Build-side modules imported by default.
|
||||
`((guix build node-build-system)
|
||||
(guix build json)
|
||||
(guix build union)
|
||||
,@%gnu-build-system-modules)) ;; TODO: Might be not needed
|
||||
,@%gnu-build-system-modules))
|
||||
|
||||
(define (default-node)
|
||||
"Return the default Node package."
|
||||
|
@ -76,7 +69,7 @@ (define private-keywords
|
|||
|
||||
(define* (node-build store name inputs
|
||||
#:key
|
||||
(npm-flags ''())
|
||||
(test-target "test")
|
||||
(tests? #t)
|
||||
(phases '(@ (guix build node-build-system)
|
||||
%standard-phases))
|
||||
|
@ -86,8 +79,6 @@ (define* (node-build store name inputs
|
|||
(guile #f)
|
||||
(imported-modules %node-build-system-modules)
|
||||
(modules '((guix build node-build-system)
|
||||
(guix build json)
|
||||
(guix build union)
|
||||
(guix build utils))))
|
||||
"Build SOURCE using NODE and INPUTS."
|
||||
(define builder
|
||||
|
@ -97,12 +88,10 @@ (define builder
|
|||
#:source ,(match (assoc-ref inputs "source")
|
||||
(((? derivation? source))
|
||||
(derivation->output-path source))
|
||||
((source)
|
||||
source)
|
||||
(source
|
||||
source))
|
||||
((source) source)
|
||||
(source source))
|
||||
#:system ,system
|
||||
#:npm-flags ,npm-flags
|
||||
#:test-target ,test-target
|
||||
#:tests? ,tests?
|
||||
#:phases ,phases
|
||||
#:outputs %outputs
|
||||
|
@ -129,5 +118,5 @@ (define guile-for-build
|
|||
(define node-build-system
|
||||
(build-system
|
||||
(name 'node)
|
||||
(description "The standard Node build system")
|
||||
(description "The Node build system")
|
||||
(lower lower)))
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
||||
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
|
||||
;;; Copyright © 2016, 2020 Jelle Licht <jlicht@fsfe.org>
|
||||
;;; Copyright © 2019, 2021 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -19,144 +20,130 @@
|
|||
|
||||
(define-module (guix build node-build-system)
|
||||
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
|
||||
#:use-module (guix build json)
|
||||
#:use-module (guix build union)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix build json)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (%standard-phases
|
||||
node-build))
|
||||
|
||||
;; Commentary:
|
||||
;;
|
||||
;; Builder-side code of the standard Node/npm package build procedure.
|
||||
;; Builder-side code of the standard Node/NPM package install procedure.
|
||||
;;
|
||||
;; Code:
|
||||
|
||||
(define* (read-package-data #:key (filename "package.json"))
|
||||
(call-with-input-file filename
|
||||
(lambda (port)
|
||||
(read-json port))))
|
||||
(define (set-home . _)
|
||||
(with-directory-excursion ".."
|
||||
(let loop ((i 0))
|
||||
(let ((dir (string-append "npm-home-" (number->string i))))
|
||||
(if (directory-exists? dir)
|
||||
(loop (1+ i))
|
||||
(begin
|
||||
(mkdir dir)
|
||||
(setenv "HOME" (string-append (getcwd) "/" dir))
|
||||
(format #t "set HOME to ~s~%" (getenv "HOME")))))))
|
||||
#t)
|
||||
|
||||
(define (module-name module)
|
||||
(let* ((package.json (string-append module "/package.json"))
|
||||
(package-meta (call-with-input-file package.json read-json)))
|
||||
(assoc-ref package-meta "name")))
|
||||
|
||||
(define (index-modules input-paths)
|
||||
(define (list-modules directory)
|
||||
(append-map (lambda (x)
|
||||
(if (string-prefix? "@" x)
|
||||
(list-modules (string-append directory "/" x))
|
||||
(list (string-append directory "/" x))))
|
||||
(filter (lambda (x)
|
||||
(not (member x '("." ".."))))
|
||||
(or (scandir directory) '()))))
|
||||
(let ((index (make-hash-table (* 2 (length input-paths)))))
|
||||
(for-each (lambda (dir)
|
||||
(let ((nm (string-append dir "/lib/node_modules")))
|
||||
(for-each (lambda (module)
|
||||
(hash-set! index (module-name module) module))
|
||||
(list-modules nm))))
|
||||
input-paths)
|
||||
index))
|
||||
|
||||
(define* (patch-dependencies #:key inputs #:allow-other-keys)
|
||||
|
||||
(define index (index-modules (map cdr inputs)))
|
||||
|
||||
(define (resolve-dependencies package-meta meta-key)
|
||||
(fold (lambda (key+value acc)
|
||||
(match key+value
|
||||
('@ acc)
|
||||
((key . value) (acons key (hash-ref index key value) acc))))
|
||||
'()
|
||||
(or (assoc-ref package-meta meta-key) '())))
|
||||
|
||||
(with-atomic-file-replacement "package.json"
|
||||
(lambda (in out)
|
||||
(let ((package-meta (read-json in)))
|
||||
(assoc-set! package-meta "dependencies"
|
||||
(append
|
||||
'(@)
|
||||
(resolve-dependencies package-meta "dependencies")
|
||||
(resolve-dependencies package-meta "peerDependencies")))
|
||||
(assoc-set! package-meta "devDependencies"
|
||||
(append
|
||||
'(@)
|
||||
(resolve-dependencies package-meta "devDependencies")))
|
||||
(write-json package-meta out))))
|
||||
#t)
|
||||
|
||||
(define* (configure #:key outputs inputs #:allow-other-keys)
|
||||
(let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
|
||||
(invoke npm "--offline" "--ignore-scripts" "install")
|
||||
#t))
|
||||
|
||||
(define* (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))
|
||||
(let ((package-meta (call-with-input-file "package.json" read-json)))
|
||||
(if (and=> (assoc-ref package-meta "scripts")
|
||||
(lambda (scripts)
|
||||
(assoc-ref scripts "build")))
|
||||
(let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
|
||||
(invoke npm "run" "build"))
|
||||
(format #t "there is no build script to run~%"))
|
||||
#t))
|
||||
|
||||
(define configure link-npm-dependencies)
|
||||
|
||||
(define* (check #:key tests? #:allow-other-keys)
|
||||
(define* (check #:key tests? inputs #:allow-other-keys)
|
||||
"Run 'npm test' if TESTS?"
|
||||
(if tests?
|
||||
;; Should only be enabled once we know that there are tests
|
||||
(invoke "npm" "test"))
|
||||
(let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
|
||||
(invoke npm "test"))
|
||||
(format #t "test suite not run~%"))
|
||||
#t)
|
||||
|
||||
(define (node-package? name)
|
||||
"Check if NAME correspond to the name of an Node package."
|
||||
(string-prefix? "node-" name))
|
||||
(define* (repack #:key inputs #:allow-other-keys)
|
||||
(invoke "tar" "-czf" "../package.tgz" ".")
|
||||
#t)
|
||||
|
||||
(define* (install #:key outputs inputs #:allow-other-keys)
|
||||
"Install the node module to the output store item. The module itself is
|
||||
installed in a subdirectory of @file{node_modules} and its runtime dependencies
|
||||
as defined by @file{package.json} are symlinked into a @file{node_modules}
|
||||
subdirectory of the module's directory. Additionally, binaries are installed in
|
||||
the @file{bin} directory."
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(target (string-append out "/lib"))
|
||||
(binaries (string-append out "/bin"))
|
||||
(data (read-package-data))
|
||||
(modulename (assoc-ref data "name"))
|
||||
(binary-configuration (match (assoc-ref data "bin")
|
||||
(('@ configuration ...) configuration)
|
||||
((? string? configuration) configuration)
|
||||
(#f #f)))
|
||||
(dependencies (match (assoc-ref data "dependencies")
|
||||
(('@ deps ...) deps)
|
||||
(#f #f))))
|
||||
(mkdir-p target)
|
||||
(copy-recursively "." (string-append target "/node_modules/" modulename))
|
||||
;; Remove references to dependencies
|
||||
(delete-file-recursively
|
||||
(string-append target "/node_modules/" modulename "/node_modules"))
|
||||
(cond
|
||||
((string? binary-configuration)
|
||||
(begin
|
||||
(mkdir-p binaries)
|
||||
(symlink (string-append target "/node_modules/" modulename "/"
|
||||
binary-configuration)
|
||||
(string-append binaries "/" modulename))))
|
||||
((list? binary-configuration)
|
||||
(for-each
|
||||
(lambda (conf)
|
||||
(match conf
|
||||
((key . value)
|
||||
(begin
|
||||
(mkdir-p (dirname (string-append binaries "/" key)))
|
||||
(symlink (string-append target "/node_modules/" modulename "/"
|
||||
value)
|
||||
(string-append binaries "/" key))))))
|
||||
binary-configuration)))
|
||||
(when dependencies
|
||||
(mkdir-p
|
||||
(string-append target "/node_modules/" modulename "/node_modules"))
|
||||
(for-each
|
||||
(lambda (dependency)
|
||||
(let ((dependency (car dependency)))
|
||||
(symlink
|
||||
(string-append (assoc-ref inputs (string-append "node-" dependency))
|
||||
"/lib/node_modules/" dependency)
|
||||
(string-append target "/node_modules/" modulename
|
||||
"/node_modules/" dependency))))
|
||||
dependencies))
|
||||
"Install the node module to the output store item."
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(npm (string-append (assoc-ref inputs "node") "/bin/npm")))
|
||||
(invoke npm "--prefix" out
|
||||
"--global"
|
||||
"--offline"
|
||||
"--loglevel" "info"
|
||||
"--production"
|
||||
"install" "../package.tgz")
|
||||
#t))
|
||||
|
||||
|
||||
(define %standard-phases
|
||||
(modify-phases gnu:%standard-phases
|
||||
(add-after 'unpack 'set-home set-home)
|
||||
(add-before 'configure 'patch-dependencies patch-dependencies)
|
||||
(replace 'configure configure)
|
||||
(replace 'build build)
|
||||
(replace 'install install)
|
||||
(delete 'check)
|
||||
(add-after 'install 'check check)
|
||||
(delete 'strip)))
|
||||
(replace 'check check)
|
||||
(add-before 'install 'repack repack)
|
||||
(replace 'install install)))
|
||||
|
||||
(define* (node-build #:key inputs (phases %standard-phases)
|
||||
#:allow-other-keys #:rest args)
|
||||
|
|
Loading…
Reference in a new issue