Support completions and better hovers for first class modules

CHANGELOG.md

@@ -20,6 +20,7 @@
 
 - Add markdown divider between module doc and module type in hover information. https://github.com/rescript-lang/rescript/pull/7775
 - Show docstrings before type expansions on hover. https://github.com/rescript-lang/rescript/pull/7774
+- Autocomplete (and improved hovers) for first-class module unpacks. https://github.com/rescript-lang/rescript/pull/7780
 
 #### :bug: Bug fix
 

analysis/src/CompletionBackEnd.ml

@@ -173,24 +173,71 @@ let findModuleInScope ~env ~moduleName ~scope =
   scope |> Scope.iterModulesAfterFirstOpen processModule;
   !result
 
+let rec moduleItemToStructureEnv ~(env : QueryEnv.t) ~package (item : Module.t)
+    =
+  match item with
+  | Module.Structure structure -> Some (env, structure)
+  | Module.Constraint (_, moduleType) ->
+    moduleItemToStructureEnv ~env ~package moduleType
+  | Module.Ident p -> (
+    match ResolvePath.resolveModuleFromCompilerPath ~env ~package p with
+    | Some (env2, Some declared2) ->
+      moduleItemToStructureEnv ~env:env2 ~package declared2.item
+    | _ -> None)
+
+(* Given a declared module, return the env entered into its concrete structure
+   and the structure itself. Follows constraints and aliases *)
+let enterStructureFromDeclared ~(env : QueryEnv.t) ~package
+    (declared : Module.t Declared.t) =
+  match moduleItemToStructureEnv ~env ~package declared.item with
+  | Some (env, s) -> Some (QueryEnv.enterStructure env s, s)
+  | None -> None
+
+let completionsFromStructureItems ~(env : QueryEnv.t)
+    (structure : Module.structure) =
+  StructureUtils.unique_items structure
+  |> List.filter_map (fun (it : Module.item) ->
+         match it.kind with
+         | Module.Value typ ->
+           Some
+             (Completion.create ~env ~docstring:it.docstring
+                ~kind:(Completion.Value typ) it.name)
+         | Module.Module {type_ = m} ->
+           Some
+             (Completion.create ~env ~docstring:it.docstring
+                ~kind:
+                  (Completion.Module {docstring = it.docstring; module_ = m})
+                it.name)
+         | Module.Type (t, _recStatus) ->
+           Some
+             (Completion.create ~env ~docstring:it.docstring
+                ~kind:(Completion.Type t) it.name))
+
 let resolvePathFromStamps ~(env : QueryEnv.t) ~package ~scope ~moduleName ~path
     =
   (* Log.log("Finding from stamps " ++ name); *)
   match findModuleInScope ~env ~moduleName ~scope with
   | None -> None
   | Some declared -> (
     (* Log.log("found it"); *)
-    match ResolvePath.findInModule ~env declared.item path with
-    | None -> None
-    | Some res -> (
-      match res with
-      | `Local (env, name) -> Some (env, name)
-      | `Global (moduleName, fullPath) -> (
-        match ProcessCmt.fileForModule ~package moduleName with
-        | None -> None
-        | Some file ->
-          ResolvePath.resolvePath ~env:(QueryEnv.fromFile file) ~path:fullPath
-            ~package)))
+    (* [""] means completion after `ModuleName.` (trailing dot). *)
+    match path with
+    | [""] -> (
+      match moduleItemToStructureEnv ~env ~package declared.item with
+      | Some (env, structure) -> Some (QueryEnv.enterStructure env structure, "")
+      | None -> None)
+    | _ -> (
+      match ResolvePath.findInModule ~env declared.item path with
+      | None -> None
+      | Some res -> (
+        match res with
+        | `Local (env, name) -> Some (env, name)
+        | `Global (moduleName, fullPath) -> (
+          match ProcessCmt.fileForModule ~package moduleName with
+          | None -> None
+          | Some file ->
+            ResolvePath.resolvePath ~env:(QueryEnv.fromFile file) ~path:fullPath
+              ~package))))
 
 let resolveModuleWithOpens ~opens ~package ~moduleName =
   let rec loop opens =
