Complete functions from included module

CHANGELOG.md

@@ -37,6 +37,7 @@
 - Improve error message for pipe (`->`) syntax. https://github.com/rescript-lang/rescript/pull/7520
 - Improve a few error messages around various subtyping issues. https://github.com/rescript-lang/rescript/pull/7404
 - Refactor the ast for record expressions and patterns. https://github.com/rescript-lang/rescript/pull/7528
+- Editor: add completions from included modules. https://github.com/rescript-lang/rescript/pull/7515
 
 # 12.0.0-alpha.13
 

analysis/bin/main.ml

@@ -209,6 +209,7 @@ let main () =
   | [_; "format"; path] ->
     Printf.printf "\"%s\"" (Json.escape (Commands.format ~path))
   | [_; "test"; path] -> Commands.test ~path
+  | [_; "cmt"; rescript_json; cmt_path] -> CmtViewer.dump rescript_json cmt_path
   | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help
   | _ ->
     prerr_endline help;

analysis/src/CmtViewer.ml

@@ -0,0 +1,128 @@
+let filter_by_cursor cursor (loc : Warnings.loc) : bool =
+  match cursor with
+  | None -> true
+  | Some (line, col) ->
+    let start = loc.loc_start and end_ = loc.loc_end in
+    let line_in = start.pos_lnum <= line && line <= end_.pos_lnum in
+    let col_in =
+      if start.pos_lnum = end_.pos_lnum then
+        start.pos_cnum - start.pos_bol <= col
+        && col <= end_.pos_cnum - end_.pos_bol
+      else if line = start.pos_lnum then col >= start.pos_cnum - start.pos_bol
+      else if line = end_.pos_lnum then col <= end_.pos_cnum - end_.pos_bol
+      else true
+    in
+    line_in && col_in
+
+type filter = Cursor of (int * int) | Loc of Loc.t
+
+let dump ?filter rescript_json cmt_path =
+  let uri = Uri.fromPath (Filename.remove_extension cmt_path ^ ".res") in
+  let package =
+    let uri = Uri.fromPath rescript_json in
+    Packages.getPackage ~uri |> Option.get
+  in
+  let moduleName =
+    BuildSystem.namespacedName package.namespace (FindFiles.getName cmt_path)
+  in
+  match Cmt.fullForCmt ~moduleName ~package ~uri cmt_path with
+  | None -> failwith (Format.sprintf "Could not load cmt for %s" cmt_path)
+  | Some full ->
+    let open SharedTypes in
+    let open SharedTypes.Stamps in
+    let applyFilter =
+      match filter with
+      | None -> fun _ -> true
+      | Some (Cursor cursor) -> Loc.hasPos ~pos:cursor
+      | Some (Loc loc) -> Loc.isInside loc
+    in
+    (match filter with
+    | None -> ()
+    | Some (Cursor (line, col)) ->
+      Printf.printf "Filtering by cursor %d,%d\n" line col
+    | Some (Loc loc) -> Printf.printf "Filtering by loc %s\n" (Loc.toString loc));
+
+    Printf.printf "file moduleName: %s\n\n" full.file.moduleName;
+
+    let stamps =
+      full.file.stamps |> getEntries
+      |> List.filter (fun (_, stamp) -> applyFilter (locOfKind stamp))
+    in
+
+    let total_stamps = List.length stamps in
+    Printf.printf "Found %d stamps:\n%s" total_stamps
+      (if total_stamps > 0 then "\n" else "");
+
+    stamps
+    |> List.sort (fun (_, a) (_, b) ->
+           let aLoc = locOfKind a in
+           let bLoc = locOfKind b in
+           match compare aLoc.loc_start.pos_lnum bLoc.loc_start.pos_lnum with
+           | 0 -> compare aLoc.loc_start.pos_cnum bLoc.loc_start.pos_cnum
+           | c -> c)
+    |> List.iter (fun (stamp, kind) ->
+           match kind with
+           | KType t ->
+             Printf.printf "%d ktype        %s\n" stamp
+               (Warnings.loc_to_string t.extentLoc)
+           | KValue t ->
+             Printf.printf "%d kvalue       %s\n" stamp
+               (Warnings.loc_to_string t.extentLoc)
+           | KModule t ->
+             Printf.printf "%d kmodule      %s\n" stamp
+               (Warnings.loc_to_string t.extentLoc)
+           | KConstructor t ->
+             Printf.printf "%d kconstructor %s\n" stamp
+               (Warnings.loc_to_string t.extentLoc));
+
+    (* dump the structure *)
+    let rec dump_structure indent (structure : Module.structure) =
+      if indent > 0 then Printf.printf "%s" (String.make indent ' ');
+      Printf.printf "Structure %s:\n" structure.name;
+      structure.items |> List.iter (dump_structure_item (indent + 2))
+    and dump_structure_item indent item =
+      if indent > 0 then Printf.printf "%s" (String.make indent ' ');
+      let open Module in
+      match item.kind with
+      | Value _typedExpr ->
+        Printf.printf "Value %s %s\n" item.name
+          (Warnings.loc_to_string item.loc)
+      | Type _ ->
+        Printf.printf "Type %s %s\n" item.name (Warnings.loc_to_string item.loc)
+      | Module {type_ = m} ->
+        Printf.printf "Module %s %s\n" item.name
+          (Warnings.loc_to_string item.loc);
+        dump_module indent m
+    and dump_module indent (module_ : Module.t) =
+      match module_ with
+      | Ident path -> Printf.printf "Module (Ident) %s\n" (Path.to_string path)
+      | Structure structure -> dump_structure indent structure
+      | Constraint (m1, m2) ->
+        dump_module indent m1;
+        dump_module indent m2
+    in
+
+    print_newline ();
+    dump_structure 0 full.file.structure;
+
+    (* Dump all locItems (typed nodes) *)
+    let locItems =
+      match full.extra with
+      | {locItems} ->
+        locItems |> List.filter (fun locItem -> applyFilter locItem.loc)
+    in
+
+    Printf.printf "\nFound %d locItems (typed nodes):\n\n"
+      (List.length locItems);
+
+    locItems
+    |> List.sort (fun a b ->
+           let aLoc = a.loc.Location.loc_start in
+           let bLoc = b.loc.Location.loc_start in
+           match compare aLoc.pos_lnum bLoc.pos_lnum with
+           | 0 -> compare aLoc.pos_cnum bLoc.pos_cnum
+           | c -> c)
+    |> List.iter (fun {loc; locType} ->
+           let locStr = Warnings.loc_to_string loc in
+           let kindStr = SharedTypes.locTypeToString locType in
+           Printf.printf "%s %s\n" locStr kindStr)

