Skip to content

Towards better treatment of modules and module types. #193

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 10 commits into from
Apr 29, 2021
15 changes: 8 additions & 7 deletions analysis/src/Commands.ml
Original file line number Diff line number Diff line change
Expand Up @@ -164,14 +164,15 @@ let documentSymbol ~path =
| Ok (file, _extra) ->
let open SharedTypes in
let rec getItems {topLevel} =
let rec getItem = function
| MValue v -> (v |> SharedTypes.variableKind, [])
| MType (t, _) -> (t.decl |> SharedTypes.declarationKind, [])
| Module (Structure contents) -> (Module, getItems contents)
| Module (Constraint (_, modTypeItem)) -> getItem (Module modTypeItem)
| Module (Ident _) -> (Module, [])
in
let fn {name = {txt}; extentLoc; item} =
let item, siblings =
match item with
| MValue v -> (v |> SharedTypes.variableKind, [])
| MType (t, _) -> (t.decl |> SharedTypes.declarationKind, [])
| Module (Structure contents) -> (Module, getItems contents)
| Module (Ident _) -> (Module, [])
in
let item, siblings = getItem item in
if extentLoc.loc_ghost then siblings
else (txt, extentLoc, item) :: siblings
in
Expand Down
9 changes: 7 additions & 2 deletions analysis/src/Hover.ml
Original file line number Diff line number Diff line change
Expand Up @@ -39,13 +39,18 @@ let showModuleTopLevel ~docstring ~name
in
Some (doc ^ full)

let showModule ~docstring ~(file : SharedTypes.file) ~name
let rec showModule ~docstring ~(file : SharedTypes.file) ~name
(declared : SharedTypes.moduleKind SharedTypes.declared option) =
match declared with
| None -> showModuleTopLevel ~docstring ~name file.contents.topLevel
| Some {item = Structure {topLevel}} ->
showModuleTopLevel ~docstring ~name topLevel
| Some {item = Ident _} -> Some "Unable to resolve module reference"
| Some ({item = Constraint (_moduleItem, moduleTypeItem)} as declared) ->
(* show the interface *)
showModule ~docstring ~file ~name
(Some {declared with item = moduleTypeItem})
| Some {item = Ident path} ->
Some ("Unable to resolve module reference " ^ Path.name path)

let newHover ~(file : SharedTypes.file) ~package locItem =
match locItem.SharedTypes.locType with
Expand Down
30 changes: 23 additions & 7 deletions analysis/src/ProcessCmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -343,6 +343,24 @@ let rec forItem ~env ~(exported : exported) item =
mb_attributes exported.modules env.stamps.modules
in
[{declared with item = Module declared.item}]
| Tstr_modtype
{
mtd_name = name;
mtd_id;
mtd_attributes;
mtd_type = Some {mty_type = modType};
mtd_loc;
} ->
let env =
{env with modulePath = ExportedModule (name.txt, env.modulePath)}
in
let modTypeItem = forModuleType env modType in
let declared =
addItem ~item:modTypeItem ~name ~extent:mtd_loc
~stamp:(Ident.binding_time mtd_id)
~env mtd_attributes exported.modules env.stamps.modules
in
[{declared with item = Module modTypeItem}]
| Tstr_include {incl_mod; incl_type} ->
let env =
match getModulePath incl_mod.mod_desc with
Expand Down Expand Up @@ -417,17 +435,14 @@ and forModule env mod_desc moduleName =
{env with modulePath = ExportedModule (moduleName, env.modulePath)}
in
forModuleType env moduleType
| Tmod_constraint (expr, _typ, Tmodtype_implicit, Tcoerce_structure _) ->
(* implicit contraint synthesized during typechecking *)
(* e.g. when the same id is defined twice (e.g. make with @react.component) *)
(* skip the constraint and use the original module definition *)
forModule env expr.mod_desc moduleName
| Tmod_constraint (_expr, typ, _constraint, _coercion) ->
| Tmod_constraint (expr, typ, _constraint, _coercion) ->
(* TODO do this better I think *)
let modKind = forModule env expr.mod_desc moduleName in
let env =
{env with modulePath = ExportedModule (moduleName, env.modulePath)}
in
forModuleType env typ
let modTypeKind = forModuleType env typ in
Constraint (modKind, modTypeKind)

