Support universal dot completion in editor tooling

analysis/src/Codemod.ml

@@ -41,7 +41,7 @@ let transform ~path ~pos ~debug ~typ ~hint =
         if debug then print_endline "Found no result";
         exit 1
       | Some switchExpr ->
-        printExpr ~range:(Xform.rangeOfLoc switchExpr.pexp_loc) switchExpr)
+        printExpr ~range:(Loc.rangeOfLoc switchExpr.pexp_loc) switchExpr)
     | _ ->
       if debug then print_endline "Mismatch in expected structure";
       exit 1)

analysis/src/CompletionDecorators.ml

@@ -259,6 +259,11 @@ You will need this decorator whenever you want to use a JSX component in ReScrip
 
 [Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#variadic-decorator).|};
       ] );
+    ( "editor.completeFrom",
+      None,
+      [
+        {|The `@editor.completeFrom` decorator instructs the editor where it can draw additional completions from for this type.|};
+      ] );
   ]
 
 let toplevel =

analysis/src/CompletionFrontEnd.ml

@@ -224,19 +224,32 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
       (CPId {path = Utils.flattenLongIdent txt; completionContext = Value; loc})
   | Pexp_field (e1, {txt = Lident name}) -> (
     match exprToContextPath e1 with
-    | Some contextPath -> Some (CPField (contextPath, name))
+    | Some contextPath ->
+      Some
+        (CPField
+           {
+             contextPath;
+             fieldName = name;
+             posOfDot = None;
+             exprLoc = e1.pexp_loc;
+           })
     | _ -> None)
-  | Pexp_field (_, {loc; txt = Ldot (lid, name)}) ->
+  | Pexp_field (e1, {loc; txt = Ldot (lid, name)}) ->
     (* Case x.M.field ignore the x part *)
     Some
       (CPField
-         ( CPId
-             {
-               path = Utils.flattenLongIdent lid;
-               completionContext = Module;
-               loc;
-             },
-           name ))
+         {
+           contextPath =
+             CPId
+               {
+                 path = Utils.flattenLongIdent lid;
+                 completionContext = Module;
+                 loc;
+               };
+           fieldName = name;
+           posOfDot = None;
+           exprLoc = e1.pexp_loc;
+         })
   | Pexp_send (e1, {txt}) -> (
     match exprToContextPath e1 with
     | None -> None
@@ -327,6 +340,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
       Some text.[offsetNoWhite]
     else None
   in
+  let posOfDot = Pos.posOfDot text ~pos:posCursor ~offset in
   let charAtCursor =
     if offset < String.length text then text.[offset] else '\n'
   in
@@ -942,6 +956,32 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
            setResult
              (Completable.CdecoratorPayload
                 (JsxConfig {nested = List.rev nested; prefix})))
+       | _ -> ()
+     else if id.txt = "editor.completeFrom" then
+       match payload with
+       | PStr
+           [
+             {
+               pstr_desc =
+                 Pstr_eval
+                   ( {
+                       pexp_loc;
+                       pexp_desc = Pexp_construct ({txt = path; loc}, None);
+                     },
+                     _ );
+             };
+           ]
+         when locHasCursor pexp_loc ->
+         if Debug.verbose () then
+           print_endline "[decoratorCompletion] Found @editor.completeFrom";
+         setResult
+           (Completable.Cpath
+              (CPId
+                 {
+                   path = Utils.flattenLongIdent path;
+                   completionContext = Module;
+                   loc;
+                 }))
        | _ -> ());
     Ast_iterator.default_iterator.attribute iterator (id, payload)
   in