analysis/src/CompletionBackEnd.ml

@@ -451,6 +451,52 @@ let processLocalModule name loc ~prefix ~exact ~env
         (Printf.sprintf "Completion Module Not Found %s loc:%s\n" name
            (Loc.toString loc))
 
+let processLocalInclude includePath _loc ~prefix ~exact ~(env : QueryEnv.t)
+    ~(localTables : LocalTables.t) =
+  (* process only values for now *)
+  localTables.valueTable
+  |> Hashtbl.iter (fun (name, _) (declared : Types.type_expr Declared.t) ->
+         (* We check all the values if their origin is the same as the include path. *)
+         match declared.modulePath with
+         | ModulePath.ExportedModule {name = exportedName}
+           when exportedName = includePath ->
+           if Utils.checkName name ~prefix ~exact then
+             if not (Hashtbl.mem localTables.namesUsed name) then (
+               Hashtbl.add localTables.namesUsed name ();
+               localTables.resultRev <-
+                 {
+                   (Completion.create declared.name.txt ~env
+                      ~kind:(Value declared.item))
+                   with
+                   deprecated = declared.deprecated;
+                   docstring = declared.docstring;
+                   synthetic = true;
+                 }
+                 :: localTables.resultRev)
+         | ModulePath.IncludedModule (source, _) ->
+           let source_module_path =
+             match Path.flatten source with
+             | `Contains_apply -> ""
+             | `Ok (ident, path) -> ident.name :: path |> String.concat "."
+           in
+
+           if String.ends_with ~suffix:includePath source_module_path then
+             (* If this is the case we perform a similar check for the prefix *)
+             if Utils.checkName name ~prefix ~exact then
+               if not (Hashtbl.mem localTables.namesUsed name) then (
+                 Hashtbl.add localTables.namesUsed name ();
+                 localTables.resultRev <-
+                   {
+                     (Completion.create declared.name.txt ~env
+                        ~kind:(Value declared.item))
+                     with
+                     deprecated = declared.deprecated;
+                     docstring = declared.docstring;
+                     synthetic = true;
+                   }
+                   :: localTables.resultRev)
+         | _ -> ())
+
 let getItemsFromOpens ~opens ~localTables ~prefix ~exact ~completionContext =
   opens
   |> List.fold_left
@@ -467,6 +513,7 @@ let findLocalCompletionsForValuesAndConstructors ~(localTables : LocalTables.t)
   localTables |> LocalTables.populateValues ~env;
   localTables |> LocalTables.populateConstructors ~env;
   localTables |> LocalTables.populateModules ~env;
+
   scope
   |> Scope.iterValuesBeforeFirstOpen
        (processLocalValue ~prefix ~exact ~env ~localTables);
@@ -491,6 +538,10 @@ let findLocalCompletionsForValuesAndConstructors ~(localTables : LocalTables.t)
   scope
   |> Scope.iterModulesAfterFirstOpen
        (processLocalModule ~prefix ~exact ~env ~localTables);
+
+  scope
+  |> Scope.iterIncludes (processLocalInclude ~prefix ~exact ~env ~localTables);
+
   List.rev_append localTables.resultRev valuesFromOpens
 
 let findLocalCompletionsForValues ~(localTables : LocalTables.t) ~env ~prefix