and forStructure ~env items =
let exported = initExported () in
Expand Down Expand Up @@ -636,6 +651,7 @@ and findInModule ~env kind path =
match kind with
| Structure {exported} ->
resolvePathInner ~env:{env with qExported = exported} ~path
| Constraint (_, moduleTypeKind) -> findInModule ~env moduleTypeKind path
| Ident modulePath -> (
let stamp, moduleName, fullPath = joinPaths modulePath path in
if stamp = 0 then Some (`Global (moduleName, fullPath))
Expand Down
4 changes: 3 additions & 1 deletion analysis/src/References.ml
Original file line number Diff line number Diff line change
Expand Up @@ -194,9 +194,11 @@ let alternateDeclared ~file ~package declared tip =
| Some declared -> Some (file, extra, declared)))
| _ -> None)

let resolveModuleReference ~file ~package (declared : moduleKind declared) =
let rec resolveModuleReference ~file ~package (declared : moduleKind declared) =
match declared.item with
| Structure _ -> Some (file, Some declared)
| Constraint (_moduleItem, moduleTypeItem) ->
resolveModuleReference ~file ~package {declared with item = moduleTypeItem}
| Ident path -> (
let env = ProcessCmt.fileEnv file in
match ProcessCmt.fromCompilerPath ~env path with
Expand Down
5 changes: 4 additions & 1 deletion analysis/src/SharedTypes.ml
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,10 @@ and moduleContents = {
topLevel : moduleItem declared list;
}

and moduleKind = Ident of Path.t | Structure of moduleContents
and moduleKind =
| Ident of Path.t
| Structure of moduleContents
| Constraint of moduleKind * moduleKind

type 't stampMap = (int, 't) Hashtbl.t

Expand Down
30 changes: 30 additions & 0 deletions analysis/tests/src/Hover.res
Original file line number Diff line number Diff line change
Expand Up @@ -44,3 +44,33 @@ let make2 = (~name:string) => React.string(name)

let num = 34
// ^hov

module type Logger = {
// ^hov
let log: string => unit
}

module JsLogger: Logger = {
// ^hov
let log = (msg: string) => Js.log(msg)
let _oneMore = 3
}

module JJ = JsLogger
// ^def


module IdDefinedTwice = {
// ^hov
let x = 10
let y = 20
let x = 10
}

module A = {let x=13}

module B = A
// ^hov

module C = B
// ^hov
3 changes: 3 additions & 0 deletions analysis/tests/src/expected/A.res.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
Hover tests/src/A.res 4:7
{"contents": "```rescript\nmodule JsLogger = {\n let log: string => unit\n}\n```"}

18 changes: 18 additions & 0 deletions analysis/tests/src/expected/Hover.res.txt
Original file line number Diff line number Diff line change
Expand Up @@ -28,3 +28,21 @@ Hover tests/src/Hover.res 41:13
Hover tests/src/Hover.res 44:10
{"contents": "```rescript\nint\n```"}

Hover tests/src/Hover.res 47:13
{"contents": "```rescript\nmodule Logger = {\n let log: string => unit\n}\n```"}

Hover tests/src/Hover.res 52:7
{"contents": "```rescript\nmodule Logger = {\n let log: string => unit\n}\n```"}

Definition tests/src/Hover.res 58:14
{"uri": "Hover.res", "range": {"start": {"line": 47, "character": 12}, "end": {"line": 47, "character": 18}}}

Hover tests/src/Hover.res 62:9
{"contents": "```rescript\nmodule IdDefinedTwice = {\n let y: int\n let x: int\n}\n```"}

Hover tests/src/Hover.res 71:7
{"contents": "```rescript\nmodule A = {\n let x: int\n}\n```"}

Hover tests/src/Hover.res 74:7
{"contents": "Unable to resolve module reference A"}