Escape semantic @as values in GenType

Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

compiler/gentype/import_path.ml

@@ -29,4 +29,24 @@ let to_cmt ~(config : Config.t) ~output_file_relative (dir, s) =
     | Some name -> "-" ^ name)
   ^ ".cmt"
 
-let emit (dir, s) = (dir, s) |> dump
+(* Import paths are emitted inside single-quoted JavaScript/TypeScript string
+   literals. The AST stores their semantic value, so restore source escapes at
+   this final output boundary. *)
+let escape_for_single_quotes s =
+  let buf = Buffer.create (String.length s) in
+  String.iter
+    (function
+      | '\'' -> Buffer.add_string buf "\\'"
+      | '\\' -> Buffer.add_string buf "\\\\"
+      | '\b' -> Buffer.add_string buf "\\b"
+      | '\012' -> Buffer.add_string buf "\\f"
+      | '\n' -> Buffer.add_string buf "\\n"
+      | '\r' -> Buffer.add_string buf "\\r"
+      | '\t' -> Buffer.add_string buf "\\t"
+      | c when Char.code c < 0x20 || Char.code c = 0x7f ->
+        Buffer.add_string buf (Printf.sprintf "\\x%02x" (Char.code c))
+      | c -> Buffer.add_char buf c)
+    s;
+  Buffer.contents buf
+
+let emit path = path |> dump |> escape_for_single_quotes

compiler/gentype/import_path.mli

@@ -5,6 +5,9 @@ type t
 val bs_curry_path : config:Config.t -> t
 val chop_extension_safe : t -> t [@@live]
 val dump : t -> string
+
+(* Escape a semantic import path for a single-quoted JavaScript/TypeScript
+   string literal. The returned string does not include the quotes. *)
 val emit : t -> string
 val from_module : dir:string -> import_extension:string -> Module_name.t -> t
 val from_string_unsafe : string -> t

compiler/gentype/translate_core_type.ml

@@ -183,7 +183,8 @@ and translateCoreType_ ~config ~type_vars_gen
             let label_js =
               if as_string then
                 match attributes |> Annotation.get_as_string with
-                | Some label_renamed -> StringLabel label_renamed
+                | Some label_renamed ->
+                  StringLabel (String.escaped label_renamed)
                 | None ->
                   if is_number label then IntLabel label else StringLabel label
               else if as_int then (

compiler/gentype/translate_type_declarations.ml

@@ -35,12 +35,14 @@ let create_polyvariant_case (label, attributes) =
       | Some (_, BoolPayload b) -> BoolLabel b
       | Some (_, FloatPayload s) -> FloatLabel s
       | Some (_, IntPayload i) -> IntLabel i
-      | Some (_, StringPayload as_label) -> StringLabel as_label
+      | Some (_, StringPayload as_label) ->
+        StringLabel (String.escaped as_label)
       | _ -> if is_number label then IntLabel label else StringLabel label);
   }
 
 let create_variant_case label = function
-  | Some (Variant_runtime.String label) -> {label_js = StringLabel label}
+  | Some (Variant_runtime.String label) ->
+    {label_js = StringLabel (String.escaped label)}
   | Some (Variant_runtime.Int label) ->
     {label_js = IntLabel (string_of_int label)}
   | Some (Variant_runtime.Float label) -> {label_js = FloatLabel label}

tests/gentype_tests/typescript-react-example/src/ImportJsValue.gen.tsx

@@ -13,6 +13,8 @@ import {returnMixedArray as returnMixedArrayNotChecked} from './MyMath';
 
 import {useColor as useColorNotChecked} from './MyMath';
 
+import {useEscapedInlineVariant as useEscapedInlineVariantNotChecked} from './MyMath';
+
 import {higherOrder as higherOrderNotChecked} from './MyMath';
 
 import {convertVariant as convertVariantNotChecked} from './MyMath';
@@ -51,6 +53,12 @@ export const useColorTypeChecked: (_1:color) => number = useColorNotChecked as a
 // Export 'useColor' early to allow circular import from the '.bs.js' file.
 export const useColor: unknown = useColorTypeChecked as (_1:color) => number as any;
 
+// In case of type error, check the type of 'useEscapedInlineVariant' in 'ImportJsValue.res' and './MyMath'.
+export const useEscapedInlineVariantTypeChecked: (_1:"Illegal\"Name") => number = useEscapedInlineVariantNotChecked as any;
+
+// Export 'useEscapedInlineVariant' early to allow circular import from the '.bs.js' file.
+export const useEscapedInlineVariant: unknown = useEscapedInlineVariantTypeChecked as (_1:"Illegal\"Name") => number as any;
+
 // In case of type error, check the type of 'higherOrder' in 'ImportJsValue.res' and './MyMath'.
 export const higherOrderTypeChecked: (_1:((_1:number, _2:number) => number)) => number = higherOrderNotChecked as any;
 

tests/gentype_tests/typescript-react-example/src/ImportJsValue.res

@@ -57,6 +57,10 @@ type stringFunction
 
 @genType.import("./MyMath") external useColor: color => int = "useColor"
 
+@genType.import("./MyMath")
+external useEscapedInlineVariant: @string [@as("Illegal\"Name") #illegalName] => int =
+  "useEscapedInlineVariant"
+
 @genType.import("./MyMath") external higherOrder: ((int, int) => int) => int = "higherOrder"
 
 @genType let returnedFromHigherOrder = higherOrder(\"+")

tests/gentype_tests/typescript-react-example/src/ImportJsValue.res.js

@@ -23,6 +23,8 @@ export type stringFunction = (_: string) => string;
 
 export const useColor = (_x: "tomato" | "gray"): number => 0;
 
+export const useEscapedInlineVariant = (_x: 'Illegal"Name'): number => 0;
+
 export const higherOrder = (foo: (_1: number, _2: number) => number) =>
   foo(3, 4);
 

tests/gentype_tests/typescript-react-example/src/MyMath.ts

@@ -52,7 +52,7 @@ export type myRecBsAs = {
   readonly jsValid0: string; 
   readonly type: string; 
   readonly "the-key": string; 
-  readonly "with\\\"dquote": string; 
+  readonly "with\"dquote": string; 
   readonly "with'squote": string; 
   readonly "1number": string
 };