@@ -515,6 +566,10 @@ let findLocalCompletionsForValues ~(localTables : LocalTables.t) ~env ~prefix
   scope
   |> Scope.iterModulesAfterFirstOpen
        (processLocalModule ~prefix ~exact ~env ~localTables);
+
+  scope
+  |> Scope.iterIncludes (processLocalInclude ~prefix ~exact ~env ~localTables);
+
   List.rev_append localTables.resultRev valuesFromOpens
 
 let findLocalCompletionsForTypes ~(localTables : LocalTables.t) ~env ~prefix
@@ -1049,6 +1104,8 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
     | None -> [])
   | CPPipe {contextPath = cp; id = prefix; lhsLoc; inJsx; synthetic} -> (
     if Debug.verbose () then print_endline "[ctx_path]--> CPPipe";
+    (* The environment at the cursor is the environment we're completing from. *)
+    let env_at_cursor = env in
     match
       cp
       |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env
@@ -1175,8 +1232,8 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
         in
         (* Add completions from the current module. *)
         let currentModuleCompletions =
-          completionsForPipeFromCompletionPath ~envCompletionIsMadeFrom
-            ~opens:[] ~pos ~scope ~debug ~prefix ~env ~rawOpens ~full []
+          getCompletionsForPath ~debug ~completionContext:Value ~exact:false
+            ~opens:[] ~full ~pos ~env:env_at_cursor ~scope [prefix]
           |> TypeUtils.filterPipeableFunctions ~synthetic:true ~env ~full
                ~targetTypeId:mainTypeId
         in

analysis/src/CompletionFrontEnd.ml

@@ -743,6 +743,13 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
       mbs |> List.iter scopeModuleBinding;
       mbs |> List.iter (fun b -> iterator.module_binding iterator b);
       processed := true
+    | Pstr_include {pincl_mod = {pmod_desc = med}} -> (
+      match med with
+      | Pmod_ident {txt = lid; loc}
+      | Pmod_apply ({pmod_desc = Pmod_ident {txt = lid; loc}}, _) ->
+        let module_name = Longident.flatten lid |> String.concat "." in
+        scope := !scope |> Scope.addInclude ~name:module_name ~loc
+      | _ -> ())
     | _ -> ());
     if not !processed then
       Ast_iterator.default_iterator.structure_item iterator item

analysis/src/Completions.ml

@@ -9,6 +9,14 @@ let getCompletions ~debug ~path ~pos ~currentFile ~forHover =
     with
     | None -> None
     | Some (completable, scope) -> (
+      (* uncomment when debugging *)
+      if false then (
+        Printf.printf "\nScope from frontend:\n";
+        List.iter
+          (fun item ->
+            Printf.printf "%s\n" (SharedTypes.ScopeTypes.item_to_string item))
+          scope;
+        print_newline ());
       (* Only perform expensive ast operations if there are completables *)
       match Cmt.loadFullCmtFromPath ~path with
       | None -> None

analysis/src/Loc.ml

@@ -21,3 +21,9 @@ let rangeOfLoc (loc : t) =
   let start = loc |> start |> mkPosition in
   let end_ = loc |> end_ |> mkPosition in
   {Protocol.start; end_}
+
+let isInside (x : t) (y : t) =
+  x.loc_start.pos_cnum >= y.loc_start.pos_cnum
+  && x.loc_end.pos_cnum <= y.loc_end.pos_cnum
+  && x.loc_start.pos_lnum >= y.loc_start.pos_lnum
+  && x.loc_end.pos_lnum <= y.loc_end.pos_lnum

analysis/src/Scope.ml

@@ -14,6 +14,7 @@ let itemToString item =
   | Module (s, loc) -> "Module " ^ s ^ " " ^ Loc.toString loc
   | Value (s, loc, _, _) -> "Value " ^ s ^ " " ^ Loc.toString loc
   | Type (s, loc) -> "Type " ^ s ^ " " ^ Loc.toString loc
+  | Include (s, loc) -> "Include " ^ s ^ " " ^ Loc.toString loc
 [@@live]
 
 let create () : t = []
@@ -32,6 +33,7 @@ let addValue ~name ~loc ?contextPath x =
            (SharedTypes.Completable.contextPathToString contextPath));
   Value (name, loc, contextPath, x) :: x
 let addType ~name ~loc x = Type (name, loc) :: x
+let addInclude ~name ~loc x = Include (name, loc) :: x
 
 let iterValuesBeforeFirstOpen f x =
   let rec loop items =
@@ -129,6 +131,17 @@ let iterModulesAfterFirstOpen f x =
   in
   loop false x
 
+let iterIncludes f x =
+  let rec loop items =
+    match items with
+    | [] -> ()
+    | Include (s, loc) :: rest ->
+      f s loc;
+      loop rest
+    | _ :: rest -> loop rest
+  in
+  loop x
+
 let getRawOpens x =
   x
   |> Utils.filterMap (function