Add path to QueryEnv and remove it from Completion.

Author: cristianoc

analysis/src/CompletionBackEnd.ml

@@ -562,7 +562,6 @@ let completionForExporteds iterExported getDeclared ~prefix ~exact ~env
               with
               deprecated = declared.deprecated;
               docstring = declared.docstring;
-              modulePath = declared.modulePath;
             }
             :: !res
         | _ -> ());
@@ -1153,12 +1152,9 @@ let completionToItem {Completion.name; deprecated; docstring; kind} =
     ~deprecated ~detail:(detail name kind) ~docstring
 
 let completionsGetTypeEnv = function
-  | {Completion.kind = Value typ; env; modulePath} :: _ ->
-    Some (typ, env, modulePath)
-  | {Completion.kind = ObjLabel typ; env; modulePath} :: _ ->
-    Some (typ, env, modulePath)
-  | {Completion.kind = Field ({typ}, _); env; modulePath} :: _ ->
-    Some (typ, env, modulePath)
+  | {Completion.kind = Value typ; env} :: _ -> Some (typ, env)
+  | {Completion.kind = ObjLabel typ; env} :: _ -> Some (typ, env)
+  | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (typ, env)
   | _ -> None
 
 let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
@@ -1189,7 +1185,7 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
            ~env ~exact:true ~scope
       |> completionsGetTypeEnv
     with
-    | Some (typ, env, modulePath) -> (
+    | Some (typ, env) -> (
       let rec reconstructFunctionType args tRet =
         match args with
         | [] -> tRet
@@ -1220,10 +1216,7 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
       | args, tRet when args <> [] ->
         let args = processApply args labels in
         let retType = reconstructFunctionType args tRet in
-        [
-          Completion.createWithModulePath ~name:"dummy" ~env
-            ~kind:(Completion.Value retType) ~modulePath;
-        ]
+        [Completion.create ~name:"dummy" ~env ~kind:(Completion.Value retType)]
       | _ -> [])
     | None -> [])
   | CPField (CPId (path, Module), fieldName) ->
@@ -1238,20 +1231,19 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
            ~env ~exact:true ~scope
       |> completionsGetTypeEnv
     with
-    | Some (typ, env, modulePath) -> (
+    | Some (typ, env) -> (
       match typ |> extractRecordType ~env ~package with
       | Some (env, fields, typDecl) ->
         fields
         |> Utils.filterMap (fun field ->
                if checkName field.fname.txt ~prefix:fieldName ~exact then
                  Some
-                   (Completion.createWithModulePath ~name:field.fname.txt ~env
+                   (Completion.create ~name:field.fname.txt ~env
                       ~kind:
                         (Completion.Field
                            ( field,
                              typDecl.item.decl
-                             |> Shared.declToString typDecl.name.txt ))
-                      ~modulePath)
+                             |> Shared.declToString typDecl.name.txt )))
                else None)
       | None -> [])
     | None -> [])
@@ -1262,7 +1254,7 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
            ~env ~exact:true ~scope
       |> completionsGetTypeEnv
     with
-    | Some (typ, env, modulePath) -> (
+    | Some (typ, env) -> (
       match typ |> extractObjectType ~env ~package with
       | Some (env, tObj) ->
         let rec getFields (texp : Types.type_expr) =
@@ -1278,8 +1270,8 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
         |> Utils.filterMap (fun (field, typ) ->
                if checkName field ~prefix:label ~exact then
                  Some
-                   (Completion.createWithModulePath ~name:field ~env
-                      ~kind:(Completion.ObjLabel typ) ~modulePath)
+                   (Completion.create ~name:field ~env
+                      ~kind:(Completion.ObjLabel typ))
                else None)
       | None -> [])
     | None -> [])
@@ -1290,7 +1282,7 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
            ~env ~exact:true ~scope
       |> completionsGetTypeEnv
     with
-    | Some (typ, _envFromCompletionItem, completionItemModulePath) -> (
+    | Some (typ, envFromCompletionItem) -> (
       let {
         arrayModulePath;
         optionModulePath;
@@ -1360,15 +1352,15 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
               (* Assume a non-empty type path is coming from the compiler and
                  can be used as-is. *)
               Some (List.rev rest)
-            | _ -> (
-              (* Module paths coming directly from a completion item is prefixed with
-                 file module name it was found in. We pluck that off here if the env
-                  we're in is the same as the completion item was found in. This ensures
-                 that a correct qualified path can be produced. *)
-              match ModulePath.toFullPath completionItemModulePath with
-              | topModule :: rest when topModule = env.file.moduleName ->
-                Some rest
-              | path -> Some path)))
+            | _ ->
+              (* Get the path from the comletion environment *)
+              let pathFromEnv =
+                let path = envFromCompletionItem.path in
+                if env.file.moduleName = envFromCompletionItem.file.moduleName
+                then path
+                else envFromCompletionItem.file.moduleName :: path
+              in
+              Some pathFromEnv))
         | None -> None
       in
       match completionPath with
