diff --git a/analysis/src/hover.ml b/analysis/src/hover.ml index a4b0bca851..0a7cc12c71 100644 --- a/analysis/src/hover.ml +++ b/analysis/src/hover.ml @@ -2,7 +2,7 @@ open Shared_types module String_set = Set.Make (String) -let show_module_top_level ~docstring ~is_type ~name +let show_module_top_level ?(functor_params = []) ~docstring ~is_type ~name (top_level : Module.item list) = let contents = top_level @@ -22,6 +22,9 @@ let show_module_top_level ~docstring ~is_type ~name Markdown.code_block ("module " ^ (if is_type then "type " ^ name ^ " = " else name ^ ": ") + ^ (match functor_params with + | [] -> "" + | params -> "(" ^ String.concat ", " params ^ ") => ") ^ "{" ^ "\n" ^ contents ^ "\n}") in let doc = @@ -39,13 +42,13 @@ let rec show_module ~state ~docstring ~(file : File.t) ~package ~name match declared with | None -> show_module_top_level ~docstring ~is_type:false ~name file.structure.items - | Some {item = Structure {items}; module_path} -> + | Some {item = Structure {items; functor_params}; module_path} -> let is_type = match module_path with | ExportedModule {is_type} -> is_type | _ -> false in - show_module_top_level ~docstring ~is_type ~name items + show_module_top_level ~functor_params ~docstring ~is_type ~name items | Some ({item = Constraint (_moduleItem, module_type_item)} as declared) -> (* show the interface *) show_module ~state ~docstring ~file ~name ~package diff --git a/analysis/src/process_cmt.ml b/analysis/src/process_cmt.ml index 1a7763ca94..777d03b10a 100644 --- a/analysis/src/process_cmt.ml +++ b/analysis/src/process_cmt.ml @@ -35,6 +35,35 @@ let map_record_field {Types.ld_id; ld_type; ld_attributes; ld_optional} = deprecated = Process_attributes.find_deprecated_attribute ld_attributes; } +(* A functor parameter's module type, on one line for hover. *) +let module_type_to_string (mty : Types.module_type) = + match mty with + | Mty_ident path | Mty_alias (_, path) -> Printtyp.string_of_path path + | Mty_signature signature -> + let items = + Printtyp.tree_of_signature signature + |> List.map (fun item -> + Res_outcome_printer.print_out_sig_item_doc item + |> Res_doc.to_string ~width:Res_printer.default_print_width) + in + "{" ^ String.concat "; " items ^ "}" + | Mty_functor _ -> "{...}" + +(* A functor parameter as hover shows it, such as [O: Ord]; a generative + functor's [*] parameter shows as nothing, giving [() => ...]. *) +let functor_param ~name (mty : Types.module_type option) = + match (name, mty) with + | "*", _ -> "" + | _, None -> name + | _, Some mty -> name ^ ": " ^ module_type_to_string mty + +let rec add_functor_param param (m : Module.t) : Module.t = + match m with + | Structure s -> Structure {s with functor_params = param :: s.functor_params} + | Constraint (m1, m2) -> + Constraint (add_functor_param param m1, add_functor_param param m2) + | Ident _ -> m + let rec for_type_signature_item ~(env : Shared_types.Env.t) ~(exported : Exported.t) (item : Types.signature_item) = match item with @@ -174,7 +203,14 @@ and for_type_signature ~name ~env signature = (fun item items -> for_type_signature_item ~env ~exported item @ items) signature [] in - {Module.name; docstring = []; exported; items; deprecated = None} + { + Module.name; + docstring = []; + exported; + items; + deprecated = None; + functor_params = []; + } and for_type_module ~name ~env module_type = match module_type with @@ -182,8 +218,9 @@ and for_type_module ~name ~env module_type = | Mty_alias (_ (* 402 *), path) -> Ident path | Mty_signature signature -> Structure (for_type_signature ~name ~env signature) - | Mty_functor (_argIdent, _argType, result_type) -> + | Mty_functor (arg_ident, arg_type, result_type) -> for_type_module ~name ~env result_type + |> add_functor_param (functor_param ~name:(Ident.name arg_ident) arg_type) (* Stamps given to renamed identifiers start here, far above the stamps in a typed tree, so that they never meet one of them. *) @@ -453,7 +490,7 @@ let for_signature ~name ~env sig_items = in let docstring = attrs_to_docstring attributes in let deprecated = Process_attributes.find_deprecated_attribute attributes in - {Module.name; docstring; exported; items; deprecated} + {Module.name; docstring; exported; items; deprecated; functor_params = []} let rec get_module_path mod_desc = match mod_desc with @@ -701,7 +738,11 @@ and for_module ~env (mod_expr : Typedtree.module_expr) module_name = ~extent:arg_name.loc ~stamp ~module_path:NotVisible false [] in Stamps.add_module env.stamps stamp declared); - for_module ~env result_expr module_name + let param = + functor_param ~name:arg_name.txt + (Option.map (fun (t : Typedtree.module_type) -> t.mty_type) maybe_type) + in + for_module ~env result_expr module_name |> add_functor_param param | Tmod_apply (functor_, _arg, _coercion) -> (* The functor's body has the parameter's types; the application's signature has the argument's. Its items keep the identifiers of the @@ -779,7 +820,7 @@ and for_structure ~name ~env str_items = in let docstring = attrs_to_docstring attributes in let deprecated = Process_attributes.find_deprecated_attribute attributes in - {Module.name; docstring; exported; items; deprecated} + {Module.name; docstring; exported; items; deprecated; functor_params = []} let file_for_cmt_infos ~module_name ~uri ({cmt_modname; cmt_annots} : Cmt_format.cmt_infos) = diff --git a/analysis/src/shared_types.ml b/analysis/src/shared_types.ml index d23303fe4a..9d648c01c6 100644 --- a/analysis/src/shared_types.ml +++ b/analysis/src/shared_types.ml @@ -148,6 +148,8 @@ module Module = struct exported: Exported.t; items: item list; deprecated: string option; + functor_params: string list; + (** the parameters, such as [O: Ord], when this is a functor's result *) } and t = Ident of Path.t | Structure of structure | Constraint of t * t @@ -290,6 +292,7 @@ module File = struct exported = Exported.init (); items = []; deprecated = None; + functor_params = []; }; } end diff --git a/changes/functor-hover-params.fix.md b/changes/functor-hover-params.fix.md new file mode 100644 index 0000000000..3c02b02f3e --- /dev/null +++ b/changes/functor-hover-params.fix.md @@ -0,0 +1 @@ +- Hover on a functor shows its parameters, such as `module MakeSet: (O: Ord) => {...}`, instead of only its body. diff --git a/tests/analysis_tests/tests/src/HoverFunctor.res b/tests/analysis_tests/tests/src/HoverFunctor.res new file mode 100644 index 0000000000..4116e2c8bc --- /dev/null +++ b/tests/analysis_tests/tests/src/HoverFunctor.res @@ -0,0 +1,40 @@ +module type Ord = { + type t + let compare: (t, t) => int +} + +module MakeSet = (O: Ord) => { + // ^hov + type t = array + let add = (s: t, x: O.t) => s->Array.concat([x]) +} + +module Pair = (A: Ord, B: Ord) => { + // ^hov + type t = (A.t, B.t) +} + +module Inline = (X: { + // ^hov + let x: int +}) => { + let y = X.x +} + +module IntOrd = { + type t = int + let compare = (a: int, b) => a - b +} + +// An applied functor is a plain module +module IntSet = MakeSet(IntOrd) +// ^hov + +// A partially applied functor keeps its remaining parameter +module PairInt = Pair(IntOrd) +// ^hov + +module Counter = () => { + // ^hov + let count = ref(0) +} diff --git a/tests/analysis_tests/tests/src/expected/HoverFunctor.res.txt b/tests/analysis_tests/tests/src/expected/HoverFunctor.res.txt new file mode 100644 index 0000000000..e49c9d384b --- /dev/null +++ b/tests/analysis_tests/tests/src/expected/HoverFunctor.res.txt @@ -0,0 +1,48 @@ +Hover src/HoverFunctor.res 5:9 +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule MakeSet: (O: Ord) => {\n type t = array\n let add: (t, O.t) => array\n}\n```" + } +} + +Hover src/HoverFunctor.res 11:7 +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule Pair: (A: Ord, B: Ord) => {\n type t = (A.t, B.t)\n}\n```" + } +} + +Hover src/HoverFunctor.res 16:9 +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule Inline: (X: {let x: int}) => {\n let y: int\n}\n```" + } +} + +Hover src/HoverFunctor.res 29:8 +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule IntSet: {\n type t = array\n let add: (t, IntOrd.t) => array\n}\n```" + } +} + +Hover src/HoverFunctor.res 33:8 +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule PairInt: (B: Ord) => {\n type t = (IntOrd.t, B.t)\n}\n```" + } +} + +Hover src/HoverFunctor.res 36:9 +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule Counter: () => {\n let count: ref\n}\n```" + } +} +