Skip to content

Commit

Permalink
Refactor request and document process
Browse files Browse the repository at this point in the history
  • Loading branch information
@xvw
xvw committed Jun 26, 2024
1 parent 5516d73 commit 90f67de
Show file tree
Hide file tree
Showing 2 changed files with 240 additions and 50 deletions.
63 changes: 43 additions & 20 deletions ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -128,24 +125,50 @@ 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 finalize_enclosings enclosings =
enclosings |> List.map ~f:(fun (loc, _, _) -> Range.of_loc loc)

let dispatch_command pipeline command index =
let rec aux i = function
| (_, `String typ, _) :: enclosings when i = index ->
Some (typ, finalize_enclosings enclosings)
| _ :: enclosings -> aux (succ i) enclosings
| [] -> None
in
aux 0 (Query_commands.dispatch pipeline command)

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)
let real_index = first_index + index in
let command = make_enclosing_command position real_index in
dispatch_command pipeline command real_index)

let dispatch_without_range_end pipeline position index =
let command = make_enclosing_command position index in
dispatch_command pipeline command index

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 () ->
Expand Down
227 changes: 197 additions & 30 deletions ocaml-lsp-server/test/e2e-new/type_enclosing.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,36 +100,6 @@ let%expect_test "type enclosing on simple example - 3" =
"type": "int"
} |}]

let%expect_test "type enclosing on simple example with rangeEnd" =
let source =
{|module Foo = struct
let bar = 42
end
type t = Foo of int
let a = Foo 3|}
in
let request client =
let open Fiber.O in
let position = Position.create ~line:4 ~character:8 in
let range_end = Position.create ~line:4 ~character:11 in
let index = 0 in
let+ response = call_type_enclosing ~range_end client position index in
print_type_enclosing response
in
Helpers.test source request;
[%expect
{|
{
"index": 0,
"enclosings": [
{
"end": { "character": 13, "line": 4 },
"start": { "character": 8, "line": 4 }
}
],
"type": "int -> t"
} |}]

let cons_ml =
{|type t = U
type t' = U
Expand Down Expand Up @@ -197,6 +167,10 @@ let%expect_test "type enclosing constructors_and_path - 2" =
{
"index": 0,
"enclosings": [
{
"end": { "character": 5, "line": 7 },
"start": { "character": 4, "line": 7 }
},
{
"end": { "character": 5, "line": 7 },
"start": { "character": 4, "line": 7 }
Expand Down Expand Up @@ -262,3 +236,196 @@ let%expect_test "type enclosing constructors_and_path with reconstruction - 4" =
],
"type": "sig type t = A of int val x : int end"
} |}]

let%expect_test "type enclosing on nested-modules examples" =
let source =
{|module Foo = struct
let x = 10
let y = "foo"
module Bar = struct
let z = true
let f x =
let y = 225 in
(float_of_int y) + x
end
end
|}
in
let request client =
let open Fiber.O in
let position = Position.create ~line:7 ~character:7 in
let index = 0 in
let+ response = call_type_enclosing client position index in
print_type_enclosing response
in
Helpers.test source request;
[%expect
{|
{
"index": 0,
"enclosings": [
{
"end": { "character": 19, "line": 7 },
"start": { "character": 7, "line": 7 }
},
{
"end": { "character": 22, "line": 7 },
"start": { "character": 6, "line": 7 }
},
{
"end": { "character": 22, "line": 7 },
"start": { "character": 6, "line": 7 }
},
{
"end": { "character": 26, "line": 7 },
"start": { "character": 6, "line": 7 }
},
{
"end": { "character": 26, "line": 7 },
"start": { "character": 6, "line": 6 }
},
{
"end": { "character": 26, "line": 7 },
"start": { "character": 10, "line": 5 }
},
{
"end": { "character": 5, "line": 8 },
"start": { "character": 15, "line": 3 }
},
{
"end": { "character": 5, "line": 8 },
"start": { "character": 2, "line": 3 }
},
{
"end": { "character": 3, "line": 9 },
"start": { "character": 13, "line": 0 }
},
{
"end": { "character": 3, "line": 9 },
"start": { "character": 0, "line": 0 }
}
],
"type": "int -> float"
} |}]

let%expect_test "type enclosing on nested-modules examples, enclosing en \
module Bar" =
let source =
{|module Foo = struct
let x = 10
let y = "foo"
module Bar = struct
let z = true
let f x =
let y = 225 in
(float_of_int y) + x
end
end
|}
in
let request client =
let open Fiber.O in
let position = Position.create ~line:7 ~character:7 in
let index = 7 in
let+ response = call_type_enclosing client position index in
print_type_enclosing response
in
Helpers.test source request;
[%expect
{|
{
"index": 7,
"enclosings": [
{
"end": { "character": 5, "line": 8 },
"start": { "character": 2, "line": 3 }
},
{
"end": { "character": 3, "line": 9 },
"start": { "character": 13, "line": 0 }
},
{
"end": { "character": 3, "line": 9 },
"start": { "character": 0, "line": 0 }
}
],
"type": "sig val z : bool val f : int -> int end"
} |}]

let%expect_test "type enclosing on nested-modules examples, enclosing en \
module Foo" =
let source =
{|module Foo = struct
let x = 10
let y = "foo"
module Bar = struct
let z = true
let f x =
let y = 225 in
(float_of_int y) + x
end
end
|}
in
let request client =
let open Fiber.O in
let position = Position.create ~line:7 ~character:7 in
let index = 9 in
let+ response = call_type_enclosing client position index in
print_type_enclosing response
in
Helpers.test source request;
[%expect
{|
{
"index": 9,
"enclosings": [
{
"end": { "character": 3, "line": 9 },
"start": { "character": 0, "line": 0 }
}
],
"type": "sig\n val x : int\n val y : string\n module Bar : sig val z : bool val f : int -> int end\nend"
} |}]

let%expect_test "type enclosing on nested-modules examples, enclosing en Bar.z \
with range_end should produce enclose module Foo.Bar and \
module Foo" =
let source =
{|module Foo = struct
let x = 10
let y = "foo"
module Bar = struct
let z = true
let f x =
let y = 225 in
(float_of_int y) + x
end
end
|}
in
let request client =
let open Fiber.O in
let range_end = Position.create ~line:3 ~character:7 in
let position = Position.create ~line:4 ~character:8 in
let index = 2 in
let+ response = call_type_enclosing ~range_end client position index in
print_type_enclosing response
in
Helpers.test source request;
[%expect
{|
{
"index": 2,
"enclosings": [
{
"end": { "character": 3, "line": 9 },
"start": { "character": 13, "line": 0 }
},
{
"end": { "character": 3, "line": 9 },
"start": { "character": 0, "line": 0 }
}
],
"type": "sig val z : bool val f : int -> int end"
} |}]

0 comments on commit 90f67de

Please sign in to comment.