@@ -1457,7 +1449,7 @@ let processCompletable ~debug ~package ~scope ~env ~pos ~forHover
   | Cjsx (componentPath, prefix, identsSeen) ->
     let labels =
       match componentPath @ ["make"] |> findTypeOfValue with
-      | Some (typ, make_env, _) ->
+      | Some (typ, make_env) ->
         let rec getFieldsV3 (texp : Types.type_expr) =
           match texp.desc with
           | Tfield (name, _, t1, t2) ->
@@ -1793,7 +1785,7 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
              ~env ~exact:true ~scope
         |> completionsGetTypeEnv
       with
-      | Some (typ, _env, _) ->
+      | Some (typ, _env) ->
         if debug then
           Printf.printf "Found type for function %s\n"
             (typ |> Shared.typeToString);

analysis/src/Hover.ml

@@ -152,7 +152,7 @@ let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover
           Some (Protocol.stringifyHover (String.concat "\n\n" parts))
         | _ -> (
           match CompletionBackEnd.completionsGetTypeEnv completions with
-          | Some (typ, _env, _) ->
+          | Some (typ, _env) ->
             let typeString, _docstring =
               hoverWithExpandedTypes ~docstring:"" ~file ~package
                 ~supportsMarkdownLinks typ

analysis/src/ProcessCmt.ml

@@ -104,33 +104,34 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
     in
     [{Module.kind = Type (declared.item, recStatus); name = declared.name.txt}]
   | Sig_module (ident, {md_type; md_attributes; md_loc}, _) ->
+    let name = Ident.name ident in
     let declared =
       addDeclared ~extent:md_loc
-        ~item:(forTypeModule env md_type)
-        ~name:(Location.mkloc (Ident.name ident) md_loc)
+        ~item:(forTypeModule ~name ~env md_type)
+        ~name:(Location.mkloc name md_loc)
         ~stamp:(Ident.binding_time ident) ~env md_attributes
         (Exported.add exported Exported.Module)
         Stamps.addModule
     in
     [{Module.kind = Module declared.item; name = declared.name.txt}]
   | _ -> []
 
-and forTypeSignature env signature =
+and forTypeSignature ~name ~env signature =
   let exported = Exported.init () in
   let items =
     List.fold_right
       (fun item items -> forTypeSignatureItem ~env ~exported item @ items)
       signature []
   in
-  {Module.docstring = []; exported; items}
+  {Module.name; docstring = []; exported; items}
 
-and forTypeModule env moduleType =
+and forTypeModule ~name ~env moduleType =
   match moduleType with
   | Types.Mty_ident path -> Ident path
   | Mty_alias (_ (* 402 *), path) -> Ident path
-  | Mty_signature signature -> Structure (forTypeSignature env signature)
+  | Mty_signature signature -> Structure (forTypeSignature ~name ~env signature)
   | Mty_functor (_argIdent, _argType, resultType) ->
-    forTypeModule env resultType
+    forTypeModule ~name ~env resultType
 
 let getModuleTypePath mod_desc =
   match mod_desc with
@@ -249,7 +250,11 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
            decl |> forTypeDeclaration ~env ~exported ~recStatus)
   | Tsig_module
       {md_id; md_attributes; md_loc; md_name = name; md_type = {mty_type}} ->
-    let item = forTypeModule (env |> Env.addModule ~name:name.txt) mty_type in
+    let item =
+      forTypeModule ~name:name.txt
+        ~env:(env |> Env.addModule ~name:name.txt)
+        mty_type
+    in
     let declared =
       addDeclared ~item ~name ~extent:md_loc ~stamp:(Ident.binding_time md_id)
         ~env md_attributes
@@ -279,7 +284,7 @@ let rec forSignatureItem ~env ~(exported : Exported.t)
   (* TODO: process other things here *)
   | _ -> []
 
-let forSignature ~env sigItems =
+let forSignature ~name ~env sigItems =
   let exported = Exported.init () in
   let items =
     sigItems |> List.map (forSignatureItem ~env ~exported) |> List.flatten
@@ -294,13 +299,13 @@ let forSignature ~env sigItems =
     | None -> []
     | Some d -> [d]
   in
-  {Module.docstring; exported; items}
+  {Module.name; docstring; exported; items}
 
-let forTreeModuleType ~env {Typedtree.mty_desc} =
+let forTreeModuleType ~name ~env {Typedtree.mty_desc} =
   match mty_desc with
   | Tmty_ident _ -> None
   | Tmty_signature {sig_items} ->
-    let contents = forSignature ~env sig_items in
+    let contents = forSignature ~name ~env sig_items in
     Some (Module.Structure contents)
   | _ -> None
 
@@ -352,7 +357,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
            (String.length name.txt >= 6
            && (String.sub name.txt 0 6 = "local_") [@doesNotRaise])
          (* %%private generates a dummy module called local_... *) ->