@@ -219,12 +266,17 @@ let getEnvWithOpens ~scope ~(env : QueryEnv.t) ~package
   match resolvePathFromStamps ~env ~scope ~moduleName ~path ~package with
   | Some x -> Some x
   | None -> (
-    match resolveModuleWithOpens ~opens ~package ~moduleName with
-    | Some env -> ResolvePath.resolvePath ~env ~package ~path
-    | None -> (
-      match resolveFileModule ~moduleName ~package with
-      | None -> None
-      | Some env -> ResolvePath.resolvePath ~env ~package ~path))
+    let env_opt =
+      match resolveModuleWithOpens ~opens ~package ~moduleName with
+      | Some envOpens -> Some envOpens
+      | None -> resolveFileModule ~moduleName ~package
+    in
+    match env_opt with
+    | None -> None
+    | Some env -> (
+      match path with
+      | [""] -> Some (env, "")
+      | _ -> ResolvePath.resolvePath ~env ~package ~path))
 
 let rec expandTypeExpr ~env ~package typeExpr =
   match typeExpr |> Shared.digConstructor with
@@ -662,14 +714,47 @@ let getCompletionsForPath ~debug ~opens ~full ~pos ~exact ~scope
     localCompletionsWithOpens @ fileModules
   | moduleName :: path -> (
     Log.log ("Path " ^ pathToString path);
-    match
-      getEnvWithOpens ~scope ~env ~package:full.package ~opens ~moduleName path
-    with
-    | Some (env, prefix) ->
-      Log.log "Got the env";
-      let namesUsed = Hashtbl.create 10 in
-      findAllCompletions ~env ~prefix ~exact ~namesUsed ~completionContext
-    | None -> [])
+    (* [""] is trailing dot completion (`ModuleName.<com>`). *)
+    match path with
+    | [""] -> (
+      let envFile = env in
+      let declaredOpt =
+        match findModuleInScope ~env:envFile ~moduleName ~scope with
+        | Some d -> Some d
+        | None -> (
+          match Exported.find envFile.exported Exported.Module moduleName with
+          | Some stamp -> Stamps.findModule envFile.file.stamps stamp
+          | None -> None)
+      in
+      match declaredOpt with
+      | Some (declared : Module.t Declared.t) when declared.isExported = false
+        -> (
+        match
+          enterStructureFromDeclared ~env:envFile ~package:full.package declared
+        with
+        | None -> []
+        | Some (envInModule, structure) ->
+          completionsFromStructureItems ~env:envInModule structure)
+      | _ -> (
+        match
+          getEnvWithOpens ~scope ~env ~package:full.package ~opens ~moduleName
+            path
+        with
+        | Some (env, prefix) ->
+          Log.log "Got the env";
+          let namesUsed = Hashtbl.create 10 in
+          findAllCompletions ~env ~prefix ~exact ~namesUsed ~completionContext
+        | None -> []))
+    | _ -> (
+      match
+        getEnvWithOpens ~scope ~env ~package:full.package ~opens ~moduleName
+          path
+      with
+      | Some (env, prefix) ->
+        Log.log "Got the env";
+        let namesUsed = Hashtbl.create 10 in
+        findAllCompletions ~env ~prefix ~exact ~namesUsed ~completionContext
+      | None -> []))
 
 (** Completions intended for piping, from a completion path. *)
 let completionsForPipeFromCompletionPath ~envCompletionIsMadeFrom ~opens ~pos

analysis/src/CompletionFrontEnd.ml

@@ -538,8 +538,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
         p
     | Ppat_type _ -> ()
     | Ppat_unpack {txt; loc} ->
-      scope :=
-        !scope |> Scope.addValue ~name:txt ~loc ?contextPath:contextPathToSave
+      scope := !scope |> Scope.addModule ~name:txt ~loc
     | Ppat_exception p -> scopePattern ~patternPath ?contextPath p
     | Ppat_extension _ -> ()
     | Ppat_open (_, p) -> scopePattern ~patternPath ?contextPath p

analysis/src/Hover.ml

