diff --git a/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml b/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml index 001caebac..7c718fc43 100644 --- a/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml +++ b/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml @@ -75,13 +75,10 @@ let of_yojson_exn = function in raise_invalid_params ~data ~message:"Unexpected params format" ()) -let overlap_with_range_end range = function - | None -> true - | Some position -> - let lend = range.Range.end_ in - if lend.line = position.Position.line then - lend.character > position.character - else lend.line > position.line +let overlap_with_range_end range position = + let lend = range.Range.end_ in + if lend.line = position.Position.line then lend.character > position.character + else lend.line > position.line let render_result index result = let typ, enclosings = @@ -128,24 +125,49 @@ let get_first_enclosing_index range_end enclosings = in aux 0 enclosings -let dispatch_type_enclosing text_document_position index range_end pipeline = - let position = get_logical_position text_document_position in +let remove_enclosings_duplicata enclosings = + enclosings + |> List.map ~f:(fun (loc, _, _) -> Range.of_loc loc) + |> Merlin_utils.Std.List.merge_cons ~f:(fun a_range b_range -> + if Range.compare a_range b_range = Eq then Some b_range else None) + +let dispatch_command pipeline command = + match Query_commands.dispatch pipeline command with + | (_, `String typ, _) :: enclosings -> + Some (typ, remove_enclosings_duplicata enclosings) + | _ -> None + +let dispatch_with_range_end pipeline position index range_end = + (* merlin's `type-enclosing` command takes a position and returns a list of + increasing enclosures around that position. If it is given the [index] + parameter, it annotates the corresponding enclosing with its type. + + As the request would like to allow the target of an interval, we want to + truncate the list of enclosures that include the interval. Something merlin + cannot do. + + We use a little hack where we use the `type-enclosing` command (with a + negative index, so as not to make unnecessary computations) to calculate + the enclosings around the given position. Then, we look for the index + corresponding to the first enclosing included in the range which will act + as an offset to calculate the real index, relative to the range *) let dummy_command = make_enclosing_command position (-1) in let enclosings = Query_commands.dispatch pipeline dummy_command in Option.bind (get_first_enclosing_index range_end enclosings) ~f:(fun first_index -> let command = make_enclosing_command position (first_index + index) in - match Query_commands.dispatch pipeline command with - | (_, `String typ, _) :: enclosings -> - Some - ( typ - , enclosings - |> List.map ~f:(fun (loc, _, _) -> Range.of_loc loc) - |> Merlin_utils.Std.List.merge_cons ~f:(fun a_range b_range -> - if Range.compare a_range b_range = Eq then Some b_range - else None) ) - | _ -> None) + dispatch_command pipeline command) + +let dispatch_without_range_end pipeline position index = + let command = make_enclosing_command position index in + dispatch_command pipeline command + +let dispatch_type_enclosing text_document_position index range_end pipeline = + let position = get_logical_position text_document_position in + match range_end with + | None -> dispatch_without_range_end pipeline position index + | Some range_end -> dispatch_with_range_end pipeline position index range_end let on_request ~params state = Fiber.of_thunk (fun () ->