[PATCH] ice-9: Add JSON module.

[PATCH] ice-9: Add JSON module.

[David Thompson]

[-- Attachment #1: Type: text/plain, Size: 751 bytes --]

Hello Guilers,

JSON is an commonly encountered format when writing web applications,
much like XML, and I think it would be a good idea if the core Guile
distribution had an SXML equivalent for JSON.  This patch introduces
such an interface in the (ice-9 json) module.

With (ice-9 json), this expression:

    (@ (name . "Eva Luator")
       (age . 24)
       (schemer . #t)
       (hobbies "hacking" "cycling" "surfing"))

serializes to this JSON (except not pretty-printed):

    {
      "name": "Eva Luator",
      "age": 24,
      "schemer": true,
      "hobbies": [
        "hacking",
        "cycling",
        "surfing"
      ]
    }

Thanks to Mark Weaver and Chris Webber for helping come to a consensus
on a good syntax for JSON objects.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ice-9-Add-JSON-module.patch --]
[-- Type: text/x-patch, Size: 21913 bytes --]

From 2d4d8607aedaede98f413a84f135d8798d506233 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 15 Aug 2015 14:09:23 -0400
Subject: [PATCH] ice-9: Add JSON module.

* module/ice-9/json.scm: New file.
* module/Makefile.am (ICE_9_SOURCES): Add it.
* test-suite/tests/json.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Add it.
* doc/ref/guile.texi ("Guile Modules"): Add "JSON" section.
* doc/ref/json.texi: New file.
* doc/ref/Makefile.am (guile_TEXINFOS): Add it.
---
 doc/ref/Makefile.am        |   3 +-
 doc/ref/guile.texi         |   2 +
 doc/ref/json.texi          |  62 +++++++
 module/Makefile.am         |   3 +-
 module/ice-9/json.scm      | 395 +++++++++++++++++++++++++++++++++++++++++++++
 test-suite/Makefile.am     |   1 +
 test-suite/tests/json.test | 149 +++++++++++++++++
 7 files changed, 613 insertions(+), 2 deletions(-)
 create mode 100644 doc/ref/json.texi
 create mode 100644 module/ice-9/json.scm
 create mode 100644 test-suite/tests/json.test

diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index 31c26a7..5dfc019 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -95,7 +95,8 @@ guile_TEXINFOS = preface.texi			\
 		 goops.texi			\
 		 goops-tutorial.texi		\
 		 guile-invoke.texi		\
-		 effective-version.texi
+		 effective-version.texi		\
+		 json.texi
 
 ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS)
 
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index db815eb..468d3a5 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -375,6 +375,7 @@ available through both Scheme and C interfaces.
 * Statprof::                    An easy-to-use statistical profiler.
 * SXML::                        Parsing, transforming, and serializing XML.
 * Texinfo Processing::          Munging documents written in Texinfo.
+* JSON::                        Parsing and serializing JSON.
 @end menu
 
 @include slib.texi
@@ -397,6 +398,7 @@ available through both Scheme and C interfaces.
 @include statprof.texi
 @include sxml.texi
 @include texinfo.texi
+@include json.texi
 
 @include goops.texi
 