-    let item = forModule env mod_desc name.txt in
+    let item = forModule ~env mod_desc name.txt in
     let declared =
       addDeclared ~item ~name ~extent:mb_loc ~stamp:(Ident.binding_time mb_id)
         ~env mb_attributes
@@ -375,7 +380,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
         mtd_loc;
       } ->
     let env = env |> Env.addModuleType ~name:name.txt in
-    let modTypeItem = forTypeModule env modType in
+    let modTypeItem = forTypeModule ~name:name.txt ~env modType in
     let declared =
       addDeclared ~item:modTypeItem ~name ~extent:mtd_loc
         ~stamp:(Ident.binding_time mtd_id)
@@ -418,18 +423,18 @@ let rec forStructureItem ~env ~(exported : Exported.t) item =
            decl |> forTypeDeclaration ~env ~exported ~recStatus)
   | _ -> []
 
-and forModule env mod_desc moduleName =
+and forModule ~env mod_desc moduleName =
   match mod_desc with
   | Tmod_ident (path, _lident) -> Ident path
   | Tmod_structure structure ->
     let env = env |> Env.addModule ~name:moduleName in
-    let contents = forStructure ~env structure.str_items in
+    let contents = forStructure ~name:moduleName ~env structure.str_items in
     Structure contents
   | Tmod_functor (ident, argName, maybeType, resultExpr) ->
     (match maybeType with
     | None -> ()
     | Some t -> (
-      match forTreeModuleType ~env t with
+      match forTreeModuleType ~name:argName.txt ~env t with
       | None -> ()
       | Some kind ->
         let stamp = Ident.binding_time ident in
@@ -438,20 +443,20 @@ and forModule env mod_desc moduleName =
             ~extent:t.Typedtree.mty_loc ~stamp ~modulePath:NotVisible false []
         in
         Stamps.addModule env.stamps stamp declared));
-    forModule env resultExpr.mod_desc moduleName
+    forModule ~env resultExpr.mod_desc moduleName
   | Tmod_apply (functor_, _arg, _coercion) ->
-    forModule env functor_.mod_desc moduleName
+    forModule ~env functor_.mod_desc moduleName
   | Tmod_unpack (_expr, moduleType) ->
     let env = env |> Env.addModule ~name:moduleName in
-    forTypeModule env moduleType
+    forTypeModule ~name:moduleName ~env moduleType
   | Tmod_constraint (expr, typ, _constraint, _coercion) ->
     (* TODO do this better I think *)
-    let modKind = forModule env expr.mod_desc moduleName in
+    let modKind = forModule ~env expr.mod_desc moduleName in
     let env = env |> Env.addModule ~name:moduleName in
-    let modTypeKind = forTypeModule env typ in
+    let modTypeKind = forTypeModule ~name:moduleName ~env typ in
     Constraint (modKind, modTypeKind)
 
-and forStructure ~env strItems =
+and forStructure ~name ~env strItems =
   let exported = Exported.init () in
   let items =
     List.fold_right
@@ -468,7 +473,7 @@ and forStructure ~env strItems =
     | None -> []
     | Some d -> [d]
   in
-  {docstring; exported; items}
+  {Module.name; docstring; exported; items}
 
 let fileForCmtInfos ~moduleName ~uri
     ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) =
@@ -486,7 +491,7 @@ let fileForCmtInfos ~moduleName ~uri
              | _ -> None)
       |> List.concat
     in
-    let structure = forStructure ~env items in
+    let structure = forStructure ~name:moduleName ~env items in
     {File.uri; moduleName = cmt_modname; stamps = env.stamps; structure}
   | Partial_interface parts ->
     let items =
@@ -498,13 +503,13 @@ let fileForCmtInfos ~moduleName ~uri
              | _ -> None)
       |> List.concat
     in
-    let structure = forSignature ~env items in
+    let structure = forSignature ~name:moduleName ~env items in
     {uri; moduleName = cmt_modname; stamps = env.stamps; structure}
   | Implementation structure ->
-    let structure = forStructure ~env structure.str_items in
+    let structure = forStructure ~name:moduleName ~env structure.str_items in
     {uri; moduleName = cmt_modname; stamps = env.stamps; structure}
   | Interface signature ->
-    let structure = forSignature ~env signature.sig_items in
+    let structure = forSignature ~name:moduleName ~env signature.sig_items in
     {uri; moduleName = cmt_modname; stamps = env.stamps; structure}
   | _ -> File.create moduleName uri
 

analysis/src/ResolvePath.ml

@@ -46,7 +46,8 @@ and resolvePathInner ~(env : QueryEnv.t) ~path =
 
 and findInModule ~(env : QueryEnv.t) module_ path =
   match module_ with
-  | Structure {exported} -> resolvePathInner ~env:{env with exported} ~path
+  | Structure structure ->
+    resolvePathInner ~env:(QueryEnv.enterStructure env structure) ~path
   | Constraint (_, module1) -> findInModule ~env module1 path
   | Ident modulePath -> (
     let stamp, moduleName, fullPath = joinPaths modulePath path in