Merge pull request #1 from jestabro/no-utf8-escape

Use a modification of String.escaped to leave UTF-8 bytes unescaped

3 files changed, 26 insertions, 5 deletions

diff --git a/src/config_tree.ml b/src/config_tree.ml
index 31c0d76..c85b358 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -114,7 +114,7 @@ struct
         match child_names with
         | [] ->
              (* This is a leaf node *)
-             let values = List.map String.escaped data.values in
+             let values = List.map Util.escape_string data.values in
              let cmds =
                  begin
                  match values with
@@ -143,9 +143,9 @@ struct
   let render_values indent_str name values =
     match values with
     | [] -> Printf.sprintf "%s%s { }\n" indent_str name
-    | [v] -> Printf.sprintf "%s%s \"%s\"\n" indent_str name (String.escaped v)
+    | [v] -> Printf.sprintf "%s%s \"%s\"\n" indent_str name (Util.escape_string v)
     | _  -> 
-      let rendered = List.map (fun s -> Printf.sprintf "%s%s \"%s\"" indent_str name (String.escaped s)) values in
+      let rendered = List.map (fun s -> Printf.sprintf "%s%s \"%s\"" indent_str name (Util.escape_string s)) values in
       let rendered = String.concat "\n" rendered in
       Printf.sprintf "%s\n" rendered
 
@@ -205,9 +205,9 @@ module JSONRenderer = struct
     let render_values values =
         match values with
         | [] -> Printf.sprintf "{}"
-        | [v] -> Printf.sprintf "\"%s\"" (String.escaped v)
+        | [v] -> Printf.sprintf "\"%s\"" (Util.escape_string v)
         | _  ->
-            let rendered = List.map (fun s -> Printf.sprintf "\"%s\"" (String.escaped s)) values in
+            let rendered = List.map (fun s -> Printf.sprintf "\"%s\"" (Util.escape_string s)) values in
             let rendered = String.concat "," rendered in
             Printf.sprintf "[%s]" rendered
 
diff --git a/src/util.ml b/src/util.ml
index 9ce9387..10e7a25 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -1,11 +1,30 @@
 exception Syntax_error of ((int * int) option * string)
 
+external length : string -> int = "%string_length"
+external unsafe_get : string -> int -> char = "%string_unsafe_get"
+
+module B = Bytes
+
+let bts = B.unsafe_to_string
+let bos = B.unsafe_of_string
+
 let get_lexing_position lexbuf =
   let p = Lexing.lexeme_start_p lexbuf in
   let line_number = p.Lexing.pos_lnum in
   let column = p.Lexing.pos_cnum - p.Lexing.pos_bol + 1 in
   (line_number, column)
 
+(* Modification of String.escaped to leave UTF-8 bytes unescaped *)
+let escape_string s =
+  let rec escape_if_needed s n i =
+    if i >= n then s else
+      match unsafe_get s i with
+      | '\"' | '\\' | '\000'..'\031' | '\127' ->
+          bts (B.escaped (bos s))
+      | _ -> escape_if_needed s n (i+1)
+  in
+  escape_if_needed s (length s) 0
+
 let default default_value opt =
   match opt with
   | None -> default_value
diff --git a/src/util.mli b/src/util.mli
index 119ae01..7254fe1 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -2,4 +2,6 @@ exception Syntax_error of ((int * int) option * string)
 
 val get_lexing_position : Lexing.lexbuf -> int * int
 
+val escape_string : string -> string
+
 val default : 'a -> 'a option -> 'a