@@ -287,16 +287,29 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
          | Const_int32 _ -> "int32"
          | Const_int64 _ -> "int64"
          | Const_bigint _ -> "bigint"))
-  | Typed (_, t, locKind) ->
+  | Typed (_, t, locKind) -> (
     let fromType ?docstring ?constructor typ =
       hoverWithExpandedTypes ~file ~package ~supportsMarkdownLinks ?docstring
         ?constructor typ
     in
-    Some
-      (match References.definedForLoc ~file ~package locKind with
-      | None -> t |> fromType
-      | Some (docstring, res) -> (
-        match res with
-        | `Declared | `Field -> t |> fromType ~docstring
-        | `Constructor constructor ->
-          t |> fromType ~docstring:constructor.docstring ~constructor))
+    (* Expand first-class modules to the underlying module type signature. *)
+    let t = Shared.dig t in
+    match t.desc with
+    | Tpackage (path, _lids, _tys) -> (
+      let env = QueryEnv.fromFile file in
+      match ResolvePath.resolveModuleFromCompilerPath ~env ~package path with
+      | None -> Some (fromType t)
+      | Some (envForModule, Some declared) ->
+        let name = Path.name path in
+        showModule ~docstring:declared.docstring ~name ~file:envForModule.file
+          ~package (Some declared)
+      | Some (_, None) -> Some (fromType t))
+    | _ ->
+      Some
+        (match References.definedForLoc ~file ~package locKind with
+        | None -> t |> fromType
+        | Some (docstring, res) -> (
+          match res with
+          | `Declared | `Field -> t |> fromType ~docstring
+          | `Constructor constructor ->
+            t |> fromType ~docstring:constructor.docstring ~constructor)))

analysis/src/ProcessCmt.ml

@@ -431,30 +431,84 @@ let rec getModulePath mod_desc =
   | Tmod_constraint (expr, _typ, _constraint, _coercion) ->
     getModulePath expr.mod_desc
 
-let rec forStructureItem ~env ~(exported : Exported.t) item =
+let rec forStructureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
+    item =
   match item.Typedtree.str_desc with
   | Tstr_value (_isRec, bindings) ->
     let items = ref [] in
     let rec handlePattern attributes pat =
       match pat.Typedtree.pat_desc with
       | Tpat_var (ident, name)
       | Tpat_alias (_, ident, name) (* let x : t = ... *) ->
-        let item = pat.pat_type in
-        let declared =
-          addDeclared ~name ~stamp:(Ident.binding_time ident) ~env
-            ~extent:pat.pat_loc ~item attributes
-            (Exported.add exported Exported.Value)
-            Stamps.addValue
+        (* Detect first-class module unpack patterns and register them as modules. *)
+        let unpack_loc_opt =
+          match
+            pat.pat_extra
+            |> Utils.filterMap (function
+                 | Typedtree.Tpat_unpack, loc, _ -> Some loc
+                 | _ -> None)
+          with
+          | loc :: _ -> Some loc
+          | [] -> None
         in
