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,101 @@
+let loc_to_string (loc : Warnings.loc) : string =
+  Format.sprintf "(%03d,%03d--%03d,%03d)" loc.loc_start.pos_lnum
+    (loc.loc_start.pos_cnum - loc.loc_start.pos_bol)
+    loc.loc_end.pos_lnum
+    (loc.loc_end.pos_cnum - loc.loc_end.pos_bol)
+
+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));
+    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
+               (loc_to_string t.extentLoc)
+           | KValue t ->
+             Printf.printf "%d kvalue       %s\n" stamp
+               (loc_to_string t.extentLoc)
+           | KModule t ->
+             Printf.printf "%d kmodule      %s\n" stamp
+               (loc_to_string t.extentLoc)
+           | KConstructor t ->
+             Printf.printf "%d kconstructor %s\n" stamp
+               (loc_to_string t.extentLoc));
+
+    (* 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 = 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,37 @@ 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
+         | SharedTypes.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 +498,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 +523,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 +551,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 +1089,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 +1217,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,12 @@ 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_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/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

analysis/src/SharedTypes.ml

@@ -24,6 +24,16 @@ module ModulePath = struct
       | NotVisible -> current
     in
     loop modulePath [tipName]
+
+  let toPathWithPrefix modulePath prefix : path =
+    let rec loop modulePath current =
+      match modulePath with
+      | File _ -> current
+      | IncludedModule (_, inner) -> loop inner current
+      | ExportedModule {name; modulePath = inner} -> loop inner (name :: current)
+      | NotVisible -> current
+    in
+    prefix :: loop modulePath []
 end
 
 type field = {
@@ -155,6 +165,14 @@ module Declared = struct
 end
 
 module Stamps : sig
+  type kind =
+    | KType of Type.t Declared.t
+    | KValue of Types.type_expr Declared.t
+    | KModule of Module.t Declared.t
+    | KConstructor of Constructor.t Declared.t
+
+  val locOfKind : kind -> Warnings.loc
+
   type t
 
   val addConstructor : t -> int -> Constructor.t Declared.t -> unit
@@ -169,6 +187,7 @@ module Stamps : sig
   val iterModules : (int -> Module.t Declared.t -> unit) -> t -> unit
   val iterTypes : (int -> Type.t Declared.t -> unit) -> t -> unit
   val iterValues : (int -> Types.type_expr Declared.t -> unit) -> t -> unit
+  val getEntries : t -> (int * kind) list
 end = struct
   type 't stampMap = (int, 't Declared.t) Hashtbl.t
 
@@ -178,6 +197,12 @@ end = struct
     | KModule of Module.t Declared.t
     | KConstructor of Constructor.t Declared.t
 
+  let locOfKind = function
+    | KType declared -> declared.extentLoc
+    | KValue declared -> declared.extentLoc
+    | KModule declared -> declared.extentLoc
+    | KConstructor declared -> declared.extentLoc
+
   type t = (int, kind) Hashtbl.t
 
   let init () = Hashtbl.create 10
@@ -239,6 +264,8 @@ end = struct
         | KConstructor d -> f stamp d
         | _ -> ())
       stamps
+
+  let getEntries t = t |> Hashtbl.to_seq |> List.of_seq
 end
 
 module File = struct
@@ -773,6 +800,7 @@ module ScopeTypes = struct
     | Open of string list
     | Type of string * Location.t
     | Value of string * Location.t * Completable.contextPath option * item list
+    | Include of string * Location.t
 end
 
 module Completion = struct

analysis/src/TypeUtils.ml

@@ -1,6 +1,20 @@
 open SharedTypes
 
-let modulePathFromEnv env = env.QueryEnv.file.moduleName :: List.rev env.pathRev
+let modulePathFromEnv env =
+  let moduleName = env.QueryEnv.file.moduleName in
+  let transformedModuleName =
+    (* Transform namespaced module names from internal format (Context-Kaplay) 
+       to user-facing format (Kaplay.Context) *)
+    match String.rindex_opt moduleName '-' with
+    | None -> moduleName
+    | Some i ->
+      let namespace =
+        String.sub moduleName (i + 1) (String.length moduleName - i - 1)
+      in
+      let module_ = String.sub moduleName 0 i in
+      namespace ^ "." ^ module_
+  in
+  transformedModuleName :: List.rev env.pathRev
 
 let fullTypeIdFromDecl ~env ~name ~modulePath =
   env.QueryEnv.file.moduleName :: ModulePath.toPath modulePath name