From 459c88f8da9649e32eee02033c3f3ea9bfb22b54 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 21 Aug 2025 21:10:30 +0200 Subject: [PATCH 1/3] support completions and better hovers for first class modules (and by extension module types) --- analysis/src/CompletionBackEnd.ml | 135 ++++++++++++++---- analysis/src/CompletionFrontEnd.ml | 3 +- analysis/src/Hover.ml | 31 ++-- analysis/src/ProcessCmt.ml | 86 ++++++++--- analysis/src/ProcessExtra.ml | 41 +++++- analysis/src/StructureUtils.ml | 11 ++ .../tests/src/FirstClassModules.res | 19 +++ .../src/expected/FirstClassModules.res.txt | 49 +++++++ 8 files changed, 319 insertions(+), 56 deletions(-) create mode 100644 analysis/src/StructureUtils.ml create mode 100644 tests/analysis_tests/tests/src/FirstClassModules.res create mode 100644 tests/analysis_tests/tests/src/expected/FirstClassModules.res.txt diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index 6a3cbb1424..bbd61eac48 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -173,6 +173,46 @@ 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); *) @@ -180,17 +220,24 @@ let resolvePathFromStamps ~(env : QueryEnv.t) ~package ~scope ~moduleName ~path | 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.`). *) + 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 diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index ff605b5de7..8d4cb06e62 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/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 diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index fc8a8d0573..716f5e3c00 100644 --- a/analysis/src/Hover.ml +++ b/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))) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index be770a0687..306d862a09 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -431,7 +431,8 @@ 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 @@ -439,22 +440,75 @@ let rec forStructureItem ~env ~(exported : Exported.t) item = 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 diff --git a/analysis/src/ProcessExtra.ml b/analysis/src/ProcessExtra.ml index 1710d5fd32..75390cefba 100644 --- a/analysis/src/ProcessExtra.ml +++ b/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 diff --git a/analysis/src/StructureUtils.ml b/analysis/src/StructureUtils.ml new file mode 100644 index 0000000000..0295b1c2c7 --- /dev/null +++ b/analysis/src/StructureUtils.ml @@ -0,0 +1,11 @@ +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)) + diff --git a/tests/analysis_tests/tests/src/FirstClassModules.res b/tests/analysis_tests/tests/src/FirstClassModules.res new file mode 100644 index 0000000000..73acf433ca --- /dev/null +++ b/tests/analysis_tests/tests/src/FirstClassModules.res @@ -0,0 +1,19 @@ +module type SomeModule = { + module Inner: { + let v: int + } + type t = {x: int} + let foo: t => int + let doStuff: string => unit + let doOtherStuff: string => unit +} + +let someFn = (~ctx: {"someModule": module(SomeModule)}) => { + let module(SomeModule) = ctx["someModule"] + // ^hov + //SomeModule. + // ^com + + let _ff = SomeModule.doStuff + // ^hov +} diff --git a/tests/analysis_tests/tests/src/expected/FirstClassModules.res.txt b/tests/analysis_tests/tests/src/expected/FirstClassModules.res.txt new file mode 100644 index 0000000000..cb363ef2be --- /dev/null +++ b/tests/analysis_tests/tests/src/expected/FirstClassModules.res.txt @@ -0,0 +1,49 @@ +Hover src/FirstClassModules.res 11:16 +{"contents": {"kind": "markdown", "value": "```rescript\nmodule type SomeModule = {\n module Inner\n type t = {x: int}\n let foo: t => int\n let doStuff: string => unit\n let doOtherStuff: string => unit\n}\n```"}} + +Complete src/FirstClassModules.res 13:15 +posCursor:[13:15] posNoWhite:[13:14] Found expr:[10:13->18:1] +posCursor:[13:15] posNoWhite:[13:14] Found expr:[11:2->16:30] +posCursor:[13:15] posNoWhite:[13:14] Found expr:[13:4->16:30] +posCursor:[13:15] posNoWhite:[13:14] Found expr:[13:4->13:15] +Pexp_ident SomeModule.:[13:4->13:15] +Completable: Cpath Value[SomeModule, ""] +Package opens Stdlib.place holder Pervasives.JsxModules.place holder +Resolved opens 1 Stdlib +ContextPath Value[SomeModule, ""] +Path SomeModule. +[{ + "label": "Inner", + "kind": 9, + "tags": [], + "detail": "module Inner", + "documentation": null + }, { + "label": "t", + "kind": 22, + "tags": [], + "detail": "type t", + "documentation": {"kind": "markdown", "value": "```rescript\ntype t = {x: int}\n```"} + }, { + "label": "foo", + "kind": 12, + "tags": [], + "detail": "t => int", + "documentation": null + }, { + "label": "doStuff", + "kind": 12, + "tags": [], + "detail": "string => unit", + "documentation": null + }, { + "label": "doOtherStuff", + "kind": 12, + "tags": [], + "detail": "string => unit", + "documentation": null + }] + +Hover src/FirstClassModules.res 16:8 +{"contents": {"kind": "markdown", "value": "```rescript\nstring => unit\n```"}} + From 76f7050f6f9b279ad3bb6e943ec159157183caca Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 21 Aug 2025 21:12:45 +0200 Subject: [PATCH 2/3] changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9c1dac27e0..a6881f35a9 100644 --- a/CHANGELOG.md +++ b/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 From dea57333688d88168b4032e25ef945f5d50e5d99 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 21 Aug 2025 21:39:23 +0200 Subject: [PATCH 3/3] fix formatting --- analysis/src/StructureUtils.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/analysis/src/StructureUtils.ml b/analysis/src/StructureUtils.ml index 0295b1c2c7..2421f92a4b 100644 --- a/analysis/src/StructureUtils.ml +++ b/analysis/src/StructureUtils.ml @@ -8,4 +8,3 @@ let unique_items (structure : Module.structure) : Module.item list = else ( Hashtbl.add namesUsed it.name (); true)) -