print exotic identifiers properly when completing polyvariants

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -231,8 +231,8 @@ let kindToDetail name (kind : Completion.kind) =
       ^ "\n\n" ^ s
     else name ^ ": " ^ (typ |> Shared.typeToString) ^ "\n\n" ^ s
   | Constructor (c, s) -> showConstructor c ^ "\n\n" ^ s
-  | PolyvariantConstructor ({name; args}, s) ->
-    "#" ^ name
+  | PolyvariantConstructor ({displayName; args}, s) ->
+    "#" ^ displayName
     ^ (match args with
       | [] -> ""
       | typeExprs ->
@@ -1223,13 +1223,13 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
     |> List.map (fun (constructor : polyVariantConstructor) ->
            Completion.createWithSnippet
              ~name:
-               ("#" ^ constructor.name
+               ("#" ^ constructor.displayName
                ^ printConstructorArgs
                    (List.length constructor.args)
                    ~asSnippet:false)
              ~insertText:
                ((if Utils.startsWith prefix "#" then "" else "#")
-               ^ constructor.name
+               ^ constructor.displayName
                ^ printConstructorArgs
                    (List.length constructor.args)
                    ~asSnippet:true)
@@ -1771,7 +1771,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
                  ~cases:
                    (v.constructors
                    |> List.map (fun (constructor : polyVariantConstructor) ->
-                          "#" ^ constructor.name
+                          "#" ^ constructor.displayName
                           ^
                           match constructor.args with
                           | [] -> ""

analysis/src/SharedTypes.ml

@@ -311,7 +311,11 @@ end = struct
     {env with exported = structure.exported; pathRev; parent = Some env}
 end
 
-type polyVariantConstructor = {name: string; args: Types.type_expr list}
+type polyVariantConstructor = {
+  name: string;
+  displayName: string;
+  args: Types.type_expr list;
+}
 
 type innerType = TypeExpr of Types.type_expr | ExtractedType of completionType
 and completionType =

analysis/src/TypeUtils.ml

@@ -157,6 +157,7 @@ let rec extractType ~env ~package (t : Types.type_expr) =
       |> List.map (fun (label, field) ->
              {
                name = label;
+               displayName = Utils.printMaybeExoticIdent ~allowUident:true label;
                args =
                  (* Multiple arguments are represented as a Ttuple, while a single argument is just the type expression itself. *)
                  (match field with
@@ -691,7 +692,7 @@ module Codegen = struct
                    (match c.args with
                    | [] -> None
                    | _ -> Some (any ()))
-                 c.name))
+                 c.displayName))
     | Toption (_, innerType) ->
       let extractedType =
         match innerType with

analysis/src/Utils.ml

@@ -243,3 +243,20 @@ let rec flattenAnyNamespaceInPath path =
       (* Namespaces are in reverse order, so "URL-RescriptBun" where RescriptBun is the namespace. *)
       (parts |> List.rev) @ flattenAnyNamespaceInPath tail
     else head :: flattenAnyNamespaceInPath tail
+
+let printMaybeExoticIdent ?(allowUident = false) txt =
+  let len = String.length txt in
+
+  let rec loop i =
+    if i == len then txt
+    else if i == 0 then
+      match String.unsafe_get txt i with
+      | 'A' .. 'Z' when allowUident -> loop (i + 1)
+      | 'a' .. 'z' | '_' -> loop (i + 1)
+      | _ -> "\"" ^ txt ^ "\""
+    else
+      match String.unsafe_get txt i with
+      | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' -> loop (i + 1)
+      | _ -> "\"" ^ txt ^ "\""
+  in
+  loop 0

analysis/tests/src/CompletionExpressions.res

@@ -262,3 +262,12 @@ let arr = ["hello"]
 
 // arr->Belt.Array.map()
 //                     ^com
+
+type exoticPolyvariant = [#"some exotic"]
+
+let takesExotic = (e: exoticPolyvariant) => {
+  ignore(e)
+}
+
+// takesExotic()
+//             ^com

analysis/tests/src/ExhaustiveSwitch.res

@@ -1,5 +1,5 @@
 type someVariant = One | Two | Three(option<bool>)
-type somePolyVariant = [#one | #two | #three(option<bool>)]
+type somePolyVariant = [#one | #two | #three(option<bool>) | #"exotic ident"]
 
 let withSomeVariant = One
 let withSomePoly: somePolyVariant = #one

analysis/tests/src/expected/CompletionExpressions.res.txt

@@ -1113,3 +1113,22 @@ Path Belt.Array.map
     "insertTextFormat": 2
   }]
 
+Complete src/CompletionExpressions.res 271:15
+posCursor:[271:15] posNoWhite:[271:14] Found expr:[271:3->271:16]
+Pexp_apply ...[271:3->271:14] (...[271:15->271:16])
+Completable: Cexpression CArgument Value[takesExotic]($0)
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath CArgument Value[takesExotic]($0)
+ContextPath Value[takesExotic]
+Path takesExotic
+[{
+    "label": "#\"some exotic\"",
+    "kind": 4,
+    "tags": [],
+    "detail": "#\"some exotic\"\n\n[#\"some exotic\"]",
+    "documentation": null,
+    "insertText": "#\"some exotic\"",
+    "insertTextFormat": 2
+  }]
+

analysis/tests/src/expected/ExhaustiveSwitch.res.txt

@@ -42,7 +42,7 @@ Path withSomePol
     "detail": "insert exhaustive switch for value",
     "documentation": null,
     "filterText": "withSomePoly",
-    "insertText": "withSomePoly {\n   | #one => ${1:failwith(\"todo\")}\n   | #three(_) => ${2:failwith(\"todo\")}\n   | #two => ${3:failwith(\"todo\")}\n   }",
+    "insertText": "withSomePoly {\n   | #one => ${1:failwith(\"todo\")}\n   | #three(_) => ${2:failwith(\"todo\")}\n   | #two => ${3:failwith(\"todo\")}\n   | #\"exotic ident\" => ${4:failwith(\"todo\")}\n   }",
     "insertTextFormat": 2
   }]