From b73d82294a54136a3418f85212b8647bfc3d3f8f Mon Sep 17 00:00:00 2001 From: Xavier Van de Woestyne Date: Wed, 3 Jul 2024 11:44:25 +0200 Subject: [PATCH] Type enclosing query (#1304) Add `typeEnclosing` customRequest --- CHANGES.md | 2 + .../docs/ocamllsp/typeEnclosing-spec.md | 59 +++ .../src/custom_requests/req_type_enclosing.ml | 182 +++++++ .../custom_requests/req_type_enclosing.mli | 23 + ocaml-lsp-server/src/import.ml | 4 + ocaml-lsp-server/src/ocaml_lsp_server.ml | 2 + ocaml-lsp-server/test/e2e-new/dune | 1 + ocaml-lsp-server/test/e2e-new/start_stop.ml | 3 +- .../test/e2e-new/type_enclosing.ml | 497 ++++++++++++++++++ 9 files changed, 772 insertions(+), 1 deletion(-) create mode 100644 ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md create mode 100644 ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml create mode 100644 ocaml-lsp-server/src/custom_requests/req_type_enclosing.mli create mode 100644 ocaml-lsp-server/test/e2e-new/type_enclosing.ml diff --git a/CHANGES.md b/CHANGES.md index 9ef6c41c3..09e835ed5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -42,6 +42,8 @@ [`ocamllsp/merlinCallCompatible`](https://github.com/ocaml/ocaml-lsp/blob/e165f6a3962c356adc7364b9ca71788e93489dd0/ocaml-lsp-server/docs/ocamllsp/merlinCallCompatible-spec.md) request (#1265) +- Add custom [`ocamllsp/typeEnclosing`](https://github.com/ocaml/ocaml-lsp/blob/109801e56f2060caf4487427bede28b824f4f1fe/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md) request (#1304) + ## Fixes diff --git a/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md b/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md new file mode 100644 index 000000000..dfd39dc65 --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/typeEnclosing-spec.md @@ -0,0 +1,59 @@ +# Type Enclosing Request + +## Description + +Merlin has a concept of `type enclosing` that gets the type of ident under the +cursor. It will highlight the ident and display its type. You can climb the +typed-tree and display the type of bigger expressions surrounding the cursor. In +order to keep the request stateless, the manipulation related to growing or +shrinking enclosings is delegated to the client. This request allows to request +type enclosing under the cursor and then its surrounding enclosings. + +## Client capability + +There is no client capability relative to this request. + +## Server capability + +- property name: `handleTypeEnclosing` +- property type: `boolean` + +## Request + +- method: `ocamllsp/typeEnclosing` +- params: + + ```json + { + "uri": TextDocumentIdentifier, + "at": (Position | Range), + "index": uinteger, + "verbosity?": uinteger, + } + ``` + + - `index` can be used to print only one type information. This is useful to query + the types lazily: normally, Merlin would return the signature of all enclosing + modules, which can be very expensive. + - `verbosity` determines the number of expansions of aliases in answers. + - `at` : + - if a `Position` is given, it will returns all enclosing around the position + - if a `Range` is given, only enclosings that contain the range + `[range.start; range.end]` will be included in the answer + + +## Response + +```json +{ + "enclosings": Range[], + "index": uinteger, + "type": string +} +``` + +- `enclosings`: The surrounding enclosings +- `index` The index of the provided type result: the index corresponds to a + zero-indexed enclosing in the `enclosings`' array. It is the same value as the + one provided in this request's `TypeEnclosingParams` +- `type`: The type of the enclosing `enclosings[index]` as a raw string diff --git a/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml b/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml new file mode 100644 index 000000000..9060fdfdd --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_type_enclosing.ml @@ -0,0 +1,182 @@ +open Import +module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams + +let capability = ("handleTypeEnclosing", `Bool true) + +let meth = "ocamllsp/typeEnclosing" + +module Request_params = struct + type t = + { text_document : TextDocumentIdentifier.t + ; at : [ `Range of Range.t | `Position of Position.t ] + ; index : int + ; verbosity : int + } + + let yojson_of_at = function + | `Range r -> Range.yojson_of_t r + | `Position p -> Position.yojson_of_t p + + let yojson_of_t { text_document; index; at; verbosity } = + match TextDocumentIdentifier.yojson_of_t text_document with + | `Assoc assoc -> + let index = ("index", `Int index) in + let range_end = ("at", yojson_of_at at) in + let verbosity = ("verbosity", `Int verbosity) in + `Assoc (index :: range_end :: verbosity :: assoc) + | _ -> (* unreachable *) assert false + + let create ?(verbosity = 0) ~text_document ~at ~index () = + { text_document; index; at; verbosity } + + let json_error json = + Json.error "invalid Req_type_enclosing.Request_params" json + + let index_of_yojson json params = + match List.assoc_opt "index" params with + | Some (`Int index) -> index + | _ -> + (* If the parameter is incorrectly formatted or missing, we refuse to build + the parameter, [index] is mandatory. *) + json_error json + + let verbosity_of_yojson params = + match List.assoc_opt "verbosity" params with + | Some (`Int verbosity) -> verbosity + | _ -> + (* If the parameter is incorrectly formatted or missing, it is assumed that + the we ask for a verbosity level set to 0. *) + 0 + + let at_of_yojson json params = + match List.assoc_opt "at" params with + | Some at -> ( + try `Position (Position.t_of_yojson at) + with _ -> `Range (Range.t_of_yojson at)) + | _ -> + (* If the parameter is incorrectly formatted or missing, we refuse to build + the parameter, [at] is mandatory. *) + json_error json + + let t_of_yojson = function + | `Assoc params as json -> + let verbosity = verbosity_of_yojson params in + let at = at_of_yojson json params in + let index = index_of_yojson json params in + let text_document = TextDocumentIdentifier.t_of_yojson json in + { index; at; verbosity; text_document } + | json -> json_error json +end + +type t = + { index : int + ; type_ : string + ; enclosings : Range.t list + } + +let yojson_of_t { index; type_; enclosings } = + `Assoc + [ ("index", `Int index) + ; ("enclosings", `List (List.map ~f:Range.yojson_of_t enclosings)) + ; ("type", `String type_) + ] + +let config_with_given_verbosity config verbosity = + let open Mconfig in + { config with query = { config.query with verbosity } } + +let with_pipeline state uri verbosity with_pipeline = + let doc = Document_store.get state.State.store uri in + match Document.kind doc with + | `Other -> Fiber.return `Null + | `Merlin merlin -> + let open Fiber.O in + let* config = Document.Merlin.mconfig merlin in + Document.Merlin.with_configurable_pipeline_exn + ~config:(config_with_given_verbosity config verbosity) + merlin + with_pipeline + +let make_enclosing_command position index = + Query_protocol.Type_enclosing (None, position, Some index) + +let get_first_enclosing_index range_end enclosings = + List.find_mapi enclosings ~f:(fun i (loc, _, _) -> + let range = Range.of_loc loc in + match Position.compare range_end range.end_ with + | Ordering.Lt | Ordering.Eq -> Some i + | Ordering.Gt -> None) + +let dispatch_command pipeline command first_index index = + let rec aux i acc = function + | (_, `String typ, _) :: _ as enclosings when i = index -> + Some + ( typ + , List.map + ~f:(fun (loc, _, _) -> Range.of_loc loc) + (List.rev_append acc enclosings) ) + | curr :: enclosings -> aux (succ i) (curr :: acc) enclosings + | [] -> None + in + let result = + List.drop (Query_commands.dispatch pipeline command) first_index + in + aux 0 [] result + +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 real_index = first_index + index in + let command = make_enclosing_command position real_index in + dispatch_command pipeline command first_index index) + +let dispatch_without_range_end pipeline position index = + let command = make_enclosing_command position index in + dispatch_command pipeline command 0 index + +let dispatch_type_enclosing position index range_end pipeline = + let position = Position.logical position in + let result = + match range_end with + | None -> dispatch_without_range_end pipeline position index + | Some range_end -> + dispatch_with_range_end pipeline position index range_end + in + let type_, enclosings = + match result with + | None -> ("", []) + | Some (typ, enclosings) -> (typ, enclosings) + in + yojson_of_t { index; type_; enclosings } + +let on_request ~params state = + Fiber.of_thunk (fun () -> + let params = (Option.value ~default:(`Assoc []) params :> Json.t) in + let Request_params.{ index; verbosity; text_document; at } = + Request_params.t_of_yojson params + in + let position, range_end = + match at with + | `Position p -> (p, None) + | `Range r -> (r.start, Some r.end_) + in + let uri = text_document.uri in + let verbosity = Mconfig.Verbosity.Lvl verbosity in + with_pipeline state uri verbosity + @@ dispatch_type_enclosing position index range_end) diff --git a/ocaml-lsp-server/src/custom_requests/req_type_enclosing.mli b/ocaml-lsp-server/src/custom_requests/req_type_enclosing.mli new file mode 100644 index 000000000..a396ee10a --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_type_enclosing.mli @@ -0,0 +1,23 @@ +open Import + +module Request_params : sig + type t + + val create : + ?verbosity:int + -> text_document:Lsp.Types.TextDocumentIdentifier.t + -> at:[ `Position of Position.t | `Range of Range.t ] + -> index:int + -> unit + -> t + + val yojson_of_t : t -> Json.t +end + +type t + +val capability : string * Json.t + +val meth : string + +val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 302aba243..135bdfe76 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -28,6 +28,8 @@ include struct let findi xs ~f = List.findi xs ~f + let find_mapi xs ~f = List.find_mapi xs ~f + let sub xs ~pos ~len = List.sub xs ~pos ~len let hd_exn t = List.hd_exn t @@ -39,6 +41,8 @@ include struct let filter t ~f = List.filter t ~f let tl t = List.tl t + + let drop xs i = List.drop xs i end module Map = Map diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 8a7f3e655..73f664bc6 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -99,6 +99,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : ; Dune.view_promotion_capability ; Req_hover_extended.capability ; Req_merlin_call_compatible.capability + ; Req_type_enclosing.capability ] ) ] in @@ -521,6 +522,7 @@ let on_request : ; (Req_infer_intf.meth, Req_infer_intf.on_request) ; (Req_typed_holes.meth, Req_typed_holes.on_request) ; (Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request) + ; (Req_type_enclosing.meth, Req_type_enclosing.on_request) ; (Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request) ; ( Semantic_highlighting.Debug.meth_request_full , Semantic_highlighting.Debug.on_request_full ) diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 62954baec..da23f37d7 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -60,6 +60,7 @@ start_stop syntax_doc_tests test + type_enclosing with_pp with_ppx workspace_change_config)))) diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index dab3b1580..278f13673 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -92,7 +92,8 @@ let%expect_test "start/stop" = "handleWrappingAstNode": true, "diagnostic_promotions": true, "handleHoverExtended": true, - "handleMerlinCallCompatible": true + "handleMerlinCallCompatible": true, + "handleTypeEnclosing": true } }, "foldingRangeProvider": true, diff --git a/ocaml-lsp-server/test/e2e-new/type_enclosing.ml b/ocaml-lsp-server/test/e2e-new/type_enclosing.ml new file mode 100644 index 000000000..48959f32f --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/type_enclosing.ml @@ -0,0 +1,497 @@ +open Test.Import + +module Util = struct + let call_type_enclosing ?(verbosity = 0) client at index = + let uri = DocumentUri.of_path "test.ml" in + let text_document = TextDocumentIdentifier.create ~uri in + let at = + match at with + | `Range r -> Range.yojson_of_t r + | `Position p -> Position.yojson_of_t p + in + let params = + match TextDocumentIdentifier.yojson_of_t text_document with + | `Assoc assoc -> + `Assoc + (("at", at) + :: ("index", `Int index) + :: ("verbosity", `Int verbosity) + :: assoc) + | _ -> (* unreachable *) assert false + in + let params = Some (Jsonrpc.Structured.t_of_yojson params) in + let req = + Lsp.Client_request.UnknownRequest + { meth = "ocamllsp/typeEnclosing"; params } + in + Client.request client req + + let print_type_enclosing result = + result |> Yojson.Safe.pretty_to_string ~std:false |> print_endline + + let test ?range_end ~verbosity ~index ~line ~character source = + let start = Position.create ~line ~character in + let at = + match range_end with + | None -> `Position start + | Some (character, line) -> + let end_ = Position.create ~character ~line in + let range = Range.create ~start ~end_ in + `Range range + in + let request client = + let open Fiber.O in + let+ response = call_type_enclosing ~verbosity client at index in + print_type_enclosing response + in + Helpers.test source request +end + +let%expect_test "Application of function without range end" = + let source = "string_of_int 42" in + let line = 0 + and character = 0 + and verbosity = 0 + and index = 0 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 13, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + { + "end": { "character": 13, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + { + "end": { "character": 16, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + ], + "type": "int -> string" + } |}] + +let%expect_test "Application of function with range end (including the current \ + enclosing) it should not change the result" = + let source = "string_of_int 42" in + let line = 0 + and character = 0 + and range_end = (13, 0) + and verbosity = 0 + and index = 0 in + Util.test ~range_end ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 13, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + { + "end": { "character": 13, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + { + "end": { "character": 16, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + ], + "type": "int -> string" + } |}] + +let%expect_test "Application of function with range end (excluding the current \ + enclosing)" = + let source = "string_of_int 42" in + let line = 0 + and character = 0 + and range_end = (14, 0) + and verbosity = 0 + and index = 0 in + Util.test ~range_end ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 16, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + ], + "type": "string" + } |}] + +let%expect_test {| + The cursor is positioned on [x]. + + We expect to have the type [string] and no other enclosings + than the first one ([00:04-00:05]), because [x] is not + nested into an other expression. +|} + = + let source = "let x = string_of_int 2002" in + let line = 0 + and character = 4 + and verbosity = 0 + and index = 0 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 5, "line": 0 }, + "start": { "character": 4, "line": 0 } + } + ], + "type": "string" + } |}] + +let%expect_test {| + The cursor is positioned on [string_of_int] and we do not give a range. +|} + = + let source = "let x = string_of_int 2002" in + let line = 0 + and character = 8 + and verbosity = 0 + and index = 0 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 21, "line": 0 }, + "start": { "character": 8, "line": 0 } + }, + { + "end": { "character": 21, "line": 0 }, + "start": { "character": 8, "line": 0 } + }, + { + "end": { "character": 26, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + ], + "type": "int -> string" + } |}] + +let%expect_test {| + The cursor is positioned on [2002]. + + We expect to have the type [int] and to have two enclosings: + 0. [00:22 - 00:26], the [2002] expr + 1. [00:08 - 00:26]. the [string_of_int 2002] expr + +|} + = + let source = "let x = string_of_int 2002" in + let line = 0 + and character = 23 + and verbosity = 0 + and index = 0 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 26, "line": 0 }, + "start": { "character": 22, "line": 0 } + }, + { + "end": { "character": 26, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + ], + "type": "int" + } |}] + +let%expect_test {| + The cursor is still positioned on [2002] but we ask for + the index [1] (the second enclosing). + + We expect still have our two enclosings but now, we are targeting the + second-one, so the expected type is [string]: + 0. [00:22 - 00:26], the [2002] expr + 1. [00:08 - 00:26]. the [string_of_int 2002] expr + +|} + = + let source = "let x = string_of_int 2002" in + let line = 0 + and character = 23 + and verbosity = 0 + and index = 1 in + Util.test ~verbosity ~line ~character ~index source; + [%expect + {| + { + "index": 1, + "enclosings": [ + { + "end": { "character": 26, "line": 0 }, + "start": { "character": 22, "line": 0 } + }, + { + "end": { "character": 26, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + ], + "type": "string" + } |}] + +let%expect_test {| + First, let's locate on [A.z], we expect the type [t], but we + will increase the verbosity in order to get the full expansion of + [type t]. And we will have 3 enclosings: + 0 : [16:06 - 16:07], the [z] expr. + 1 : [02:11 - 17:03], the [struct ... end] expr. + 2 : [02:00 - 17:03], the [module A] expr. +|} + = + let source = + {|type a = Foo | Bar + +module A = struct + let f () = 10 + let g = Bar + let h x = x + + module B = struct + type b = Baz + + let x = (Baz, 10) + let y = (Bar, Foo) + end + + type t = { a : string; b : float } + + let z = { a = "Hello"; b = 1.0 } +end|} + in + let line = 16 + and character = 6 + and verbosity = 1 + and index = 0 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 7, "line": 16 }, + "start": { "character": 6, "line": 16 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 11, "line": 2 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 0, "line": 2 } + } + ], + "type": "type t = { a : string; b : float; }" + } |}] + +let%expect_test {| + Now, let's use our enclosing to jump to the index [2], in order + to get the type of [module A], our enclosings will no change. + 0 : [16:06 - 16:07], the [z] expr. + 1 : [02:11 - 17:03], the [struct ... end] expr. + 2 : [02:00 - 17:03], the [module A] expr. +|} + = + let source = + {|type a = Foo | Bar + +module A = struct + let f () = 10 + let g = Bar + let h x = x + + module B = struct + type b = Baz + + let x = (Baz, 10) + let y = (Bar, Foo) + end + + type t = { a : string; b : float } + + let z = { a = "Hello"; b = 1.0 } +end|} + in + let line = 16 + and character = 6 + and verbosity = 0 + and index = 2 in + Util.test ~verbosity ~line ~character ~index source; + [%expect + {| + { + "index": 2, + "enclosings": [ + { + "end": { "character": 7, "line": 16 }, + "start": { "character": 6, "line": 16 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 11, "line": 2 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 0, "line": 2 } + } + ], + "type": "sig\n val f : unit -> int\n val g : a\n val h : 'a -> 'a\n module B : sig type b = Baz val x : b * int val y : a * a end\n type t = { a : string; b : float; }\n val z : t\nend" + } |}] + +let%expect_test {| + Now, let's jump on the [10] inside of [A.B.x]. We expect + to have the type [int]. And we get a huge list of enclosings! + 0. [10:18 - 10:20] the [10] expr. + 1. [10:12 - 10:21] the [Baz, 10] expr. + 2. [07:13 - 12:05] the [struct .. end] (of [module B]) + 3. [02:11 - 17:03] the [struct .. end] (of [module A]) + 4. [02:00 - 17:03], the [module A] expr. +|} + = + let source = + {|type a = Foo | Bar + +module A = struct + let f () = 10 + let g = Bar + let h x = x + + module B = struct + type b = Baz + + let x = (Baz, 10) + let y = (Bar, Foo) + end + + type t = { a : string; b : float } + + let z = { a = "Hello"; b = 1.0 } +end|} + in + let line = 10 + and character = 18 + and verbosity = 0 + and index = 0 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 0, + "enclosings": [ + { + "end": { "character": 20, "line": 10 }, + "start": { "character": 18, "line": 10 } + }, + { + "end": { "character": 21, "line": 10 }, + "start": { "character": 12, "line": 10 } + }, + { + "end": { "character": 5, "line": 12 }, + "start": { "character": 13, "line": 7 } + }, + { + "end": { "character": 5, "line": 12 }, + "start": { "character": 2, "line": 7 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 11, "line": 2 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 0, "line": 2 } + } + ], + "type": "int" + } |}] + +let%expect_test {| + Now, let's jump on the [10] inside of [A.B.x] and ask for index [1]. + We expect to have the type [b * int]. And we keep our list of enclosings! + 0. [10:18 - 10:20] the [10] expr. + 1. [10:12 - 10:21] the [Baz, 10] expr. + 2. [07:13 - 12:05] the [struct .. end] (of [module B]) + 3. [02:11 - 17:03] the [struct .. end] (of [module A]) + 4. [02:00 - 17:03], the [module A] expr. +|} + = + let source = + {|type a = Foo | Bar + +module A = struct + let f () = 10 + let g = Bar + let h x = x + + module B = struct + type b = Baz + + let x = (Baz, 10) + let y = (Bar, Foo) + end + + type t = { a : string; b : float } + + let z = { a = "Hello"; b = 1.0 } +end|} + in + let line = 10 + and character = 18 + and verbosity = 0 + and index = 1 in + Util.test ~verbosity ~index ~line ~character source; + [%expect + {| + { + "index": 1, + "enclosings": [ + { + "end": { "character": 20, "line": 10 }, + "start": { "character": 18, "line": 10 } + }, + { + "end": { "character": 21, "line": 10 }, + "start": { "character": 12, "line": 10 } + }, + { + "end": { "character": 5, "line": 12 }, + "start": { "character": 13, "line": 7 } + }, + { + "end": { "character": 5, "line": 12 }, + "start": { "character": 2, "line": 7 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 11, "line": 2 } + }, + { + "end": { "character": 3, "line": 17 }, + "start": { "character": 0, "line": 2 } + } + ], + "type": "b * int" + } |}]