diff --git a/doc/ref/json.texi b/doc/ref/json.texi
new file mode 100644
index 0000000..43dba4d
--- /dev/null
+++ b/doc/ref/json.texi
@@ -0,0 +1,62 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C) 2015  Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+@c
+
+@node JSON
+@section JSON
+
+@cindex json
+@cindex (ice-9 json)
+
+The @code{(ice-9 json)} module provides procedures for parsing and
+serializing JSON, the JavaScript Object Notation data interchange
+format.  For example, the JSON document:
+
+@example
+@verbatim
+{
+  "name": "Eva Luator",
+  "age": 24,
+  "schemer": true,
+  "hobbies": [
+    "hacking",
+    "cycling",
+    "surfing"
+  ]
+}
+@end verbatim
+@end example
+
+may be represented with the following s-expression:
+
+@example
+@verbatim
+(@ (name . "Eva Luator")
+   (age . 24)
+   (schemer . #t)
+   (hobbies "hacking" "cycling" "surfing"))
+@end verbatim
+@end example
+
+Strings, real numbers, @code{#t}, @code{#f}, @code{#nil}, lists, and
+association lists may be serialized as JSON.  Association lists
+serialize to objects, and regular lists serialize to arrays.  To
+distinguish regular lists from association lists, the @code{@@} symbol
+is used to ``tag'' the association list as a JSON object, as in the
+above example.  The keys of association lists may be either strings or
+symbols.
+
+@deffn {Scheme Procedure} read-json port
+
+Parse JSON-encoded text from @var{port} and return its s-expression
+representation.
+
+@end deffn
+
+@deffn {Scheme Procedure} write-json exp port
+
+Write the expression @var{exp} as JSON-encoded text to @var{port}.
+
+@end deffn
diff --git a/module/Makefile.am b/module/Makefile.am
index 7e96de7..6380953 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -256,7 +256,8 @@ ICE_9_SOURCES = \
   ice-9/list.scm \
   ice-9/serialize.scm \
   ice-9/local-eval.scm \
-  ice-9/unicode.scm
+  ice-9/unicode.scm \
+  ice-9/json.scm
 
 srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
 
diff --git a/module/ice-9/json.scm b/module/ice-9/json.scm
new file mode 100644
index 0000000..3850ee4
--- /dev/null
+++ b/module/ice-9/json.scm
@@ -0,0 +1,395 @@
+;;;; 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 (ice-9 json)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (read-json write-json))
+
+;;;
+;;; 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 (read-zeroes port)
+  "Read a sequence of zeroes from PORT."
+  (let loop ((result '()))
+    (match (peek-char port)
+      ((? eof-object?)
+       result)
+      (#\0
+       (read-char port)
+       (loop (cons 0 result)))
+      (else 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))
+
+\f
+;;;
+;;; 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/test-suite/Makefile.am b/test-suite/Makefile.am
index 3b10353..cbdfa7d 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -71,6 +71,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/iconv.test			\
 	    tests/import.test			\
 	    tests/interp.test			\
+	    tests/json.test			\
 	    tests/keywords.test			\
 	    tests/list.test			\
 	    tests/load.test			\
diff --git a/test-suite/tests/json.test b/test-suite/tests/json.test
new file mode 100644
index 0000000..c94a1c7
--- /dev/null
+++ b/test-suite/tests/json.test
@@ -0,0 +1,149 @@
+;;;; json.test --- test JSON reader/writer     -*- scheme -*-
+;;;;
+;;;; 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 (test-suite test-json)
+  #:use-module (test-suite lib)
+  #:use-module (ice-9 json))
+
+;;;
+;;; Reader
+;;;
+
+(define (read-json-string str)
+  (call-with-input-string str read-json))
+
+(define (json-read=? str x)
+  (= x (read-json-string str)))
+
+(define (json-read-eq? str x)
+  (eq? x (read-json-string str)))
+
+(define (json-read-equal? str x)
+  (equal? x (read-json-string str)))
+
+(define (json-read-string=? str x)
+  (string=? x (read-json-string str)))
+
+(with-test-prefix "read-json"
+  (pass-if (json-read-eq? "true" #t))
+  (pass-if (json-read-eq? "false" #f))
+  (pass-if (json-read-eq? "null" #nil))
+  (pass-if (json-read=? "0" 0))
+  (pass-if (json-read=? "0.1" 0.1))
+  (pass-if (json-read=? "1" 1))
+  (pass-if (json-read=? "-1" -1))
+  (pass-if (json-read=? "1.1" 1.1))
+  (pass-if (json-read=? "1e2" 1e2))
+  (pass-if (json-read=? "1.1e2" 1.1e2))
+  (pass-if (json-read=? "1.1e-2" 1.1e-2))
+  (pass-if (json-read=? "1.1e+2" 1.1e2))
+  (pass-if (json-read=? "1.1e+02" 1.1e2))
+  (pass-if (json-read-string=? "\"foo\"" "foo"))
+  ;; \" escape code.
+  (pass-if (json-read-string=? "\"\\\"\"" "\""))
+  ;; \\ escape code.
+  (pass-if (json-read-string=? "\"\\\\\"" "\\"))
+  ;; \/ escape code.
+  (pass-if (json-read-string=? "\"\\/\"" "/"))
+  ;; \b escape code.
+  (pass-if (json-read-string=? "\"\\b\"" "\b"))
+  ;; \f escape code.
+  (pass-if (json-read-string=? "\"\\f\"" "\f"))
+  ;; \n escape code.
+  (pass-if (json-read-string=? "\"\\n\"" "\n"))
+  ;; \r escape code.
+  (pass-if (json-read-string=? "\"\\r\"" "\r"))
+  ;; \t escape code.
+  (pass-if (json-read-string=? "\"\\t\"" "\t"))
+  ;; Unicode in hexadecimal format.
+  (pass-if (json-read-string=? "\"\\u12ab\"" "\u12ab"))
+  (pass-if (json-read-equal? "{}" '(@)))
+  (pass-if (json-read-equal? "{ \"foo\": \"bar\", \"baz\": \"frob\"}"
+                             '(@ ("foo" . "bar") ("baz" . "frob"))))
+  ;; Nested objects.
+  (pass-if (json-read-equal? "{\"foo\":{\"bar\":\"baz\"}}"
+                             '(@ ("foo" . (@ ("bar" . "baz"))))))
+  (pass-if (json-read-eq? "[]" '()))
+  (pass-if (json-read-equal? "[1, 2, \"foo\"]"
+                             '(1 2 "foo")))
+  ;; Nested arrays.
+  (pass-if (json-read-equal? "[1, 2, [\"foo\", \"bar\"]]"
+                             '(1 2 ("foo" "bar"))))
+  ;; Arrays and objects nested in each other.
+  (pass-if (json-read-equal? "{\"foo\":[{\"bar\":true},{\"baz\":[1,2,3]}]}"
+                             '(@ ("foo" . ((@ ("bar" . #t))
+                                           (@ ("baz" . (1 2 3))))))))
+  ;; Leading/trailing whitespace.
+  (pass-if (json-read-eq? "  true  " #t)))
+
+;;;
+;;; Writer
+;;;
+
+(define (write-json-string exp)
+  (call-with-output-string
+   (lambda (port)
+     (write-json exp port))))
+
+(define (json-write-string=? exp str)
+  (string=? str (write-json-string exp)))
+
+(with-test-prefix "write-json"
+  (pass-if (json-write-string=? #t "true"))
+  (pass-if (json-write-string=? #f "false"))
+  (pass-if (json-write-string=? #nil "null"))
+  (pass-if (json-write-string=? 0 "0"))
+  (pass-if (json-write-string=? 0.1 "0.1"))
+  (pass-if (json-write-string=? 1 "1"))
+  (pass-if (json-write-string=? -1 "-1"))
+  (pass-if (json-write-string=? 1.1 "1.1"))
+  (pass-if (json-write-string=? "foo" "\"foo\""))
+  ;; \" escape code.
+  (pass-if (json-write-string=? "\"" "\"\\\"\""))
+  ;; \\ escape code.
+  (pass-if (json-write-string=? "\\" "\"\\\\\""))
+  ;; \/ escape code.
+  (pass-if (json-write-string=? "/" "\"\\/\""))
+  ;; \b escape code.
+  (pass-if (json-write-string=? "\b" "\"\\b\""))
+  ;; \f escape code.
+  (pass-if (json-write-string=? "\f" "\"\\f\""))
+  ;; \n escape code.
+  (pass-if (json-write-string=? "\n" "\"\\n\""))
+  ;; \r escape code.
+  (pass-if (json-write-string=? "\r" "\"\\r\""))
+  ;; \t escape code.
+  (pass-if (json-write-string=? "\t" "\"\\t\""))
+  (pass-if (json-write-string=? '(@) "{}"))
+  (pass-if (json-write-string=? '(@ ("foo" . "bar") ("baz" . "frob"))
+                                "{\"foo\":\"bar\",\"baz\":\"frob\"}"))
+  ;; Nested objects.
+  (pass-if (json-write-string=? '(@ ("foo" . (@ ("bar" . "baz"))))
+                                "{\"foo\":{\"bar\":\"baz\"}}"))
+  (pass-if (json-write-string=? '() "[]"))
+  (pass-if (json-write-string=? '(1 2 "foo")
+                                "[1,2,\"foo\"]"))
+  ;; Nested arrays.
+  (pass-if (json-write-string=? '(1 2 ("foo" "bar"))
+                                "[1,2,[\"foo\",\"bar\"]]"))
+  ;; Arrays and objects nested in each other.
+  (pass-if (json-write-string=? '(@ ("foo" . ((@ ("bar" . #t))
+                                              (@ ("baz" . (1 2))))))
+                                "{\"foo\":[{\"bar\":true},{\"baz\":[1,2]}]}"))
+  ;; Symbol keys in alists
+  (pass-if (json-write-string=? '(@ (foo . 1)) "{\"foo\":1}")))
-- 
2.4.3


[-- Attachment #3: Type: text/plain, Size: 38 bytes --]


-- 
David Thompson
GPG Key: 0FF1D807

Re: [PATCH] ice-9: Add JSON module.

[David Thompson]

Noticed a couple of small issues after I sent the initial patch that
I've fixed in my local git branch:

David Thompson <davet@gnu.org> writes:

> +(define-module (ice-9 json)
> +  #:use-module (ice-9 match)
> +  #:use-module (srfi srfi-1)
> +  #:export (read-json write-json))

No need to import SRFI-1.

> +(define (read-zeroes port)
> +  "Read a sequence of zeroes from PORT."
> +  (let loop ((result '()))
> +    (match (peek-char port)
> +      ((? eof-object?)
> +       result)
> +      (#\0
> +       (read-char port)
> +       (loop (cons 0 result)))
> +      (else result))))

Never used.  Removed.

-- 
David Thompson
GPG Key: 0FF1D807

Re: [PATCH] ice-9: Add JSON module.

[Christopher Allan Webber]

I tested this, including with the fixes specified in the email.
(ice-9 json) seems to be working great... I'd love to see it
merged!

Re: [PATCH] ice-9: Add JSON module.

[Ludovic Courtès]

David Thompson <davet@gnu.org> skribis:

> JSON is an commonly encountered format when writing web applications,
> much like XML, and I think it would be a good idea if the core Guile
> distribution had an SXML equivalent for JSON.  This patch introduces
> such an interface in the (ice-9 json) module.

There’s also guile-json, bindings to a C library, but I think it’s
better to have a pure Scheme implementation, and to have it in Guile
core.

I wonder if we should introduce it in 2.0.  What do people think?

> +(define (json-error port)
> +  (throw 'json-error port))

This won’t print correctly, unless there’s an exception printer
installed in boot-9.scm (see ‘getaddrinfo-error’ for instance.)  Could
you add one?

Also, I think we need more details about the error: parse error, what
kind, etc.

Would it work to use the parser from (language ecmascript parse),
possibly restricting it?  Or do you think it’s more viable to have a
separate parser because there are too many differences?

Is there a standard test suite that we could test it against, somehow?

Otherwise LGTM.

Thanks, and sorry for the delay!

Ludo’.

Re: [PATCH] ice-9: Add JSON module.

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 1195 bytes --]


> On Sep 21, 2015, at 1:08 PM, Ludovic Courtès <ludo@gnu.org> wrote:
> 
> David Thompson <davet@gnu.org> skribis:
> 
>> JSON is an commonly encountered format when writing web applications,
>> much like XML, and I think it would be a good idea if the core Guile
>> distribution had an SXML equivalent for JSON.  This patch introduces
>> such an interface in the (ice-9 json) module.
> 
> There’s also guile-json, bindings to a C library, but I think it’s
> better to have a pure Scheme implementation, and to have it in Guile
> core.
> 
> I wonder if we should introduce it in 2.0.  What do people think?


I would be happy to have this in the core; I have used it.  A few comments:

1. There is a minor typo in the source: should be "denominator.”
2. The comments say integers are converted to exact and floating point to inexact, but the code will convert 1.0 to exact.

> Would it work to use the parser from (language ecmascript parse),
> possibly restricting it?  Or do you think it’s more viable to have a
> separate parser because there are too many differences?

I vote for separate parser, the json.scm file is lightweight.  json.scm.go is < 17k.


[-- Attachment #2: Type: text/html, Size: 2337 bytes --]

Re: [PATCH] ice-9: Add JSON module.

[Mark H Weaver]

Hi David,

Sorry for the long delay.

David Thompson <davet@gnu.org> writes:

> JSON is an commonly encountered format when writing web applications,
> much like XML, and I think it would be a good idea if the core Guile
> distribution had an SXML equivalent for JSON.  This patch introduces
> such an interface in the (ice-9 json) module.

Excellent!  This will be a most welcome addition :)

Please see below for comments.

> With (ice-9 json), this expression:
>
>     (@ (name . "Eva Luator")
>        (age . 24)
>        (schemer . #t)
>        (hobbies "hacking" "cycling" "surfing"))
>
> serializes to this JSON (except not pretty-printed):
>
>     {
>       "name": "Eva Luator",
>       "age": 24,
>       "schemer": true,
>       "hobbies": [
>         "hacking",
>         "cycling",
>         "surfing"
>       ]
>     }
>
> Thanks to Mark Weaver and Chris Webber for helping come to a consensus
> on a good syntax for JSON objects.
>
> From 2d4d8607aedaede98f413a84f135d8798d506233 Mon Sep 17 00:00:00 2001
> From: David Thompson <dthompson2@worcester.edu>
> Date: Sat, 15 Aug 2015 14:09:23 -0400
> Subject: [PATCH] ice-9: Add JSON module.
>
> * module/ice-9/json.scm: New file.
> * module/Makefile.am (ICE_9_SOURCES): Add it.
> * test-suite/tests/json.test: New file.
> * test-suite/Makefile.am (SCM_TESTS): Add it.
> * doc/ref/guile.texi ("Guile Modules"): Add "JSON" section.
> * doc/ref/json.texi: New file.
> * doc/ref/Makefile.am (guile_TEXINFOS): Add it.

The Makefile.am files need 2015 added to their copyright dates.

> ---
>  doc/ref/Makefile.am        |   3 +-
>  doc/ref/guile.texi         |   2 +
>  doc/ref/json.texi          |  62 +++++++
>  module/Makefile.am         |   3 +-
>  module/ice-9/json.scm      | 395 +++++++++++++++++++++++++++++++++++++++++++++
>  test-suite/Makefile.am     |   1 +
>  test-suite/tests/json.test | 149 +++++++++++++++++
>  7 files changed, 613 insertions(+), 2 deletions(-)
>  create mode 100644 doc/ref/json.texi
>  create mode 100644 module/ice-9/json.scm
>  create mode 100644 test-suite/tests/json.test
>
> diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
> index 31c26a7..5dfc019 100644
> --- a/doc/ref/Makefile.am
> +++ b/doc/ref/Makefile.am
> @@ -95,7 +95,8 @@ guile_TEXINFOS = preface.texi			\
>  		 goops.texi			\
>  		 goops-tutorial.texi		\
>  		 guile-invoke.texi		\
> -		 effective-version.texi
> +		 effective-version.texi		\
> +		 json.texi
>  
>  ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS)
>  
> diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
> index db815eb..468d3a5 100644
> --- a/doc/ref/guile.texi
> +++ b/doc/ref/guile.texi
> @@ -375,6 +375,7 @@ available through both Scheme and C interfaces.
>  * Statprof::                    An easy-to-use statistical profiler.
>  * SXML::                        Parsing, transforming, and serializing XML.
>  * Texinfo Processing::          Munging documents written in Texinfo.
> +* JSON::                        Parsing and serializing JSON.
>  @end menu
>  
>  @include slib.texi
> @@ -397,6 +398,7 @@ available through both Scheme and C interfaces.
>  @include statprof.texi
>  @include sxml.texi
>  @include texinfo.texi
> +@include json.texi
>  
>  @include goops.texi
>  
> diff --git a/doc/ref/json.texi b/doc/ref/json.texi
> new file mode 100644
> index 0000000..43dba4d
> --- /dev/null
> +++ b/doc/ref/json.texi
> @@ -0,0 +1,62 @@
> +@c -*-texinfo-*-
> +@c This is part of the GNU Guile Reference Manual.
> +@c Copyright (C) 2015  Free Software Foundation, Inc.
> +@c See the file guile.texi for copying conditions.
> +@c
> +
> +@node JSON
> +@section JSON
> +
> +@cindex json
> +@cindex (ice-9 json)
> +
> +The @code{(ice-9 json)} module provides procedures for parsing and
> +serializing JSON, the JavaScript Object Notation data interchange
> +format.  For example, the JSON document:
> +
> +@example
> +@verbatim
> +{
> +  "name": "Eva Luator",
> +  "age": 24,
> +  "schemer": true,
> +  "hobbies": [
> +    "hacking",
> +    "cycling",
> +    "surfing"
> +  ]
> +}
> +@end verbatim
> +@end example
> +
> +may be represented with the following s-expression:
> +
> +@example
> +@verbatim
> +(@ (name . "Eva Luator")
> +   (age . 24)
> +   (schemer . #t)
> +   (hobbies "hacking" "cycling" "surfing"))
> +@end verbatim
> +@end example

Looks good!

> +Strings, real numbers, @code{#t}, @code{#f}, @code{#nil}, lists, and

As we discussed on #guile, I would prefer to avoid the use of #nil.
Support for #nil is a hack that we're compelled to support for the sake
of integration with elisp which conflates boolean false with the empty
list, but we should avoid introducing more uses of it.

Was it decided that the symbol 'null' would be a good choice?  If so,
that sounds good to me.

> +association lists may be serialized as JSON.  Association lists
> +serialize to objects, and regular lists serialize to arrays.  To
> +distinguish regular lists from association lists, the @code{@@} symbol
> +is used to ``tag'' the association list as a JSON object, as in the
> +above example.  The keys of association lists may be either strings or
> +symbols.

It's probably better to strictly require strings and not accept symbols,
partly because of the special meanings of '@' and 'null'.

> +
> +@deffn {Scheme Procedure} read-json port
> +
> +Parse JSON-encoded text from @var{port} and return its s-expression
> +representation.
> +
> +@end deffn
> +
> +@deffn {Scheme Procedure} write-json exp port
> +
> +Write the expression @var{exp} as JSON-encoded text to @var{port}.
> +
> +@end deffn
> diff --git a/module/Makefile.am b/module/Makefile.am
> index 7e96de7..6380953 100644
> --- a/module/Makefile.am
> +++ b/module/Makefile.am
> @@ -256,7 +256,8 @@ ICE_9_SOURCES = \
>    ice-9/list.scm \
>    ice-9/serialize.scm \
>    ice-9/local-eval.scm \
> -  ice-9/unicode.scm
> +  ice-9/unicode.scm \
> +  ice-9/json.scm
>  
>  srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
>  
> diff --git a/module/ice-9/json.scm b/module/ice-9/json.scm
> new file mode 100644
> index 0000000..3850ee4
> --- /dev/null
> +++ b/module/ice-9/json.scm
> @@ -0,0 +1,395 @@
> +;;;; 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 (ice-9 json)
> +  #:use-module (ice-9 match)
> +  #:use-module (srfi srfi-1)
> +  #:export (read-json write-json))
> +
> +;;;
> +;;; 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))

RFC 7159 specifies a formal grammar for JSON.  We should make sure to
follow it precisely.  In the case of whitespace, RFC 7159 specifies:

      ws = *(
              %x20 /              ; Space
              %x09 /              ; Horizontal tab
              %x0A /              ; Line feed or New line
              %x0D )              ; Carriage return

in contrast:

(char-set->list char-set:whitespace)
=> (#\tab #\newline #\vtab #\page #\return #\space #\xa0 #\x1680 #\x180e
    #\x2000 #\x2001 #\x2002 #\x2003 #\x2004 #\x2005 #\x2006 #\x2007
    #\x2008 #\x2009 #\x200a #\x2028 #\x2029 #\x202f #\x205f #\x3000)

> +(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."

This docstring needs improvement.  See below for a suggested
replacement.

> +  (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)))))))

To optimize this inner loop, it would be good to avoid the calls to
'string-length' and 'string-ref' on each iteration.  They lack VM
instructions, and 'string-ref' will likely be more expensive in the
future when we switch to UTF-8 for our internal string representation.

So, how about something like this instead?

--8<---------------cut here---------------start------------->8---
(define (make-keyword-reader keyword value)
  "Return a procedure that, given an input port, expects to find KEYWORD
(a symbol) as the next characters to be read.  In that case, it consumes
KEYWORD from the port and returns VALUE.  Otherwise, it raises an error
after consuming the first non-matching character or EOF."
  (let ((chars (string->list (symbol->string keyword))))
    (lambda (port)
      (let loop ((cs chars))
        (match cs
          (() value)
          ((c . rest)
           (if (eqv? c (read-char port))
               (loop rest)
               (json-error port))))))))
--8<---------------cut here---------------end--------------->8---

> +
> +(define read-true (make-keyword-reader 'true #t))
> +(define read-false (make-keyword-reader 'false #f))
> +(define read-null (make-keyword-reader 'null #nil))

How about lining up the right hand sides here?

> +
> +(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."

Perhaps I'm being too pedantic, but this doesn't read the whole
character, but only the part after the "\u".  How about calling it
something like 'read-4-hex-digits' and returning the integer instead of
the character?

> +  (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))))

This assumes that the arguments to '+' are evaluated left-to-right, but
this is not guaranteed by the relevant Scheme standards and I'd prefer
to avoid making such assumptions.  I suggest using 'let*' to read the
four digits and bind them to four variables.  'let*' guarantees the
order of evaluation (although 'let' does not).

Also, it would be more efficient to use 'ash' than multiplication here.

> +
> +(define (read-escape-character port)
> +  "Read escape character from PORT."

As with 'read-utf16-character', this doesn't read the escape character
but only the part after the "\".  Maybe it's not worth changing the
name, but the doc string should make this clear, at least.

> +  (match (read-char port)
> +    (#\" #\")
> +    (#\\ #\\)
> +    (#\/ #\/)
> +    (#\b #\backspace)
> +    (#\f #\page)
> +    (#\n #\newline)
> +    (#\r #\return)
> +    (#\t #\tab)
> +    (#\u (read-utf16-character port))

This doesn't correctly handle characters that are not in the Basic
Multilingual Plane.  RFC 7159 specifies that such characters are:

  [...] represented as a 12-character sequence, encoding the UTF-16
  surrogate pair.  So, for example, a string containing only the G clef
  character (U+1D11E) may be represented as "\uD834\uDD1E".

These sequences must be handled properly in both directions (reading and
writing), and on the read side should be validated to be within the
valid unicode range.  Also, the code points used in UTF-16 surrogate
pairs should only be accepted when they are part of a valid surrogate
pair.

> +    (_ (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)))

SRFI-1 actually has a 'reverse-list->string' procedure that does this
more efficiently.

> +      (#\\ (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)))))

It should be noted that if no digits are found on the port, this will
return an empty list, which 'list->integer' accepts and returns zero.
I'm not sure if that's a problem.

> +
> +(define (read-zeroes port)
> +  "Read a sequence of zeroes from PORT."
> +  (let loop ((result '()))
> +    (match (peek-char port)
> +      ((? eof-object?)
> +       result)
> +      (#\0
> +       (read-char port)
> +       (loop (cons 0 result)))
> +      (else result))))

As you already noted, this procedure is unused.

> +
> +(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)))))

How about using 'string->number' instead?  This would also allow
avoiding the slow converstion of digits to integers above.

> +(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))))

There are some decisions to make regarding the handling of numbers, and
I'm not sure what's best.

* Should we keep this independent implementation in Scheme for
  converting character strings to numbers, or use the existing
  'string->number' after verifying that it matches the precise JSON
  syntax?  There are several optimizations and tricks that can be used
  by a mature number reader, some of which are already done by
  'string->number' and some which we may do in the future.

* When should this JSON reader produce exact numbers, and when should it
  produce inexact?  I can see arguments for always producing exact
  numbers (to avoid introducing errors in things like monetary values
  like 0.01), or always producing inexact numbers (to allow bounding
  memory use to a constant), or doing something like you've chosen here
  (to allow unbounded big integers but improving efficiency for
  floating-point numbers).

* A large exponent could easily make this use huge amounts of memory.
  Of course, there's no reasonable way to avoid running out of memory
  when reading something like JSON, so perhaps it's not worth worrying
  about in this particular case.

Thoughts?

> +(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))

Hmm.  I can see why this strict expectation of EOF is helpful to avoid
possible bugs, but I wonder: might there be cases where a user needs to
read multiple JSON values from a port, or JSON followed by something
else?  It seems that this module currently provides no interface that
can do it.

> +
> +\f
> +;;;
> +;;; 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))

RFC 7159 says:

  All Unicode characters may be placed within the quotation marks,
  except for the characters that must be escaped: quotation mark,
  reverse solidus, and the control characters (U+0000 through U+001F).

and in more formal language:

      unescaped = %x20-21 / %x23-5B / %x5D-10FFFF

So, you need to add another case, for the other control characters
between U+0000 and U+001F that are not already handled above.

Also, there's no need to escape "/", and I guess it's probably better
not to.  What do you think?

> +             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))))

As we discussed on IRC, it's probably better to strictly require strings
than to allow both.

> +  (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)

It would be more efficient to use (head tail ...) as the pattern here,
and adjust the code below accordingly.

> +     (for-each (lambda (pair)
> +                 (write-pair pair)
> +                 (display "," port))
> +          front)

Indentation.

> +     (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)

Ditto.

> +     (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))))

Otherwise it looks good to me.  Can you send an updated patch?

   Thank you!
      Mark

Re: [PATCH] ice-9: Add JSON module.

[Mark H Weaver]

Matt Wette <matthew.wette@verizon.net> writes:

>     On Sep 21, 2015, at 1:08 PM, Ludovic Courtès <ludo@gnu.org> wrote:
>
>     
>     David Thompson <davet@gnu.org> skribis:
>     
>         JSON is an commonly encountered format when writing web
>         applications,
>         much like XML, and I think it would be a good idea if the core
>         Guile
>         distribution had an SXML equivalent for JSON. This patch
>         introduces
>         such an interface in the (ice-9 json) module.
>         
>
>     There’s also guile-json, bindings to a C library, but I think it’s
>     better to have a pure Scheme implementation, and to have it in
>     Guile
>     core.
>     
>     I wonder if we should introduce it in 2.0. What do people think?
>     
>
> I would be happy to have this in the core; I have used it.

Agreed.

> 1. There is a minor typo in the source: should be "denominator.”

Indeed, good catch!

> 2. The comments say integers are converted to exact and floating point
> to inexact, but the code will convert 1.0 to exact.

In Scheme terminology, 1.0 is an integer.

>     Would it work to use the parser from (language ecmascript parse),
>     possibly restricting it? Or do you think it’s more viable to have
>     a
>     separate parser because there are too many differences?
>     
>
> I vote for separate parser, the json.scm file is lightweight.
> json.scm.go is < 17k.

Agreed.  The simplicity also allows confidence that it can safely handle
potentially malicious JSON data.

      Mark

Re: [PATCH] ice-9: Add JSON module.

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 438 bytes --]


> On Sep 21, 2015, at 11:49 PM, Mark H Weaver <mhw@netris.org> wrote:
> 
>> 2. The comments say integers are converted to exact and floating point
>> to inexact, but the code will convert 1.0 to exact.
> 
> In Scheme terminology, 1.0 is an integer.

But in guile-2.0.11:

scheme@(guile-user)> (exact? (string->number "1.0"))
$1 = #f

I also vote for using string->number: probably faster and more heavily tested.

Matt


[-- Attachment #2: Type: text/html, Size: 2907 bytes --]