20171025 src/JSON/patch/json-stream-printer.sml.* (update nach merge von SML/NJ 110.82)

src/JSON/patch/json-stream-printer.sml.orig

@@ -97,8 +97,30 @@ structure JSONStreamPrinter : sig
       | boolean (p, true) = prVal (p, "true")
     fun integer (p, n) = prVal (p, F.format "%d" [F.LINT n])
     fun float (p, f) = prVal (p, F.format "%g" [F.REAL f])
-(* FIXME: need to deal with UTF-* escapes *)
-    fun string (p, s) = prVal (p, F.format "\"%s\"" [F.STR(String.toCString s)])
+    fun string (p, s) = let
+	  fun getChar i = if (i < size s) then SOME(String.sub(s, i), i+1) else NONE
+	  val getWChar = UTF8.getu getChar
+	  fun tr (i, chrs) = (case getWChar i
+		 of SOME(wchr, i) => if (wchr <= 0w126)
+		      then (case UTF8.toAscii wchr
+			 of #"\"" => "\\\""
+			  | #"\\" => "\\\\"
+			  | #"/" => "\\/"
+			  | #"\b" => "\\b"
+			  | #"\f" => "\\f"
+			  | #"\n" => "\\n"
+			  | #"\r" => "\\r"
+			  | #"\t" => "\\t"
+			  | c => if (wchr < 0w32)
+			      then tr(i, F.format "\\u%04x" [F.WORD wchr] :: chrs)
+			      else tr(i, str c :: chrs)
+			(* end case *))
+		      else tr(i, F.format "\\u%04x" [F.WORD wchr] :: chrs)
+		  | NONE => String.concat(List.rev chrs)
+		(* end case *))
+	  in
+	    prVal (p, F.format "\"%s\"" [F.STR(tr (0, []))])
+	  end
 
     fun beginObject (p as P{ctx, ...}) = (
 	  optComma p;
@@ -131,10 +153,10 @@ structure JSONStreamPrinter : sig
     fun endArray (p as P{ctx, ...}) = let
 	  fun prEnd ctx' = (
 		ctx := ctx';
-		nl p; indent(p, ~1); pr(p, "]"); decIndent (p, 2))
+		indent(p, ~1); pr(p, "]"); decIndent (p, 2))
 	  in
 	    case !ctx
-	     of ARRAY ctx' => prEnd ctx'
+	     of ARRAY ctx' => (nl p; prEnd ctx')
 	      | FIRST(ARRAY ctx') => prEnd ctx'
 	      | _ => raise Fail "endArray not in array context"
 	    (* end case *)

src/JSON/patch/json-stream-printer.sml.patch

@@ -1,5 +1,5 @@
---- json-stream-printer.sml.orig	2008-05-20 20:08:00.000000000 +0200
-+++ json-stream-printer.sml	2017-10-13 00:04:34.575739000 +0200
+--- json-stream-printer.sml.orig	2017-10-25 01:34:17.349274000 +0200
++++ json-stream-printer.sml	2017-10-25 01:43:40.211305000 +0200
 @@ -66,7 +66,7 @@
  		then TextIO.output(strm, String.extract(tenSpaces, 10-n, NONE))
  		else (TextIO.output(strm, tenSpaces); prIndent(n-10))
@@ -9,26 +9,8 @@
  	  end
  
      fun incIndent (P{indent, ...}, n) = indent := !indent + n;
-@@ -98,11 +98,23 @@
-     fun integer (p, n) = prVal (p, F.format "%d" [F.LINT n])
-     fun float (p, f) = prVal (p, F.format "%g" [F.REAL f])
- (* FIXME: need to deal with UTF-* escapes *)
--    fun string (p, s) = prVal (p, F.format "\"%s\"" [F.STR(String.toCString s)])
--
-+    (* fun string (p, s) = prVal (p, F.format "\"%s\"" [F.STR(String.toCString s)]) *)
-+    fun string (p, s) = (* RFC 7159 *)
-+	let fun esc #"\"" = "\\\""
-+	      | esc #"\\" = "\\\\"
-+	      | esc #"\b" = "\\b"
-+	      | esc #"\f" = "\\f"
-+	      | esc #"\n" = "\\n"
-+	      | esc #"\r" = "\\r"
-+	      | esc #"\t" = "\\t"
-+	      | esc c = if c < #" "
-+			then "\\u" ^ (StringCvt.padLeft #"0" 4 (Int.fmt StringCvt.HEX (ord c)))
-+			else str c
-+	in prVal (p, "\"" ^ (String.translate esc s) ^ "\"")
-+	end
+@@ -124,7 +124,7 @@
+ 
      fun beginObject (p as P{ctx, ...}) = (
  	  optComma p;
 -	  pr (p, "{"); incIndent(p, 2); nl p;
@@ -36,7 +18,7 @@
  	  ctx := FIRST(OBJECT(!ctx)))
  
      fun objectKey (p as P{ctx = ref(KEY _), ...}, field) =
-@@ -114,7 +126,7 @@
+@@ -136,7 +136,7 @@
      fun endObject (p as P{ctx, ...}) = let
  	  fun prEnd ctx' = (
  		ctx := ctx';
@@ -45,7 +27,7 @@
  	  in
  	    case !ctx
  	     of OBJECT ctx' => (nl p; prEnd ctx')
-@@ -125,13 +137,13 @@
+@@ -147,13 +147,13 @@
  
      fun beginArray (p as P{ctx, ...}) = (
  	  optComma p;
@@ -56,8 +38,8 @@
      fun endArray (p as P{ctx, ...}) = let
  	  fun prEnd ctx' = (
  		ctx := ctx';
--		nl p; indent(p, ~1); pr(p, "]"); decIndent (p, 2))
-+		nl p; indent(p, 0); pr(p, "]"); decIndent (p, 1))
+-		indent(p, ~1); pr(p, "]"); decIndent (p, 2))
++		indent(p, 0); pr(p, "]"); decIndent (p, 1))
  	  in
  	    case !ctx
- 	     of ARRAY ctx' => prEnd ctx'
+ 	     of ARRAY ctx' => (nl p; prEnd ctx')