-        items :=
-          {
-            Module.kind = Module.Value declared.item;
-            name = declared.name.txt;
-            docstring = declared.docstring;
-            deprecated = declared.deprecated;
-            loc = declared.extentLoc;
-          }
-          :: !items
+        if unpack_loc_opt <> None then
+          match (Shared.dig pat.pat_type).desc with
+          | Tpackage (path, _, _) ->
+            let declared =
+              ProcessAttributes.newDeclared ~item:(Module.Ident path)
+                ~extent:(Option.get unpack_loc_opt)
+                ~name ~stamp:(Ident.binding_time ident) ~modulePath:NotVisible
+                false attributes
+            in
+            Stamps.addModule env.stamps (Ident.binding_time ident) declared;
+            items :=
+              {
+                Module.kind =
+                  Module
+                    {
+                      type_ = declared.item;
+                      isModuleType = isModuleType declared;
+                    };
+                name = declared.name.txt;
+                docstring = declared.docstring;
+                deprecated = declared.deprecated;
+                loc = declared.extentLoc;
+              }
+              :: !items
+          | _ ->
+            let item = pat.pat_type in
+            let declared =
+              addDeclared ~name ~stamp:(Ident.binding_time ident) ~env
+                ~extent:pat.pat_loc ~item attributes
+                (Exported.add exported Exported.Value)
+                Stamps.addValue
+            in
+            items :=
+              {
+                Module.kind = Module.Value declared.item;
+                name = declared.name.txt;
+                docstring = declared.docstring;
+                deprecated = declared.deprecated;
+                loc = declared.extentLoc;
+              }
+              :: !items
+        else
+          let item = pat.pat_type in
+          let declared =
+            addDeclared ~name ~stamp:(Ident.binding_time ident) ~env
+              ~extent:pat.pat_loc ~item attributes
+              (Exported.add exported Exported.Value)
+              Stamps.addValue
+          in
+          items :=
+            {
+              Module.kind = Module.Value declared.item;
+              name = declared.name.txt;
+              docstring = declared.docstring;
+              deprecated = declared.deprecated;
+              loc = declared.extentLoc;
+            }
+            :: !items
       | Tpat_tuple pats | Tpat_array pats | Tpat_construct (_, _, pats) ->
         pats |> List.iter (fun p -> handlePattern [] p)
       | Tpat_or (p, _, _) -> handlePattern [] p

analysis/src/ProcessExtra.ml

@@ -358,6 +358,25 @@ let typ ~env ~extra (iter : Tast_iterator.iterator) (item : Typedtree.core_type)
 
 let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator)
     (pattern : Typedtree.pattern) =
+  (* Detect first-class module unpack in a pattern and return the module path
+     if present. Used to register a synthetic module declaration *)
+  let unpacked_module_path_opt () =
+    let has_unpack =
+      match
+        pattern.pat_extra
+        |> List.filter_map (function
+             | Typedtree.Tpat_unpack, _, _ -> Some ()
+             | _ -> None)
+      with
+      | _ :: _ -> true
+      | [] -> false
+    in
+    if not has_unpack then None
+    else
+      match (Shared.dig pattern.pat_type).desc with
+      | Tpackage (path, _, _) -> Some path
+      | _ -> None
+  in
   let addForPattern stamp name =
     if Stamps.findValue file.stamps stamp = None then (
       let declared =
@@ -376,13 +395,27 @@ let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator)
     addForRecord ~env ~extra ~recordType:pattern.pat_type items
   | Tpat_construct (lident, constructor, _) ->
     addForConstructor ~env ~extra pattern.pat_type lident constructor
-  | Tpat_alias (_inner, ident, name) ->
+  | Tpat_alias (_inner, ident, name) -> (
     let stamp = Ident.binding_time ident in
-    addForPattern stamp name
-  | Tpat_var (ident, name) ->
+    match unpacked_module_path_opt () with
+    | Some path ->
+      let declared =
+        ProcessAttributes.newDeclared ~item:(Module.Ident path) ~extent:name.loc
+          ~name ~stamp ~modulePath:NotVisible false pattern.pat_attributes
+      in
+      Stamps.addModule file.stamps stamp declared
+    | None -> addForPattern stamp name)
+  | Tpat_var (ident, name) -> (
     (* Log.log("Pattern " ++ name.txt); *)
     let stamp = Ident.binding_time ident in
-    addForPattern stamp name
+    match unpacked_module_path_opt () with
+    | Some path ->
+      let declared =
+        ProcessAttributes.newDeclared ~item:(Module.Ident path) ~extent:name.loc
+          ~name ~stamp ~modulePath:NotVisible false pattern.pat_attributes
+      in
+      Stamps.addModule file.stamps stamp declared
+    | None -> addForPattern stamp name)
   | _ -> ());
   Tast_iterator.default_iterator.pat iter pattern
 

analysis/src/StructureUtils.ml

@@ -0,0 +1,10 @@
+open SharedTypes
+
+let unique_items (structure : Module.structure) : Module.item list =
+  let namesUsed = Hashtbl.create 10 in
+  structure.items
+  |> List.filter (fun (it : Module.item) ->
+         if Hashtbl.mem namesUsed it.name then false
+         else (
+           Hashtbl.add namesUsed it.name ();
+           true))