@@ -1011,6 +1051,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             (Cpath
                (CPPipe
                   {
+                    synthetic = false;
                     contextPath = pipe;
                     id;
                     lhsLoc = lhs.pexp_loc;
@@ -1021,7 +1062,14 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
       | Some (pipe, lhsLoc) ->
         setResult
           (Cpath
-             (CPPipe {contextPath = pipe; id; lhsLoc; inJsx = !inJsxContext}));
+             (CPPipe
+                {
+                  synthetic = false;
+                  contextPath = pipe;
+                  id;
+                  lhsLoc;
+                  inJsx = !inJsxContext;
+                }));
         true
     in
     typedCompletionExpr expr;
@@ -1131,29 +1179,52 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             | Lident name -> (
               match exprToContextPath e with
               | Some contextPath ->
-                let contextPath = Completable.CPField (contextPath, name) in
+                let contextPath =
+                  Completable.CPField
+                    {
+                      contextPath;
+                      fieldName = name;
+                      posOfDot;
+                      exprLoc = e.pexp_loc;
+                    }
+                in
                 setResult (Cpath contextPath)
               | None -> ())
             | Ldot (id, name) ->
               (* Case x.M.field ignore the x part *)
               let contextPath =
                 Completable.CPField
-                  ( CPId
-                      {
-                        loc = fieldName.loc;
-                        path = Utils.flattenLongIdent id;
-                        completionContext = Module;
-                      },
-                    if blankAfterCursor = Some '.' then
-                      (* x.M. field  --->  M. *) ""
-                    else if name = "_" then ""
-                    else name )
+                  {
+                    contextPath =
+                      CPId
+                        {
+                          loc = fieldName.loc;
+                          path = Utils.flattenLongIdent id;
+                          completionContext = Module;
+                        };
+                    fieldName =
+                      (if blankAfterCursor = Some '.' then
+                         (* x.M. field  --->  M. *) ""
+                       else if name = "_" then ""
+                       else name);
+                    posOfDot;
+                    exprLoc = e.pexp_loc;
+                  }
               in
               setResult (Cpath contextPath)
             | Lapply _ -> ()
           else if Loc.end_ e.pexp_loc = posBeforeCursor then
             match exprToContextPath e with
-            | Some contextPath -> setResult (Cpath (CPField (contextPath, "")))
+            | Some contextPath ->
+              setResult
+                (Cpath
+                   (CPField
+                      {
+                        contextPath;
+                        fieldName = "";
+                        posOfDot;
+                        exprLoc = e.pexp_loc;
+                      }))
             | None -> ())
         | Pexp_apply ({pexp_desc = Pexp_ident compName}, args)
           when Res_parsetree_viewer.is_jsx_expression expr ->

analysis/src/DotCompletionUtils.ml

@@ -0,0 +1,42 @@
+let filterRecordFields ~env ~recordAsString ~prefix ~exact fields =
+  fields
+  |> Utils.filterMap (fun (field : SharedTypes.field) ->
+         if Utils.checkName field.fname.txt ~prefix ~exact then
+           Some
+             (SharedTypes.Completion.create field.fname.txt ~env
+                ?deprecated:field.deprecated ~docstring:field.docstring
+                ~kind:(SharedTypes.Completion.Field (field, recordAsString)))
+         else None)
+
+let fieldCompletionsForDotCompletion ?posOfDot typ ~env ~package ~prefix ~exact
+    =
+  let asObject = typ |> TypeUtils.extractObjectType ~env ~package in
+  match asObject with
+  | Some (objEnv, obj) ->
+    (* Handle obj completion via dot *)
+    if Debug.verbose () then
+      Printf.printf "[dot_completion]--> Obj type found:\n";
+    obj |> TypeUtils.getObjFields
+    |> Utils.filterMap (fun (field, _typ) ->
+           if Utils.checkName field ~prefix ~exact then
+             let fullObjFieldName = Printf.sprintf "[\"%s\"]" field in
+             Some
+               (SharedTypes.Completion.create fullObjFieldName ~synthetic:true
+                  ~insertText:fullObjFieldName ~env:objEnv
+                  ~kind:(SharedTypes.Completion.ObjLabel typ)
+                  ?additionalTextEdits:
+                    (match posOfDot with
+                    | None -> None
+                    | Some posOfDot ->
+                      Some
+                        (TypeUtils.makeAdditionalTextEditsForRemovingDot
+                           posOfDot)))
+           else None)
+  | None -> (
+    match typ |> TypeUtils.extractRecordType ~env ~package with
+    | Some (env, fields, typDecl) ->
+      fields
+      |> filterRecordFields ~env ~prefix ~exact
+           ~recordAsString:
+             (typDecl.item.decl |> Shared.declToString typDecl.name.txt)
+    | None -> [])

analysis/src/Loc.ml

@@ -12,3 +12,12 @@ let hasPos ~pos loc = start loc <= pos && pos < end_ loc
 (** Allows the character after the end to be included. Ie when the cursor is at the 
     end of the word, like `someIdentifier<cursor>`. Useful in some scenarios. *)
 let hasPosInclusiveEnd ~pos loc = start loc <= pos && pos <= end_ loc
+
+let mkPosition (pos : Pos.t) =
+  let line, character = pos in
+  {Protocol.line; character}
+
+let rangeOfLoc (loc : t) =
+  let start = loc |> start |> mkPosition in
+  let end_ = loc |> end_ |> mkPosition in
+  {Protocol.start; end_}

analysis/src/PipeCompletionUtils.ml

@@ -0,0 +1,26 @@
+let addJsxCompletionItems ~mainTypeId ~env ~prefix ~(full : SharedTypes.full)
+    ~rawOpens typ =
+  match mainTypeId with
+  | ("array" | "float" | "string" | "int") as builtinNameToComplete ->
+    if Utils.checkName builtinNameToComplete ~prefix ~exact:false then
+      let name =
+        match full.package.genericJsxModule with
+        | None -> "React." ^ builtinNameToComplete
+        | Some g ->
+          g ^ "." ^ builtinNameToComplete
+          |> String.split_on_char '.'
+          |> TypeUtils.removeOpensFromCompletionPath ~rawOpens
+               ~package:full.package
+          |> String.concat "."
+      in
+      [
+        SharedTypes.Completion.create name ~synthetic:true
+          ~includesSnippets:true ~kind:(Value typ) ~env ~sortText:"A"
+          ~docstring:
+            [
+              "Turns `" ^ builtinNameToComplete
+              ^ "` into a JSX element so it can be used inside of JSX.";
+            ];
+      ]
+    else []
+  | _ -> []

analysis/src/Pos.ml

@@ -26,3 +26,19 @@ let positionToOffset text (line, character) =
     else None
 
 let posBeforeCursor pos = (fst pos, max 0 (snd pos - 1))
+
+let posOfDot text ~(pos : int * int) ~offset =
+  let rec loop i =
+    if i < 0 then None
+    else
+      match text.[i] with
+      | '.' -> Some (i + 1)
+      | '\n' -> None
+      | _ -> loop (i - 1)
+  in
+  match loop (offset - 1) with
+  | None -> None
+  | Some offsetBeforeDot ->
+    let line, col = pos in
+    let newCol = max 0 (col - (offset - offsetBeforeDot)) in
+    Some (line, newCol)

analysis/src/ProcessAttributes.ml

@@ -48,3 +48,28 @@ let newDeclared ~item ~extent ~name ~stamp ~modulePath isExported attributes =
       | Some d -> [d]);
     item;
   }
+
+let rec findEditorCompleteFromAttribute ?(modulePaths = []) attributes =
+  let open Parsetree in
+  match attributes with
+  | [] -> modulePaths
+  | ( {Asttypes.txt = "editor.completeFrom"},
+      PStr [{pstr_desc = Pstr_eval (payloadExpr, _)}] )
+    :: rest ->
+    let items =
+      match payloadExpr with
+      | {pexp_desc = Pexp_array items} -> items
+      | p -> [p]
+    in
+    let modulePathsFromArray =
+      items
+      |> List.filter_map (fun item ->
+             match item.Parsetree.pexp_desc with
+             | Pexp_construct ({txt = path}, None) ->
+               Some (Utils.flattenLongIdent path)
+             | _ -> None)
+    in
+    findEditorCompleteFromAttribute
+      ~modulePaths:(modulePathsFromArray @ modulePaths)
+      rest
+  | _ :: rest -> findEditorCompleteFromAttribute ~modulePaths rest