diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/build-system/node.scm | 10 | ||||
| -rw-r--r-- | guix/build/json.scm | 387 | ||||
| -rw-r--r-- | guix/build/node-build-system.scm | 28 |
4 files changed, 20 insertions, 406 deletions
diff --git a/Makefile.am b/Makefile.am index 9839bf27cc..38f2d7e690 100644 --- a/Makefile.am +++ b/Makefile.am @@ -184,7 +184,6 @@ 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/guix/build-system/node.scm b/guix/build-system/node.scm index 05c24c47d5..dad492dc95 100644 --- a/guix/build-system/node.scm +++ b/guix/build-system/node.scm @@ -18,7 +18,6 @@ (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) @@ -27,6 +26,7 @@ #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) + #:use-module (json parser) #:export (npm-meta-uri %node-build-system-modules node-build @@ -40,8 +40,8 @@ registry." (define %node-build-system-modules ;; Build-side modules imported by default. `((guix build node-build-system) - (guix build json) (guix build union) + (json parser) ,@%gnu-build-system-modules)) ;; TODO: Might be not needed (define (default-node) @@ -88,9 +88,9 @@ registry." (guile #f) (imported-modules %node-build-system-modules) (modules '((guix build node-build-system) - (guix build json) - (guix build union) - (guix build utils)))) + (guix build union) + (guix build utils) + (json parser)))) "Build SOURCE using NODE and INPUTS." (define builder `(begin diff --git a/guix/build/json.scm b/guix/build/json.scm deleted file mode 100644 index 361ea76728..0000000000 --- a/guix/build/json.scm +++ /dev/null @@ -1,387 +0,0 @@ -;;;; 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 index 3c0ac2a12b..231e60488a 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -19,12 +19,12 @@ (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 (json parser) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases @@ -39,12 +39,12 @@ (define* (read-package-data #:key (filename "package.json")) (call-with-input-file filename (lambda (port) - (read-json port)))) + (json->scm 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"))) + (scripts (hash-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 @@ -103,13 +103,15 @@ the @file{bin} directory." (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) + (modulename (hash-ref data "name")) + (binary-configuration (match (hash-ref data "bin") + ((? hash-table? hash-table) + (hash-map->list cons hash-table)) + ((? string? configuration) configuration) + (#f #f))) + (dependencies (match (hash-ref data "dependencies") + ((? hash-table? hash-table) + (hash-map->list cons hash-table)) (#f #f)))) (mkdir-p target) (copy-recursively "." (string-append target "/node_modules/" modulename)) @@ -121,7 +123,7 @@ the @file{bin} directory." (begin (mkdir-p binaries) (symlink (string-append target "/node_modules/" modulename "/" - binary-configuration) + binary-configuration) (string-append binaries "/" modulename)))) ((list? binary-configuration) (for-each @@ -131,12 +133,12 @@ the @file{bin} directory." (begin (mkdir-p (dirname (string-append binaries "/" key))) (symlink (string-append target "/node_modules/" modulename "/" - value) + value) (string-append binaries "/" key)))))) binary-configuration)) (else (symlink (string-append target "/node_modules/" modulename "/bin") - binaries))) + binaries))) (when dependencies (mkdir-p (string-append target "/node_modules/" modulename "/node_modules")) |