Skip to content

Commit

Permalink
Include with-doc arg for search by type
Browse files Browse the repository at this point in the history
  • Loading branch information
xvw committed Sep 24, 2024
1 parent 77bbfce commit a8688aa
Show file tree
Hide file tree
Showing 13 changed files with 185 additions and 175 deletions.
3 changes: 0 additions & 3 deletions .ocamlformat

This file was deleted.

2 changes: 0 additions & 2 deletions .ocamlformat-enable

This file was deleted.

2 changes: 1 addition & 1 deletion CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ unreleased
- destruct: Refinement in the presence of optional arguments (#1800 #1807, fixes #1770)
- Implement new expand-node command for expanding PPX annotations (#1745)
- Implement new inlay-hints command for adding hints on a sourcetree (#1812)
- Implement new search-by-type command for searching values by types (#1828)
- Implement new search-by-type command for searching values by types (#1828)
+ editor modes
- vim: fix python-3.12 syntax warnings in merlin.py (#1798)
- vim: Dead code / doc removal for previously deleted MerlinPhrase command (#1804)
Expand Down
3 changes: 2 additions & 1 deletion doc/dev/PROTOCOL.md
Original file line number Diff line number Diff line change
Expand Up @@ -432,11 +432,12 @@ Returns the type of the expression when typechecked in the environment around th

Returns a list (in the form of a completion list) of values matching the query. A query is defined by polarity (and does not support type parameters). Arguments are prefixed with `-` and the return type is prefixed with `+`. For example, to find a function that takes a string and returns an integer: `-string +int`. `-list +option` will returns every definition that take a list an option.

### `search-by-type` -position <position> -query <string> -limit <int>
### `search-by-type` -position <position> -query <string> -limit <int> -with-doc <bool>

-position <position> Position to search
-query <string> The query
-limit <int> a maximum-size of the result set
-with-doc <bool> if doc should be included in the result

Returns a list of values matching the query. A query is a type expression, ie: `string -> int option` will search every definition that take a string and returns an option of int. It is also possible to search by polarity.

Expand Down
21 changes: 2 additions & 19 deletions src/analysis/polarity_search.ml
Original file line number Diff line number Diff line change
Expand Up @@ -152,32 +152,15 @@ let execute_query query env dirs =
in
List.fold_left dirs ~init:(direct None []) ~f:recurse

let execute_query_as_type_search
?(limit = 100)
~config
~local_defs
~comments
~pos
~env
~query
~modules () =
let execute_query_as_type_search ?(limit = 100) ~env ~query ~modules doc_ctx =
let direct dir acc =
Env.fold_values (fun _ path desc acc ->
let d = desc.Types.val_type in
match match_query env query d with
| Some cost ->
let path = Printtyp.rewrite_double_underscore_paths env path in
let name = Format.asprintf "%a" Printtyp.path path in
let doc =
Locate.get_doc
~config
~env
~local_defs
~comments
~pos
(`User_input name)
|> Type_search.doc_to_option
in
let doc = Type_search.get_doc doc_ctx env name in
let loc = desc.Types.val_loc in
let typ =
Format.asprintf "%a"
Expand Down
52 changes: 23 additions & 29 deletions src/analysis/type_search.ml
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,20 @@ let doc_to_option = function
| `Found doc -> Some doc
| _ -> None


let get_doc doc_ctx env name =
match doc_ctx with
| None -> None
| Some (config, local_defs, comments, pos) ->
Locate.get_doc
~config
~env
~local_defs
~comments
~pos
(`User_input name)
|> doc_to_option

let compare_result
Query_protocol.{cost = cost_a; name = a; doc = doc_a; _}
Query_protocol.{cost = cost_b; name = b; doc = doc_b; _}
Expand All @@ -85,9 +99,7 @@ let compare_result
| _ -> c
else c

let compute_value
(config, local_defs, comments, pos, query) env
_ path desc acc =
let compute_value doc_ctx query env _ path desc acc =
let open Merlin_sherlodoc in
let d = desc.Types.val_type in
let typ = sherlodoc_type_of env d in
Expand All @@ -96,16 +108,7 @@ let compute_value
let cost = Query.distance_for query ~path:name typ in
if cost >= 1000 then acc
else
let doc =
Locate.get_doc
~config
~env
~local_defs
~comments
~pos
(`User_input name)
|> doc_to_option
in
let doc = get_doc doc_ctx env name in
let loc = desc.Types.val_loc in
let typ =
Format.asprintf "%a"
Expand All @@ -115,15 +118,15 @@ let compute_value
let constructible = make_constructible name d in
Query_protocol.{cost; name; typ; loc; doc; constructible} :: acc

let compute_values ctx env lident acc =
Env.fold_values (compute_value ctx env) lident env acc
let compute_values doc_ctx query env lident acc =
Env.fold_values (compute_value doc_ctx query env) lident env acc

let values_from_module ctx env lident acc =
let values_from_module doc_ctx query env lident acc =
let rec aux acc lident =
match Env.find_module_by_name lident env with
| exception _ -> acc
| _ ->
let acc = compute_values ctx env (Some lident) acc in
let acc = compute_values doc_ctx query env (Some lident) acc in
Env.fold_modules (fun name _ mdl acc ->
match mdl.Types.md_type with
| Types.Mty_alias _ -> acc
Expand All @@ -135,23 +138,14 @@ let values_from_module ctx env lident acc =
aux acc lident


let run
?(limit = 100)
~config
~local_defs
~comments
~pos
~env
~query
~modules () =
let ctx = (config, local_defs, comments, pos, query) in
let init = compute_values ctx env None [] in
let run ?(limit = 100) ~env ~query ~modules doc_ctx =
let init = compute_values doc_ctx query env None [] in
modules
|> List.fold_left
~init
~f:(fun acc name ->
let lident = Longident.Lident name in
values_from_module ctx env lident acc
values_from_module doc_ctx query env lident acc
)
|> List.sort ~cmp:compare_result
|> List.take_n limit
Expand Down
17 changes: 11 additions & 6 deletions src/analysis/type_search.mli
Original file line number Diff line number Diff line change
Expand Up @@ -33,17 +33,22 @@
(** Compute the list of candidates from a query inside a given environment. *)
val run :
?limit:int ->
config:Mconfig.t ->
local_defs:Mtyper.typedtree ->
comments:(string * Location.t) list ->
pos:Lexing.position ->
env:Env.t ->
query:Merlin_sherlodoc.Query.t
-> modules:string list
-> unit
-> (Mconfig.t
* Mtyper.typedtree
* (string * Location.t) list
* Lexing.position)
option
-> Query_protocol.type_search_result list

val doc_to_option : [> `Builtin of string | `Found of string ] -> string option
val get_doc :
(Mconfig.t
* Mtyper.typedtree
* (string * Warnings.loc) list
* Lexing.position) option -> Env.t -> string -> string option

val make_constructible : string -> Types.type_expr -> string
val compare_result :
Query_protocol.type_search_result ->
Expand Down
19 changes: 13 additions & 6 deletions src/commands/new_commands.ml
Original file line number Diff line number Diff line change
Expand Up @@ -576,16 +576,23 @@ of the buffer."
~doc:"return a list of values that match a query"
~spec:[
arg "-position" "<position> to complete"
(marg_position (fun pos (query, _pos, limit) -> (query, pos, limit)));
(marg_position (fun pos (query, _pos, limit, with_doc) ->
(query, pos, limit, with_doc)));
arg "-query" "<query> to request values"
(Marg.param
"string" (fun query (_query, pos, limit) -> (Some query, pos, limit)));
"string" (fun query (_query, pos, limit, with_doc) ->
(Some query, pos, limit, with_doc)));
optional "-limit" "<int> the maximal amount of results (default is 100)"
(Marg.int
(fun limit (query, pos, _limit) -> (query, pos, limit)))
(fun limit (query, pos, _limit, with_doc) ->
(query, pos, limit, with_doc)));
optional "-with-doc" "<bool> include docstring (default is false)"
(Marg.bool
(fun with_doc (query, pos, limit, _with_doc) ->
(query, pos, limit, with_doc)))
]
~default:(None, `None, 100)
begin fun buffer (query, pos, limit) ->
~default:(None, `None, 100, false)
begin fun buffer (query, pos, limit, with_doc) ->
match (query, pos) with
| (None, `None) ->
failwith "-position <pos> and -query <string> are mandatory"
Expand All @@ -594,7 +601,7 @@ of the buffer."
| (_, `None) ->
failwith "-position <pos> is mandatory"
| (Some query, (#Msource.position as pos)) ->
run buffer (Query_protocol.Type_search (query, pos, limit))
run buffer (Query_protocol.Type_search (query, pos, limit, with_doc))
end
;

Expand Down
5 changes: 3 additions & 2 deletions src/commands/query_json.ml
Original file line number Diff line number Diff line change
Expand Up @@ -211,11 +211,12 @@ let dump (type a) : a t -> json =
"query", `String query;
"position", mk_position pos;
]
| Type_search (query, pos, limit) ->
| Type_search (query, pos, limit, with_doc) ->
mk "type-search" [
"query", `String query;
"position", mk_position pos;
"limit", `Int limit
"limit", `Int limit;
"with-doc", `Bool with_doc
]
| Occurrences (`Ident_at pos, scope) ->
mk "occurrences" [
Expand Down
30 changes: 10 additions & 20 deletions src/frontend/query_commands.ml
Original file line number Diff line number Diff line change
Expand Up @@ -465,39 +465,29 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
in
{ Compl. entries ; context = `Unknown }

| Type_search (query, pos, limit) ->
| Type_search (query, pos, limit, with_doc) ->
let typer = Mpipeline.typer_result pipeline in
let local_defs = Mtyper.get_typedtree typer in
let pos = Mpipeline.get_lexing_pos pipeline pos in
let node = Mtyper.node_at typer pos in
let env, _ = Mbrowse.leaf_node node in
let config = Mpipeline.final_config pipeline in
let comments = Mpipeline.reader_comments pipeline in
let modules = Mconfig.global_modules config in
let doc_ctx =
if with_doc then
let comments = Mpipeline.reader_comments pipeline in
let local_defs = Mtyper.get_typedtree typer in
Some (config, local_defs, comments, pos)
else None
in
begin match Type_search.classify_query query with
| `By_type query ->
let query = Merlin_sherlodoc.Query.from_string query in
Type_search.run
~limit
~config
~local_defs
~comments
~pos
~env
~query
~modules ()
Type_search.run ~limit ~env ~query ~modules doc_ctx
| `Polarity query ->
let query = Polarity_search.prepare_query env query in
let modules = Polarity_search.directories ~global_modules:modules env in
Polarity_search.execute_query_as_type_search
~limit
~config
~local_defs
~comments
~pos
~env
~query
~modules ()
~limit ~env ~query ~modules doc_ctx
end

| Refactor_open (mode, pos) ->
Expand Down
2 changes: 1 addition & 1 deletion src/frontend/query_protocol.ml
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,7 @@ type _ t =
: string * Msource.position
-> completions t
| Type_search
: string * Msource.position * int
: string * Msource.position * int * bool
-> type_search_result list t
| Refactor_open
: [`Qualify | `Unqualify] * Msource.position
Expand Down
12 changes: 6 additions & 6 deletions tests/test-dirs/search-by-type-comparison-to-polarity-search.t
Original file line number Diff line number Diff line change
Expand Up @@ -132,17 +132,17 @@ map).
"name": "Seq.map",
"type": "('a -> 'b) -> 'a Stdlib__Seq.t -> 'b Stdlib__Seq.t"
}
{
"name": "List.concat_map",
"type": "('a -> 'b list) -> 'a list -> 'b list"
}
{
"name": "List.filter_map",
"type": "('a -> 'b option) -> 'a list -> 'b list"
}
{
"name": "ListLabels.concat_map",
"type": "f:('a -> 'b list) -> 'a list -> 'b list"
"name": "List.concat_map",
"type": "('a -> 'b list) -> 'a list -> 'b list"
}
{
"name": "ListLabels.filter_map",
"type": "f:('a -> 'b option) -> 'a list -> 'b list"
}


Expand Down
Loading

0 comments on commit a8688aa

Please sign in to comment.