diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index 7b786e9f0..7fe775899 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -7,3 +7,5 @@ ab49baa5873e7f0b9181dbed3ad89681f1e4bcee # Upgrade to OCamlformat 0.26.1 1a6419bac3ce012deb9c6891e6b25e2486c33388 +# Upgrade to OCamlformat 0.27.0 +2ccbee5dd691690228307d3636e2f82c8cdb3902 diff --git a/.ocamlformat b/.ocamlformat index eb29ad568..00485aeea 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,3 +1,3 @@ -version=0.26.2 +version=0.27.0 profile=janestreet ocaml-version=4.14.0 diff --git a/dune-project b/dune-project index 1ac9bca9d..a583cd964 100644 --- a/dune-project +++ b/dune-project @@ -64,7 +64,7 @@ possible and does not make any assumptions about IO. astring camlp-streams (ppx_expect (and (>= v0.17.0) :with-test)) - (ocamlformat (and :with-test (= 0.26.2))) + (ocamlformat (and :with-test (= 0.27.0))) (ocamlc-loc (>= 3.7.0)) (pp (>= 1.1.2)) (csexp (>= 1.5)) diff --git a/flake.lock b/flake.lock index 423919db5..ea4a0598f 100644 --- a/flake.lock +++ b/flake.lock @@ -5,29 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1726560853, - "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", "owner": "numtide", "repo": "flake-utils", - "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_2": { - "inputs": { - "systems": "systems_2" - }, - "locked": { - "lastModified": 1726560853, - "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", "type": "github" }, "original": { @@ -56,11 +38,11 @@ "merlin5_2": { "flake": false, "locked": { - "lastModified": 1727427098, - "narHash": "sha256-ijy7MvHaVOyj99I4M7jqqollbou3ilzcWUctJCuLES4=", + "lastModified": 1736508467, + "narHash": "sha256-ZJFtPreWenLlXDokh3dOR+b3LRuZJgs9+6r+tEx9/Vo=", "owner": "ocaml", "repo": "merlin", - "rev": "0eaccc1b8520d605b1e00685e1c3f8acb5da534c", + "rev": "9dcffb9e998703f5f5d6e7c575c30cd822cea210", "type": "github" }, "original": { @@ -72,15 +54,14 @@ }, "nixpkgs": { "inputs": { - "flake-utils": "flake-utils_2", "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1727603600, - "narHash": "sha256-bffkUWgbvlDEXPR0QUyHKPuI1FdMmIZvRwIWPP14SYQ=", + "lastModified": 1736449896, + "narHash": "sha256-Ct6RqUtqIfazkg1X4o2FXWuYpw0A+OJsd3cFGtmXaqk=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "b5c11f8e03530ab94cd251871bd1a0abcf7bef54", + "rev": "be7cfa6043ed31b17e4b86769c05825c62e55829", "type": "github" }, "original": { @@ -91,17 +72,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1727552795, - "narHash": "sha256-IZJVvM+8Jwk8RgWygbfAZ7mnLk0DxGI/2HBDSNxCIio=", + "lastModified": 1736384491, + "narHash": "sha256-h0hPzFp7iVhCqzBx+kJGdO/KmG8AkYRJ0jKxQ6+diug=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "602fb03c3a4aaeb33ea15ae1c921325c593531b1", + "rev": "8e97141d59b87e2bf254cd0920be29955d45a698", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "602fb03c3a4aaeb33ea15ae1c921325c593531b1", + "rev": "8e97141d59b87e2bf254cd0920be29955d45a698", "type": "github" } }, @@ -127,21 +108,6 @@ "repo": "default", "type": "github" } - }, - "systems_2": { - "locked": { - "lastModified": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", - "type": "github" - }, - "original": { - "owner": "nix-systems", - "repo": "default", - "type": "github" - } } }, "root": "root", diff --git a/jsonrpc-fiber/src/jsonrpc_fiber.ml b/jsonrpc-fiber/src/jsonrpc_fiber.ml index b715b3d05..5d0df8c11 100644 --- a/jsonrpc-fiber/src/jsonrpc_fiber.ml +++ b/jsonrpc-fiber/src/jsonrpc_fiber.ml @@ -137,11 +137,11 @@ struct ;; let create - ?(on_request = on_request_fail) - ?(on_notification = on_notification_fail) - ~name - chan - state + ?(on_request = on_request_fail) + ?(on_notification = on_notification_fail) + ~name + chan + state = let pending = Id.Table.create 10 in { chan @@ -274,8 +274,8 @@ struct let* () = Fiber.fork_and_join_unit (fun () -> - let* () = loop () in - Fiber.Pool.stop later) + let* () = loop () in + Fiber.Pool.stop later) (fun () -> Fiber.Pool.run later) in close t) @@ -358,11 +358,10 @@ struct let pending = !batch in batch := []; let pending, ivars = - List.fold_left pending ~init:([], []) ~f:(fun (pending, ivars) -> - function - | `Notification n -> Jsonrpc.Packet.Notification n :: pending, ivars - | `Request ((r : Request.t), ivar) -> - Jsonrpc.Packet.Request r :: pending, (r.id, ivar) :: ivars) + List.fold_left pending ~init:([], []) ~f:(fun (pending, ivars) -> function + | `Notification n -> Jsonrpc.Packet.Notification n :: pending, ivars + | `Request ((r : Request.t), ivar) -> + Jsonrpc.Packet.Request r :: pending, (r.id, ivar) :: ivars) in List.iter ivars ~f:(fun (id, ivar) -> register_request_ivar t id ivar); Chan.send t.chan pending) diff --git a/jsonrpc-fiber/test/jsonrpc_fiber_tests.ml b/jsonrpc-fiber/test/jsonrpc_fiber_tests.ml index 8d1336063..c4602a8ab 100644 --- a/jsonrpc-fiber/test/jsonrpc_fiber_tests.ml +++ b/jsonrpc-fiber/test/jsonrpc_fiber_tests.ml @@ -41,7 +41,8 @@ let%expect_test "start and stop server" = Fiber.fork_and_join_unit (fun () -> run) (fun () -> Jrpc.stop jrpc) in let () = Fiber_test.test Dyn.opaque run in - [%expect {| + [%expect + {| |}] ;; @@ -62,7 +63,8 @@ let%expect_test "server accepts notifications" = Jrpc.run jrpc in Fiber_test.test Dyn.opaque run; - [%expect {| + [%expect + {| received notification |}] ;; @@ -99,7 +101,8 @@ let%expect_test "serving requests" = print_endline (Yojson.Safe.pretty_to_string ~std:false json)) in Fiber_test.test Dyn.opaque run; - [%expect {| + [%expect + {| { "id": 1, "jsonrpc": "2.0", "result": "response" } |}] ;; diff --git a/jsonrpc/src/jsonrpc.ml b/jsonrpc/src/jsonrpc.ml index 3f3fbe9fa..02be3a6bc 100644 --- a/jsonrpc/src/jsonrpc.ml +++ b/jsonrpc/src/jsonrpc.ml @@ -247,8 +247,8 @@ module Packet = struct | Batch_call r -> `List (List.map r ~f:(function - | `Request r -> Request.yojson_of_t r - | `Notification r -> Notification.yojson_of_t r)) + | `Request r -> Request.yojson_of_t r + | `Notification r -> Notification.yojson_of_t r)) ;; let t_of_fields (fields : (string * Json.t) list) = diff --git a/lsp-fiber/src/rpc.ml b/lsp-fiber/src/rpc.ml index 22fa959d1..740d6a46b 100644 --- a/lsp-fiber/src/rpc.ml +++ b/lsp-fiber/src/rpc.ml @@ -147,9 +147,9 @@ struct ;; let make - ?(on_request = on_request_default) - ?(on_notification = on_notification_default) - () + ?(on_request = on_request_default) + ?(on_notification = on_notification_default) + () = { h_on_request = on_request; h_on_notification = on_notification } ;; @@ -176,9 +176,9 @@ struct Lazy.force remove; exn)) (fun () -> - Fiber.Var.set cancel_token cancel (fun () -> - Table.replace t.pending req.id cancel; - h_on_request.on_request t r)) + Fiber.Var.set cancel_token cancel (fun () -> + Table.replace t.pending req.id cancel; + h_on_request.on_request t r)) in let to_response x = Jsonrpc.Response.ok req.id (In_request.yojson_of_result r x) @@ -192,8 +192,8 @@ struct let f send = Fiber.finalize (fun () -> - Fiber.Var.set cancel_token cancel (fun () -> - k (fun r -> send (to_response r)))) + Fiber.Var.set cancel_token cancel (fun () -> + k (fun r -> send (to_response r)))) ~finally:(fun () -> Lazy.force remove; Fiber.return ()) @@ -265,12 +265,12 @@ struct cancel ~on_cancel:(fun () -> on_cancel jsonrpc_req.id) (fun () -> - let+ resp = Session.request (Fdecl.get t.session) jsonrpc_req in - match resp.result with - | Error { code = RequestCancelled; _ } -> `Cancelled - | Ok _ when Fiber.Cancel.fired cancel -> `Cancelled - | Ok s -> `Ok (Out_request.response_of_json req s) - | Error e -> raise (Jsonrpc.Response.Error.E e)) + let+ resp = Session.request (Fdecl.get t.session) jsonrpc_req in + match resp.result with + | Error { code = RequestCancelled; _ } -> `Cancelled + | Ok _ when Fiber.Cancel.fired cancel -> `Cancelled + | Ok s -> `Ok (Out_request.response_of_json req s) + | Error e -> raise (Jsonrpc.Response.Error.E e)) in match cancel_status with | Cancelled () -> `Cancelled @@ -331,8 +331,8 @@ struct let start_loop t = Fiber.fork_and_join_unit (fun () -> - let* () = Session.run (Fdecl.get t.session) in - Fiber.Pool.stop t.detached) + let* () = Session.run (Fdecl.get t.session) in + Fiber.Pool.stop t.detached) (fun () -> Fiber.Pool.run t.detached) ;; diff --git a/lsp-fiber/test/lsp_fiber_test.ml b/lsp-fiber/test/lsp_fiber_test.ml index f849e39d8..a775968c8 100644 --- a/lsp-fiber/test/lsp_fiber_test.ml +++ b/lsp-fiber/test/lsp_fiber_test.ml @@ -6,11 +6,11 @@ open Lsp_fiber module Test = struct module Client = struct let run - ?(capabilities = ClientCapabilities.create ()) - ?on_request - ?on_notification - state - (in_, out) + ?(capabilities = ClientCapabilities.create ()) + ?on_request + ?on_notification + state + (in_, out) = let initialize = InitializeParams.create ~capabilities () in let client = diff --git a/lsp/bin/cinaps.ml b/lsp/bin/cinaps.ml index 81073a695..c07c121b5 100644 --- a/lsp/bin/cinaps.ml +++ b/lsp/bin/cinaps.ml @@ -108,8 +108,8 @@ let ocaml = (Metamodel_lsp.t () |> preprocess_metamodel#t |> (fun metamodel -> - let db = Metamodel.Entity.DB.create metamodel in - expand_superclasses db metamodel) + let db = Metamodel.Entity.DB.create metamodel in + expand_superclasses db metamodel) |> Typescript.of_metamodel |> Ocaml.of_typescript) ;; diff --git a/lsp/bin/metamodel/metamodel.ml b/lsp/bin/metamodel/metamodel.ml index d9be957da..7164d35bc 100644 --- a/lsp/bin/metamodel/metamodel.ml +++ b/lsp/bin/metamodel/metamodel.ml @@ -236,8 +236,8 @@ let rec type_ json = field "value" (fun json -> - let fields = fields_conv json in - properties fields) + let fields = fields_conv json in + properties fields) fields in Literal (Record fields) @@ -354,8 +354,8 @@ module Entity = struct type nonrec t = t String.Map.t let create - ({ structures; requests = _; notifications = _; enumerations; typeAliases } : - metamodel) + ({ structures; requests = _; notifications = _; enumerations; typeAliases } : + metamodel) : t = let structures = diff --git a/lsp/bin/ocaml/ml.mli b/lsp/bin/ocaml/ml.mli index 8545f57a3..d6d28a1b2 100644 --- a/lsp/bin/ocaml/ml.mli +++ b/lsp/bin/ocaml/ml.mli @@ -191,7 +191,7 @@ module Expr : sig (** toplevel declartion (without the name) *) type toplevel = { pat : (string Arg.t * Type.t) list - (** paterns and their types. types should be optional but they really + (** paterns and their types. types should be optional but they really help the error messages if the generated code is incorrect *) ; type_ : Type.t (** useful to annotate the return types *) ; body : t diff --git a/lsp/bin/typescript/typescript.ml b/lsp/bin/typescript/typescript.ml index c8f7847cc..e755d14cd 100644 --- a/lsp/bin/typescript/typescript.ml +++ b/lsp/bin/typescript/typescript.ml @@ -94,7 +94,7 @@ and field { Metamodel.name; optional; doc = _; type_ } : Ts_types.Unresolved.fie ;; let structure - ({ doc = _; extends = _; mixins = _; name; properties } : Metamodel.structure) + ({ doc = _; extends = _; mixins = _; name; properties } : Metamodel.structure) : Ts_types.Unresolved.t = let interface : Ts_types.Unresolved.interface = diff --git a/lsp/src/extension.ml b/lsp/src/extension.ml index dcfe4ea21..d4761b512 100644 --- a/lsp/src/extension.ml +++ b/lsp/src/extension.ml @@ -25,8 +25,9 @@ module DebugEcho = struct | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | _ -> - if Ppx_yojson_conv_lib.( ! ) - Ppx_yojson_conv_lib.Yojson_conv.record_check_extra_fields + if + Ppx_yojson_conv_lib.( ! ) + Ppx_yojson_conv_lib.Yojson_conv.record_check_extra_fields then extra := field_name :: Ppx_yojson_conv_lib.( ! ) extra else ()); iter tail diff --git a/lsp/src/import.ml b/lsp/src/import.ml index 9b3159b7e..04cfdf71b 100644 --- a/lsp/src/import.ml +++ b/lsp/src/import.ml @@ -168,12 +168,12 @@ module Json = struct ;; let literal_field - (type a) - (name : string) - (k : string) - (v : string) - (f : t -> a) - (json : t) + (type a) + (name : string) + (k : string) + (v : string) + (f : t -> a) + (json : t) : a = match json with diff --git a/lsp/src/io.ml b/lsp/src/io.ml index f4d17a336..40a6ab185 100644 --- a/lsp/src/io.ml +++ b/lsp/src/io.ml @@ -64,8 +64,9 @@ struct | None -> loop chan content_length content_type | Some (k, v) -> let k = String.trim k in - if caseless_equal k content_length_lowercase - && content_length = init_content_length + if + caseless_equal k content_length_lowercase + && content_length = init_content_length then ( let content_length = int_of_string_opt (String.trim v) in match content_length with diff --git a/lsp/src/string_zipper.ml b/lsp/src/string_zipper.ml index 2704a968d..d7a1ade1d 100644 --- a/lsp/src/string_zipper.ml +++ b/lsp/src/string_zipper.ml @@ -20,7 +20,7 @@ module T = struct ; rel_pos : int (** the cursor's position inside [current] *) ; abs_pos : int (** the total length of strings in [left] *) ; current : Substring.t - (** [current] needed to prevent fragmentation of the substring. E.g. + (** [current] needed to prevent fragmentation of the substring. E.g. so that moving inside the substring doesn't create unnecessary splits *) ; line : int (** the number of '\n' characters traversed past the current position *) diff --git a/lsp/src/text_document.ml b/lsp/src/text_document.ml index efd562429..13ea05228 100644 --- a/lsp/src/text_document.ml +++ b/lsp/src/text_document.ml @@ -29,10 +29,10 @@ type t = let position_encoding t = t.position_encoding let make - ~position_encoding - { DidOpenTextDocumentParams.textDocument = - { TextDocumentItem.languageId; text; uri; version } - } + ~position_encoding + { DidOpenTextDocumentParams.textDocument = + { TextDocumentItem.languageId; text; uri; version } + } = let zipper = String_zipper.of_string text in { text = Some text; position_encoding; zipper; uri; version; languageId } diff --git a/lsp/src/types.ml b/lsp/src/types.ml index 6bd9109c6..36c2730a3 100644 --- a/lsp/src/types.ml +++ b/lsp/src/types.ml @@ -88,8 +88,10 @@ module ProgressParams = struct let _ = fun (_ : 'a t) -> () let t_of_yojson - : 'a. - (Ppx_yojson_conv_lib.Yojson.Safe.t -> 'a) -> Ppx_yojson_conv_lib.Yojson.Safe.t -> 'a t + : 'a. + (Ppx_yojson_conv_lib.Yojson.Safe.t -> 'a) + -> Ppx_yojson_conv_lib.Yojson.Safe.t + -> 'a t = let _tp_loc = "lsp/src/types.ml.ProgressParams.t" in fun _of_a -> function @@ -161,8 +163,10 @@ module ProgressParams = struct let _ = t_of_yojson let yojson_of_t - : 'a. - ('a -> Ppx_yojson_conv_lib.Yojson.Safe.t) -> 'a t -> Ppx_yojson_conv_lib.Yojson.Safe.t + : 'a. + ('a -> Ppx_yojson_conv_lib.Yojson.Safe.t) + -> 'a t + -> Ppx_yojson_conv_lib.Yojson.Safe.t = fun _of_a -> function | { token = v_token; value = v_value } -> @@ -1680,9 +1684,9 @@ module AnnotatedTextEdit = struct [@@@end] let create - ~(annotationId : ChangeAnnotationIdentifier.t) - ~(newText : string) - ~(range : Range.t) + ~(annotationId : ChangeAnnotationIdentifier.t) + ~(newText : string) + ~(range : Range.t) : t = { annotationId; newText; range } @@ -1692,7 +1696,7 @@ end module DeleteFileOptions = struct type t = { ignoreIfNotExists : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; recursive : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -1806,9 +1810,9 @@ end module DeleteFile = struct type t = { annotationId : ChangeAnnotationIdentifier.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; options : DeleteFileOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; uri : DocumentUri.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -1947,10 +1951,10 @@ module DeleteFile = struct [@@@end] let create - ?(annotationId : ChangeAnnotationIdentifier.t option) - ?(options : DeleteFileOptions.t option) - ~(uri : DocumentUri.t) - (() : unit) + ?(annotationId : ChangeAnnotationIdentifier.t option) + ?(options : DeleteFileOptions.t option) + ~(uri : DocumentUri.t) + (() : unit) : t = { annotationId; options; uri } @@ -1966,7 +1970,7 @@ end module RenameFileOptions = struct type t = { ignoreIfExists : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; overwrite : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -2077,11 +2081,11 @@ end module RenameFile = struct type t = { annotationId : ChangeAnnotationIdentifier.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; newUri : DocumentUri.t ; oldUri : DocumentUri.t ; options : RenameFileOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -2242,11 +2246,11 @@ module RenameFile = struct [@@@end] let create - ?(annotationId : ChangeAnnotationIdentifier.t option) - ~(newUri : DocumentUri.t) - ~(oldUri : DocumentUri.t) - ?(options : RenameFileOptions.t option) - (() : unit) + ?(annotationId : ChangeAnnotationIdentifier.t option) + ~(newUri : DocumentUri.t) + ~(oldUri : DocumentUri.t) + ?(options : RenameFileOptions.t option) + (() : unit) : t = { annotationId; newUri; oldUri; options } @@ -2262,7 +2266,7 @@ end module CreateFileOptions = struct type t = { ignoreIfExists : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; overwrite : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -2373,9 +2377,9 @@ end module CreateFile = struct type t = { annotationId : ChangeAnnotationIdentifier.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; options : CreateFileOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; uri : DocumentUri.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -2514,10 +2518,10 @@ module CreateFile = struct [@@@end] let create - ?(annotationId : ChangeAnnotationIdentifier.t option) - ?(options : CreateFileOptions.t option) - ~(uri : DocumentUri.t) - (() : unit) + ?(annotationId : ChangeAnnotationIdentifier.t option) + ?(options : CreateFileOptions.t option) + ~(uri : DocumentUri.t) + (() : unit) : t = { annotationId; options; uri } @@ -2867,8 +2871,8 @@ module TextDocumentEdit = struct [@@@end] let create - ~(edits : edits_pvar list) - ~(textDocument : OptionalVersionedTextDocumentIdentifier.t) + ~(edits : edits_pvar list) + ~(textDocument : OptionalVersionedTextDocumentIdentifier.t) : t = { edits; textDocument } @@ -2878,10 +2882,10 @@ end module ChangeAnnotation = struct type t = { description : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : string ; needsConfirmation : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -3015,10 +3019,10 @@ module ChangeAnnotation = struct [@@@end] let create - ?(description : string option) - ~(label : string) - ?(needsConfirmation : bool option) - (() : unit) + ?(description : string option) + ~(label : string) + ?(needsConfirmation : bool option) + (() : unit) : t = { description; label; needsConfirmation } @@ -3058,11 +3062,11 @@ module WorkspaceEdit = struct { changeAnnotations : (ChangeAnnotationIdentifier.t, ChangeAnnotation.t) Json.Assoc.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; changes : (DocumentUri.t, TextEdit.t list) Json.Assoc.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentChanges : documentChanges_pvar list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -3217,11 +3221,11 @@ module WorkspaceEdit = struct [@@@end] let create - ?(changeAnnotations : - (ChangeAnnotationIdentifier.t, ChangeAnnotation.t) Json.Assoc.t option) - ?(changes : (DocumentUri.t, TextEdit.t list) Json.Assoc.t option) - ?(documentChanges : documentChanges_pvar list option) - (() : unit) + ?(changeAnnotations : + (ChangeAnnotationIdentifier.t, ChangeAnnotation.t) Json.Assoc.t option) + ?(changes : (DocumentUri.t, TextEdit.t list) Json.Assoc.t option) + ?(documentChanges : documentChanges_pvar list option) + (() : unit) : t = { changeAnnotations; changes; documentChanges } @@ -3343,9 +3347,9 @@ module ApplyWorkspaceEditResult = struct type t = { applied : bool ; failedChange : int Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; failureReason : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -3479,10 +3483,10 @@ module ApplyWorkspaceEditResult = struct [@@@end] let create - ~(applied : bool) - ?(failedChange : int option) - ?(failureReason : string option) - (() : unit) + ~(applied : bool) + ?(failedChange : int option) + ?(failureReason : string option) + (() : unit) : t = { applied; failedChange; failureReason } @@ -3492,11 +3496,11 @@ end module BaseSymbolInformation = struct type t = { containerName : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; kind : SymbolKind.t ; name : string ; tags : SymbolTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -3651,11 +3655,11 @@ module BaseSymbolInformation = struct [@@@end] let create - ?(containerName : string option) - ~(kind : SymbolKind.t) - ~(name : string) - ?(tags : SymbolTag.t list option) - (() : unit) + ?(containerName : string option) + ~(kind : SymbolKind.t) + ~(name : string) + ?(tags : SymbolTag.t list option) + (() : unit) : t = { containerName; kind; name; tags } @@ -3665,7 +3669,7 @@ end module CallHierarchyClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -3760,7 +3764,7 @@ module CallHierarchyItem = struct ; range : Range.t ; selectionRange : Range.t ; tags : SymbolTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; uri : DocumentUri.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -3998,15 +4002,15 @@ module CallHierarchyItem = struct [@@@end] let create - ?(data : Json.t option) - ?(detail : string option) - ~(kind : SymbolKind.t) - ~(name : string) - ~(range : Range.t) - ~(selectionRange : Range.t) - ?(tags : SymbolTag.t list option) - ~(uri : DocumentUri.t) - (() : unit) + ?(data : Json.t option) + ?(detail : string option) + ~(kind : SymbolKind.t) + ~(name : string) + ~(range : Range.t) + ~(selectionRange : Range.t) + ?(tags : SymbolTag.t list option) + ~(uri : DocumentUri.t) + (() : unit) : t = { data; detail; kind; name; range; selectionRange; tags; uri } @@ -4122,9 +4126,9 @@ module CallHierarchyIncomingCallsParams = struct type t = { item : CallHierarchyItem.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -4265,10 +4269,10 @@ module CallHierarchyIncomingCallsParams = struct [@@@end] let create - ~(item : CallHierarchyItem.t) - ?(partialResultToken : ProgressToken.t option) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(item : CallHierarchyItem.t) + ?(partialResultToken : ProgressToken.t option) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { item; partialResultToken; workDoneToken } @@ -4278,7 +4282,7 @@ end module CallHierarchyOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -4471,9 +4475,9 @@ module CallHierarchyOutgoingCallsParams = struct type t = { item : CallHierarchyItem.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -4614,10 +4618,10 @@ module CallHierarchyOutgoingCallsParams = struct [@@@end] let create - ~(item : CallHierarchyItem.t) - ?(partialResultToken : ProgressToken.t option) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(item : CallHierarchyItem.t) + ?(partialResultToken : ProgressToken.t option) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { item; partialResultToken; workDoneToken } @@ -4708,7 +4712,7 @@ module CallHierarchyPrepareParams = struct { position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -4839,10 +4843,10 @@ module CallHierarchyPrepareParams = struct [@@@end] let create - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { position; textDocument; workDoneToken } @@ -4874,7 +4878,7 @@ module NotebookCellTextDocumentFilter = struct type t = { language : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; notebook : notebook_pvar } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -5033,10 +5037,10 @@ end module CallHierarchyRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -5172,10 +5176,10 @@ module CallHierarchyRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -5263,7 +5267,7 @@ end module WorkspaceEditClientCapabilities = struct type changeAnnotationSupport = { groupsOnLabel : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -5350,15 +5354,15 @@ module WorkspaceEditClientCapabilities = struct type t = { changeAnnotationSupport : changeAnnotationSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentChanges : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; failureHandling : FailureHandlingKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; normalizesLineEndings : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resourceOperations : ResourceOperationKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -5560,12 +5564,12 @@ module WorkspaceEditClientCapabilities = struct [@@@end] let create - ?(changeAnnotationSupport : changeAnnotationSupport option) - ?(documentChanges : bool option) - ?(failureHandling : FailureHandlingKind.t option) - ?(normalizesLineEndings : bool option) - ?(resourceOperations : ResourceOperationKind.t list option) - (() : unit) + ?(changeAnnotationSupport : changeAnnotationSupport option) + ?(documentChanges : bool option) + ?(failureHandling : FailureHandlingKind.t option) + ?(normalizesLineEndings : bool option) + ?(resourceOperations : ResourceOperationKind.t list option) + (() : unit) : t = { changeAnnotationSupport @@ -5658,7 +5662,7 @@ module WorkspaceSymbolClientCapabilities = struct type symbolKind = { valueSet : SymbolKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -5824,13 +5828,13 @@ module WorkspaceSymbolClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveSupport : resolveSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; symbolKind : symbolKind Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tagSupport : tagSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -5995,11 +5999,11 @@ module WorkspaceSymbolClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(resolveSupport : resolveSupport option) - ?(symbolKind : symbolKind option) - ?(tagSupport : tagSupport option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(resolveSupport : resolveSupport option) + ?(symbolKind : symbolKind option) + ?(tagSupport : tagSupport option) + (() : unit) : t = { dynamicRegistration; resolveSupport; symbolKind; tagSupport } @@ -6009,7 +6013,7 @@ end module SemanticTokensWorkspaceClientCapabilities = struct type t = { refreshSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6092,7 +6096,7 @@ end module InlineValueWorkspaceClientCapabilities = struct type t = { refreshSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6175,7 +6179,7 @@ end module InlayHintWorkspaceClientCapabilities = struct type t = { refreshSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6258,7 +6262,7 @@ end module FoldingRangeWorkspaceClientCapabilities = struct type t = { refreshSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6344,13 +6348,13 @@ module FileOperationClientCapabilities = struct ; didDelete : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; didRename : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willCreate : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willDelete : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willRename : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6584,14 +6588,14 @@ module FileOperationClientCapabilities = struct [@@@end] let create - ?(didCreate : bool option) - ?(didDelete : bool option) - ?(didRename : bool option) - ?(dynamicRegistration : bool option) - ?(willCreate : bool option) - ?(willDelete : bool option) - ?(willRename : bool option) - (() : unit) + ?(didCreate : bool option) + ?(didDelete : bool option) + ?(didRename : bool option) + ?(dynamicRegistration : bool option) + ?(willCreate : bool option) + ?(willDelete : bool option) + ?(willRename : bool option) + (() : unit) : t = { didCreate @@ -6608,7 +6612,7 @@ end module ExecuteCommandClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6697,9 +6701,9 @@ end module DidChangeWatchedFilesClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; relativePatternSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6808,9 +6812,9 @@ module DidChangeWatchedFilesClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(relativePatternSupport : bool option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(relativePatternSupport : bool option) + (() : unit) : t = { dynamicRegistration; relativePatternSupport } @@ -6820,7 +6824,7 @@ end module DidChangeConfigurationClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6909,7 +6913,7 @@ end module DiagnosticWorkspaceClientCapabilities = struct type t = { refreshSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -6992,7 +6996,7 @@ end module CodeLensWorkspaceClientCapabilities = struct type t = { refreshSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -7076,35 +7080,35 @@ module WorkspaceClientCapabilities = struct type t = { applyEdit : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; codeLens : CodeLensWorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; configuration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; diagnostics : DiagnosticWorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; didChangeConfiguration : DidChangeConfigurationClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; didChangeWatchedFiles : DidChangeWatchedFilesClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; executeCommand : ExecuteCommandClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; fileOperations : FileOperationClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; foldingRange : FoldingRangeWorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlayHint : InlayHintWorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlineValue : InlineValueWorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; semanticTokens : SemanticTokensWorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; symbol : WorkspaceSymbolClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspaceEdit : WorkspaceEditClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspaceFolders : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -7610,22 +7614,22 @@ module WorkspaceClientCapabilities = struct [@@@end] let create - ?(applyEdit : bool option) - ?(codeLens : CodeLensWorkspaceClientCapabilities.t option) - ?(configuration : bool option) - ?(diagnostics : DiagnosticWorkspaceClientCapabilities.t option) - ?(didChangeConfiguration : DidChangeConfigurationClientCapabilities.t option) - ?(didChangeWatchedFiles : DidChangeWatchedFilesClientCapabilities.t option) - ?(executeCommand : ExecuteCommandClientCapabilities.t option) - ?(fileOperations : FileOperationClientCapabilities.t option) - ?(foldingRange : FoldingRangeWorkspaceClientCapabilities.t option) - ?(inlayHint : InlayHintWorkspaceClientCapabilities.t option) - ?(inlineValue : InlineValueWorkspaceClientCapabilities.t option) - ?(semanticTokens : SemanticTokensWorkspaceClientCapabilities.t option) - ?(symbol : WorkspaceSymbolClientCapabilities.t option) - ?(workspaceEdit : WorkspaceEditClientCapabilities.t option) - ?(workspaceFolders : bool option) - (() : unit) + ?(applyEdit : bool option) + ?(codeLens : CodeLensWorkspaceClientCapabilities.t option) + ?(configuration : bool option) + ?(diagnostics : DiagnosticWorkspaceClientCapabilities.t option) + ?(didChangeConfiguration : DidChangeConfigurationClientCapabilities.t option) + ?(didChangeWatchedFiles : DidChangeWatchedFilesClientCapabilities.t option) + ?(executeCommand : ExecuteCommandClientCapabilities.t option) + ?(fileOperations : FileOperationClientCapabilities.t option) + ?(foldingRange : FoldingRangeWorkspaceClientCapabilities.t option) + ?(inlayHint : InlayHintWorkspaceClientCapabilities.t option) + ?(inlineValue : InlineValueWorkspaceClientCapabilities.t option) + ?(semanticTokens : SemanticTokensWorkspaceClientCapabilities.t option) + ?(symbol : WorkspaceSymbolClientCapabilities.t option) + ?(workspaceEdit : WorkspaceEditClientCapabilities.t option) + ?(workspaceFolders : bool option) + (() : unit) : t = { applyEdit @@ -7650,7 +7654,7 @@ end module ShowMessageRequestClientCapabilities = struct type messageActionItem = { additionalPropertiesSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -7743,7 +7747,7 @@ module ShowMessageRequestClientCapabilities = struct type t = { messageActionItem : messageActionItem Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -7914,11 +7918,11 @@ end module WindowClientCapabilities = struct type t = { showDocument : ShowDocumentClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; showMessage : ShowMessageRequestClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8060,10 +8064,10 @@ module WindowClientCapabilities = struct [@@@end] let create - ?(showDocument : ShowDocumentClientCapabilities.t option) - ?(showMessage : ShowMessageRequestClientCapabilities.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(showDocument : ShowDocumentClientCapabilities.t option) + ?(showMessage : ShowMessageRequestClientCapabilities.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { showDocument; showMessage; workDoneProgress } @@ -8073,7 +8077,7 @@ end module TypeHierarchyClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8162,9 +8166,9 @@ end module TypeDefinitionClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; linkSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8279,10 +8283,10 @@ module TextDocumentSyncClientCapabilities = struct type t = { didSave : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willSave : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; willSaveWaitUntil : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8443,11 +8447,11 @@ module TextDocumentSyncClientCapabilities = struct [@@@end] let create - ?(didSave : bool option) - ?(dynamicRegistration : bool option) - ?(willSave : bool option) - ?(willSaveWaitUntil : bool option) - (() : unit) + ?(didSave : bool option) + ?(dynamicRegistration : bool option) + ?(willSave : bool option) + ?(willSaveWaitUntil : bool option) + (() : unit) : t = { didSave; dynamicRegistration; willSave; willSaveWaitUntil } @@ -8457,7 +8461,7 @@ end module SignatureHelpClientCapabilities = struct type parameterInformation = { labelOffsetSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8548,13 +8552,13 @@ module SignatureHelpClientCapabilities = struct type signatureInformation = { documentationFormat : MarkupKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; parameterInformation : parameterInformation Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; activeParameterSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; noActiveParameterSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8727,11 +8731,11 @@ module SignatureHelpClientCapabilities = struct [@@@end] let create_signatureInformation - ?(documentationFormat : MarkupKind.t list option) - ?(parameterInformation : parameterInformation option) - ?(activeParameterSupport : bool option) - ?(noActiveParameterSupport : bool option) - (() : unit) + ?(documentationFormat : MarkupKind.t list option) + ?(parameterInformation : parameterInformation option) + ?(activeParameterSupport : bool option) + ?(noActiveParameterSupport : bool option) + (() : unit) : signatureInformation = { documentationFormat @@ -8743,11 +8747,11 @@ module SignatureHelpClientCapabilities = struct type t = { contextSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; signatureInformation : signatureInformation Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -8886,10 +8890,10 @@ module SignatureHelpClientCapabilities = struct [@@@end] let create - ?(contextSupport : bool option) - ?(dynamicRegistration : bool option) - ?(signatureInformation : signatureInformation option) - (() : unit) + ?(contextSupport : bool option) + ?(dynamicRegistration : bool option) + ?(signatureInformation : signatureInformation option) + (() : unit) : t = { contextSupport; dynamicRegistration; signatureInformation } @@ -9108,17 +9112,17 @@ module SemanticTokensClientCapabilities = struct type t = { augmentsSyntaxTokens : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; formats : TokenFormat.t list ; multilineTokenSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; overlappingTokenSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; requests : requests ; serverCancelSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tokenModifiers : string list ; tokenTypes : string list } @@ -9397,16 +9401,16 @@ module SemanticTokensClientCapabilities = struct [@@@end] let create - ?(augmentsSyntaxTokens : bool option) - ?(dynamicRegistration : bool option) - ~(formats : TokenFormat.t list) - ?(multilineTokenSupport : bool option) - ?(overlappingTokenSupport : bool option) - ~(requests : requests) - ?(serverCancelSupport : bool option) - ~(tokenModifiers : string list) - ~(tokenTypes : string list) - (() : unit) + ?(augmentsSyntaxTokens : bool option) + ?(dynamicRegistration : bool option) + ~(formats : TokenFormat.t list) + ?(multilineTokenSupport : bool option) + ?(overlappingTokenSupport : bool option) + ~(requests : requests) + ?(serverCancelSupport : bool option) + ~(tokenModifiers : string list) + ~(tokenTypes : string list) + (() : unit) : t = { augmentsSyntaxTokens @@ -9425,7 +9429,7 @@ end module SelectionRangeClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -9514,14 +9518,14 @@ end module RenameClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; honorsChangeAnnotations : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; prepareSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; prepareSupportDefaultBehavior : PrepareSupportDefaultBehavior.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -9688,11 +9692,11 @@ module RenameClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(honorsChangeAnnotations : bool option) - ?(prepareSupport : bool option) - ?(prepareSupportDefaultBehavior : PrepareSupportDefaultBehavior.t option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(honorsChangeAnnotations : bool option) + ?(prepareSupport : bool option) + ?(prepareSupportDefaultBehavior : PrepareSupportDefaultBehavior.t option) + (() : unit) : t = { dynamicRegistration @@ -9706,7 +9710,7 @@ end module ReferenceClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -9795,9 +9799,9 @@ end module DocumentRangeFormattingClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rangesSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -9902,9 +9906,9 @@ module DocumentRangeFormattingClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(rangesSupport : bool option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(rangesSupport : bool option) + (() : unit) : t = { dynamicRegistration; rangesSupport } @@ -9992,15 +9996,15 @@ module PublishDiagnosticsClientCapabilities = struct type t = { codeDescriptionSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dataSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; relatedInformation : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tagSupport : tagSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; versionSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10188,12 +10192,12 @@ module PublishDiagnosticsClientCapabilities = struct [@@@end] let create - ?(codeDescriptionSupport : bool option) - ?(dataSupport : bool option) - ?(relatedInformation : bool option) - ?(tagSupport : tagSupport option) - ?(versionSupport : bool option) - (() : unit) + ?(codeDescriptionSupport : bool option) + ?(dataSupport : bool option) + ?(relatedInformation : bool option) + ?(tagSupport : tagSupport option) + ?(versionSupport : bool option) + (() : unit) : t = { codeDescriptionSupport @@ -10208,7 +10212,7 @@ end module DocumentOnTypeFormattingClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10297,7 +10301,7 @@ end module MonikerClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10386,7 +10390,7 @@ end module LinkedEditingRangeClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10475,7 +10479,7 @@ end module InlineValueClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10564,7 +10568,7 @@ end module InlineCompletionClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10731,9 +10735,9 @@ module InlayHintClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveSupport : resolveSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10841,9 +10845,9 @@ module InlayHintClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(resolveSupport : resolveSupport option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(resolveSupport : resolveSupport option) + (() : unit) : t = { dynamicRegistration; resolveSupport } @@ -10853,9 +10857,9 @@ end module ImplementationClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; linkSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -10969,9 +10973,9 @@ end module HoverClientCapabilities = struct type t = { contentFormat : MarkupKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11081,9 +11085,9 @@ module HoverClientCapabilities = struct [@@@end] let create - ?(contentFormat : MarkupKind.t list option) - ?(dynamicRegistration : bool option) - (() : unit) + ?(contentFormat : MarkupKind.t list option) + ?(dynamicRegistration : bool option) + (() : unit) : t = { contentFormat; dynamicRegistration } @@ -11093,7 +11097,7 @@ end module DocumentFormattingClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11182,7 +11186,7 @@ end module FoldingRangeClientCapabilities = struct type foldingRangeKind = { valueSet : FoldingRangeKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11273,7 +11277,7 @@ module FoldingRangeClientCapabilities = struct type foldingRange = { collapsedText : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11356,13 +11360,13 @@ module FoldingRangeClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; foldingRange : foldingRange Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; foldingRangeKind : foldingRangeKind Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; lineFoldingOnly : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rangeLimit : int Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11556,12 +11560,12 @@ module FoldingRangeClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(foldingRange : foldingRange option) - ?(foldingRangeKind : foldingRangeKind option) - ?(lineFoldingOnly : bool option) - ?(rangeLimit : int option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(foldingRange : foldingRange option) + ?(foldingRangeKind : foldingRangeKind option) + ?(lineFoldingOnly : bool option) + ?(rangeLimit : int option) + (() : unit) : t = { dynamicRegistration; foldingRange; foldingRangeKind; lineFoldingOnly; rangeLimit } @@ -11649,7 +11653,7 @@ module DocumentSymbolClientCapabilities = struct type symbolKind = { valueSet : SymbolKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11737,15 +11741,15 @@ module DocumentSymbolClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; hierarchicalDocumentSymbolSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; labelSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; symbolKind : symbolKind Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tagSupport : tagSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -11939,12 +11943,12 @@ module DocumentSymbolClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(hierarchicalDocumentSymbolSupport : bool option) - ?(labelSupport : bool option) - ?(symbolKind : symbolKind option) - ?(tagSupport : tagSupport option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(hierarchicalDocumentSymbolSupport : bool option) + ?(labelSupport : bool option) + ?(symbolKind : symbolKind option) + ?(tagSupport : tagSupport option) + (() : unit) : t = { dynamicRegistration @@ -11959,9 +11963,9 @@ end module DocumentLinkClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tooltipSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12067,9 +12071,9 @@ module DocumentLinkClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(tooltipSupport : bool option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(tooltipSupport : bool option) + (() : unit) : t = { dynamicRegistration; tooltipSupport } @@ -12079,7 +12083,7 @@ end module DocumentHighlightClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12168,11 +12172,11 @@ end module DiagnosticClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; markupMessageSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; relatedDocumentSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12310,10 +12314,10 @@ module DiagnosticClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(markupMessageSupport : bool option) - ?(relatedDocumentSupport : bool option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(markupMessageSupport : bool option) + ?(relatedDocumentSupport : bool option) + (() : unit) : t = { dynamicRegistration; markupMessageSupport; relatedDocumentSupport } @@ -12323,9 +12327,9 @@ end module DefinitionClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; linkSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12439,9 +12443,9 @@ end module DeclarationClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; linkSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12555,7 +12559,7 @@ end module CompletionClientCapabilities = struct type completionList = { itemDefaults : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12645,7 +12649,7 @@ module CompletionClientCapabilities = struct type completionItemKind = { valueSet : CompletionItemKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -12978,25 +12982,25 @@ module CompletionClientCapabilities = struct type completionItem = { snippetSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; commitCharactersSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentationFormat : MarkupKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; deprecatedSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; preselectSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tagSupport : tagSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertReplaceSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveSupport : resolveSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertTextModeSupport : insertTextModeSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; labelDetailsSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -13327,17 +13331,17 @@ module CompletionClientCapabilities = struct [@@@end] let create_completionItem - ?(snippetSupport : bool option) - ?(commitCharactersSupport : bool option) - ?(documentationFormat : MarkupKind.t list option) - ?(deprecatedSupport : bool option) - ?(preselectSupport : bool option) - ?(tagSupport : tagSupport option) - ?(insertReplaceSupport : bool option) - ?(resolveSupport : resolveSupport option) - ?(insertTextModeSupport : insertTextModeSupport option) - ?(labelDetailsSupport : bool option) - (() : unit) + ?(snippetSupport : bool option) + ?(commitCharactersSupport : bool option) + ?(documentationFormat : MarkupKind.t list option) + ?(deprecatedSupport : bool option) + ?(preselectSupport : bool option) + ?(tagSupport : tagSupport option) + ?(insertReplaceSupport : bool option) + ?(resolveSupport : resolveSupport option) + ?(insertTextModeSupport : insertTextModeSupport option) + ?(labelDetailsSupport : bool option) + (() : unit) : completionItem = { snippetSupport @@ -13355,17 +13359,17 @@ module CompletionClientCapabilities = struct type t = { completionItem : completionItem Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; completionItemKind : completionItemKind Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; completionList : completionList Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; contextSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertTextMode : InsertTextMode.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -13588,13 +13592,13 @@ module CompletionClientCapabilities = struct [@@@end] let create - ?(completionItem : completionItem option) - ?(completionItemKind : completionItemKind option) - ?(completionList : completionList option) - ?(contextSupport : bool option) - ?(dynamicRegistration : bool option) - ?(insertTextMode : InsertTextMode.t option) - (() : unit) + ?(completionItem : completionItem option) + ?(completionItemKind : completionItemKind option) + ?(completionList : completionList option) + ?(contextSupport : bool option) + ?(dynamicRegistration : bool option) + ?(insertTextMode : InsertTextMode.t option) + (() : unit) : t = { completionItem @@ -13610,7 +13614,7 @@ end module DocumentColorClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -13699,7 +13703,7 @@ end module CodeLensClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -14030,19 +14034,19 @@ module CodeActionClientCapabilities = struct type t = { codeActionLiteralSupport : codeActionLiteralSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dataSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; disabledSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; honorsChangeAnnotations : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; isPreferredSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveSupport : resolveSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -14289,14 +14293,14 @@ module CodeActionClientCapabilities = struct [@@@end] let create - ?(codeActionLiteralSupport : codeActionLiteralSupport option) - ?(dataSupport : bool option) - ?(disabledSupport : bool option) - ?(dynamicRegistration : bool option) - ?(honorsChangeAnnotations : bool option) - ?(isPreferredSupport : bool option) - ?(resolveSupport : resolveSupport option) - (() : unit) + ?(codeActionLiteralSupport : codeActionLiteralSupport option) + ?(dataSupport : bool option) + ?(disabledSupport : bool option) + ?(dynamicRegistration : bool option) + ?(honorsChangeAnnotations : bool option) + ?(isPreferredSupport : bool option) + ?(resolveSupport : resolveSupport option) + (() : unit) : t = { codeActionLiteralSupport @@ -14313,68 +14317,68 @@ end module TextDocumentClientCapabilities = struct type t = { callHierarchy : CallHierarchyClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; codeAction : CodeActionClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; codeLens : CodeLensClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; colorProvider : DocumentColorClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; completion : CompletionClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; declaration : DeclarationClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; definition : DefinitionClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; diagnostic : DiagnosticClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentHighlight : DocumentHighlightClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentLink : DocumentLinkClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentSymbol : DocumentSymbolClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; foldingRange : FoldingRangeClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; formatting : DocumentFormattingClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; hover : HoverClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; implementation : ImplementationClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlayHint : InlayHintClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlineCompletion : InlineCompletionClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlineValue : InlineValueClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; linkedEditingRange : LinkedEditingRangeClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; moniker : MonikerClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; onTypeFormatting : DocumentOnTypeFormattingClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; publishDiagnostics : PublishDiagnosticsClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rangeFormatting : DocumentRangeFormattingClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; references : ReferenceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rename : RenameClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; selectionRange : SelectionRangeClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; semanticTokens : SemanticTokensClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; signatureHelp : SignatureHelpClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; synchronization : TextDocumentSyncClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; typeDefinition : TypeDefinitionClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; typeHierarchy : TypeHierarchyClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -15378,38 +15382,38 @@ module TextDocumentClientCapabilities = struct [@@@end] let create - ?(callHierarchy : CallHierarchyClientCapabilities.t option) - ?(codeAction : CodeActionClientCapabilities.t option) - ?(codeLens : CodeLensClientCapabilities.t option) - ?(colorProvider : DocumentColorClientCapabilities.t option) - ?(completion : CompletionClientCapabilities.t option) - ?(declaration : DeclarationClientCapabilities.t option) - ?(definition : DefinitionClientCapabilities.t option) - ?(diagnostic : DiagnosticClientCapabilities.t option) - ?(documentHighlight : DocumentHighlightClientCapabilities.t option) - ?(documentLink : DocumentLinkClientCapabilities.t option) - ?(documentSymbol : DocumentSymbolClientCapabilities.t option) - ?(foldingRange : FoldingRangeClientCapabilities.t option) - ?(formatting : DocumentFormattingClientCapabilities.t option) - ?(hover : HoverClientCapabilities.t option) - ?(implementation : ImplementationClientCapabilities.t option) - ?(inlayHint : InlayHintClientCapabilities.t option) - ?(inlineCompletion : InlineCompletionClientCapabilities.t option) - ?(inlineValue : InlineValueClientCapabilities.t option) - ?(linkedEditingRange : LinkedEditingRangeClientCapabilities.t option) - ?(moniker : MonikerClientCapabilities.t option) - ?(onTypeFormatting : DocumentOnTypeFormattingClientCapabilities.t option) - ?(publishDiagnostics : PublishDiagnosticsClientCapabilities.t option) - ?(rangeFormatting : DocumentRangeFormattingClientCapabilities.t option) - ?(references : ReferenceClientCapabilities.t option) - ?(rename : RenameClientCapabilities.t option) - ?(selectionRange : SelectionRangeClientCapabilities.t option) - ?(semanticTokens : SemanticTokensClientCapabilities.t option) - ?(signatureHelp : SignatureHelpClientCapabilities.t option) - ?(synchronization : TextDocumentSyncClientCapabilities.t option) - ?(typeDefinition : TypeDefinitionClientCapabilities.t option) - ?(typeHierarchy : TypeHierarchyClientCapabilities.t option) - (() : unit) + ?(callHierarchy : CallHierarchyClientCapabilities.t option) + ?(codeAction : CodeActionClientCapabilities.t option) + ?(codeLens : CodeLensClientCapabilities.t option) + ?(colorProvider : DocumentColorClientCapabilities.t option) + ?(completion : CompletionClientCapabilities.t option) + ?(declaration : DeclarationClientCapabilities.t option) + ?(definition : DefinitionClientCapabilities.t option) + ?(diagnostic : DiagnosticClientCapabilities.t option) + ?(documentHighlight : DocumentHighlightClientCapabilities.t option) + ?(documentLink : DocumentLinkClientCapabilities.t option) + ?(documentSymbol : DocumentSymbolClientCapabilities.t option) + ?(foldingRange : FoldingRangeClientCapabilities.t option) + ?(formatting : DocumentFormattingClientCapabilities.t option) + ?(hover : HoverClientCapabilities.t option) + ?(implementation : ImplementationClientCapabilities.t option) + ?(inlayHint : InlayHintClientCapabilities.t option) + ?(inlineCompletion : InlineCompletionClientCapabilities.t option) + ?(inlineValue : InlineValueClientCapabilities.t option) + ?(linkedEditingRange : LinkedEditingRangeClientCapabilities.t option) + ?(moniker : MonikerClientCapabilities.t option) + ?(onTypeFormatting : DocumentOnTypeFormattingClientCapabilities.t option) + ?(publishDiagnostics : PublishDiagnosticsClientCapabilities.t option) + ?(rangeFormatting : DocumentRangeFormattingClientCapabilities.t option) + ?(references : ReferenceClientCapabilities.t option) + ?(rename : RenameClientCapabilities.t option) + ?(selectionRange : SelectionRangeClientCapabilities.t option) + ?(semanticTokens : SemanticTokensClientCapabilities.t option) + ?(signatureHelp : SignatureHelpClientCapabilities.t option) + ?(synchronization : TextDocumentSyncClientCapabilities.t option) + ?(typeDefinition : TypeDefinitionClientCapabilities.t option) + ?(typeHierarchy : TypeHierarchyClientCapabilities.t option) + (() : unit) : t = { callHierarchy @@ -15450,9 +15454,9 @@ end module NotebookDocumentSyncClientCapabilities = struct type t = { dynamicRegistration : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; executionSummarySupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -15561,9 +15565,9 @@ module NotebookDocumentSyncClientCapabilities = struct [@@@end] let create - ?(dynamicRegistration : bool option) - ?(executionSummarySupport : bool option) - (() : unit) + ?(dynamicRegistration : bool option) + ?(executionSummarySupport : bool option) + (() : unit) : t = { dynamicRegistration; executionSummarySupport } @@ -15768,7 +15772,7 @@ end module MarkdownClientCapabilities = struct type t = { allowedTags : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; parser : string ; version : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } @@ -15904,10 +15908,10 @@ module MarkdownClientCapabilities = struct [@@@end] let create - ?(allowedTags : string list option) - ~(parser : string) - ?(version : string option) - (() : unit) + ?(allowedTags : string list option) + ~(parser : string) + ?(version : string option) + (() : unit) : t = { allowedTags; parser; version } @@ -16024,13 +16028,13 @@ module GeneralClientCapabilities = struct type t = { markdown : MarkdownClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; positionEncodings : PositionEncodingKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; regularExpressions : RegularExpressionsClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; staleRequestSupport : staleRequestSupport Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -16209,11 +16213,11 @@ module GeneralClientCapabilities = struct [@@@end] let create - ?(markdown : MarkdownClientCapabilities.t option) - ?(positionEncodings : PositionEncodingKind.t list option) - ?(regularExpressions : RegularExpressionsClientCapabilities.t option) - ?(staleRequestSupport : staleRequestSupport option) - (() : unit) + ?(markdown : MarkdownClientCapabilities.t option) + ?(positionEncodings : PositionEncodingKind.t list option) + ?(regularExpressions : RegularExpressionsClientCapabilities.t option) + ?(staleRequestSupport : staleRequestSupport option) + (() : unit) : t = { markdown; positionEncodings; regularExpressions; staleRequestSupport } @@ -16224,15 +16228,15 @@ module ClientCapabilities = struct type t = { experimental : Json.t option [@yojson.option] ; general : GeneralClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; notebookDocument : NotebookDocumentClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; window : WindowClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspace : WorkspaceClientCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -16460,13 +16464,13 @@ module ClientCapabilities = struct [@@@end] let create - ?(experimental : Json.t option) - ?(general : GeneralClientCapabilities.t option) - ?(notebookDocument : NotebookDocumentClientCapabilities.t option) - ?(textDocument : TextDocumentClientCapabilities.t option) - ?(window : WindowClientCapabilities.t option) - ?(workspace : WorkspaceClientCapabilities.t option) - (() : unit) + ?(experimental : Json.t option) + ?(general : GeneralClientCapabilities.t option) + ?(notebookDocument : NotebookDocumentClientCapabilities.t option) + ?(textDocument : TextDocumentClientCapabilities.t option) + ?(window : WindowClientCapabilities.t option) + ?(workspace : WorkspaceClientCapabilities.t option) + (() : unit) : t = { experimental; general; notebookDocument; textDocument; window; workspace } @@ -16884,19 +16888,19 @@ module Diagnostic = struct type t = { code : Jsonrpc.Id.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; codeDescription : CodeDescription.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : Json.t option [@yojson.option] ; message : message_pvar ; range : Range.t ; relatedInformation : DiagnosticRelatedInformation.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; severity : DiagnosticSeverity.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; source : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; tags : DiagnosticTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -17188,16 +17192,16 @@ module Diagnostic = struct [@@@end] let create - ?(code : Jsonrpc.Id.t option) - ?(codeDescription : CodeDescription.t option) - ?(data : Json.t option) - ~(message : message_pvar) - ~(range : Range.t) - ?(relatedInformation : DiagnosticRelatedInformation.t list option) - ?(severity : DiagnosticSeverity.t option) - ?(source : string option) - ?(tags : DiagnosticTag.t list option) - (() : unit) + ?(code : Jsonrpc.Id.t option) + ?(codeDescription : CodeDescription.t option) + ?(data : Json.t option) + ~(message : message_pvar) + ~(range : Range.t) + ?(relatedInformation : DiagnosticRelatedInformation.t list option) + ?(severity : DiagnosticSeverity.t option) + ?(source : string option) + ?(tags : DiagnosticTag.t list option) + (() : unit) : t = { code @@ -17216,7 +17220,7 @@ end module Command = struct type t = { arguments : Json.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; command : string ; title : string } @@ -17347,10 +17351,10 @@ module Command = struct [@@@end] let create - ?(arguments : Json.t list option) - ~(command : string) - ~(title : string) - (() : unit) + ?(arguments : Json.t list option) + ~(command : string) + ~(title : string) + (() : unit) : t = { arguments; command; title } @@ -17437,18 +17441,18 @@ module CodeAction = struct type t = { command : Command.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : Json.t option [@yojson.option] ; diagnostics : Diagnostic.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; disabled : disabled Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; edit : WorkspaceEdit.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; isPreferred : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; kind : CodeActionKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; title : string } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -17714,15 +17718,15 @@ module CodeAction = struct [@@@end] let create - ?(command : Command.t option) - ?(data : Json.t option) - ?(diagnostics : Diagnostic.t list option) - ?(disabled : disabled option) - ?(edit : WorkspaceEdit.t option) - ?(isPreferred : bool option) - ?(kind : CodeActionKind.t option) - ~(title : string) - (() : unit) + ?(command : Command.t option) + ?(data : Json.t option) + ?(diagnostics : Diagnostic.t list option) + ?(disabled : disabled option) + ?(edit : WorkspaceEdit.t option) + ?(isPreferred : bool option) + ?(kind : CodeActionKind.t option) + ~(title : string) + (() : unit) : t = { command; data; diagnostics; disabled; edit; isPreferred; kind; title } @@ -17733,9 +17737,9 @@ module CodeActionContext = struct type t = { diagnostics : Diagnostic.t list ; only : CodeActionKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerKind : CodeActionTriggerKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -17875,10 +17879,10 @@ module CodeActionContext = struct [@@@end] let create - ~(diagnostics : Diagnostic.t list) - ?(only : CodeActionKind.t list option) - ?(triggerKind : CodeActionTriggerKind.t option) - (() : unit) + ~(diagnostics : Diagnostic.t list) + ?(only : CodeActionKind.t list option) + ?(triggerKind : CodeActionTriggerKind.t option) + (() : unit) : t = { diagnostics; only; triggerKind } @@ -17888,11 +17892,11 @@ end module CodeActionOptions = struct type t = { codeActionKinds : CodeActionKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -18031,10 +18035,10 @@ module CodeActionOptions = struct [@@@end] let create - ?(codeActionKinds : CodeActionKind.t list option) - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(codeActionKinds : CodeActionKind.t list option) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { codeActionKinds; resolveProvider; workDoneProgress } @@ -18045,11 +18049,11 @@ module CodeActionParams = struct type t = { context : CodeActionContext.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; range : Range.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -18230,12 +18234,12 @@ module CodeActionParams = struct [@@@end] let create - ~(context : CodeActionContext.t) - ?(partialResultToken : ProgressToken.t option) - ~(range : Range.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(context : CodeActionContext.t) + ?(partialResultToken : ProgressToken.t option) + ~(range : Range.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { context; partialResultToken; range; textDocument; workDoneToken } @@ -18245,13 +18249,13 @@ end module CodeActionRegistrationOptions = struct type t = { codeActionKinds : CodeActionKind.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -18423,11 +18427,11 @@ module CodeActionRegistrationOptions = struct [@@@end] let create - ?(codeActionKinds : CodeActionKind.t list option) - ?(documentSelector : DocumentSelector.t option) - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(codeActionKinds : CodeActionKind.t list option) + ?(documentSelector : DocumentSelector.t option) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { codeActionKinds; documentSelector; resolveProvider; workDoneProgress } @@ -18437,7 +18441,7 @@ end module CodeLens = struct type t = { command : Command.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : Json.t option [@yojson.option] ; range : Range.t } @@ -18561,10 +18565,10 @@ module CodeLens = struct [@@@end] let create - ?(command : Command.t option) - ?(data : Json.t option) - ~(range : Range.t) - (() : unit) + ?(command : Command.t option) + ?(data : Json.t option) + ~(range : Range.t) + (() : unit) : t = { command; data; range } @@ -18574,9 +18578,9 @@ end module CodeLensOptions = struct type t = { resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -18683,9 +18687,9 @@ module CodeLensOptions = struct [@@@end] let create - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { resolveProvider; workDoneProgress } @@ -18695,10 +18699,10 @@ end module CodeLensParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -18839,10 +18843,10 @@ module CodeLensParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; textDocument; workDoneToken } @@ -18852,11 +18856,11 @@ end module CodeLensRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -18994,10 +18998,10 @@ module CodeLensRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; resolveProvider; workDoneProgress } @@ -19257,10 +19261,10 @@ end module ColorPresentation = struct type t = { additionalTextEdits : TextEdit.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : string ; textEdit : TextEdit.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -19397,10 +19401,10 @@ module ColorPresentation = struct [@@@end] let create - ?(additionalTextEdits : TextEdit.t list option) - ~(label : string) - ?(textEdit : TextEdit.t option) - (() : unit) + ?(additionalTextEdits : TextEdit.t list option) + ~(label : string) + ?(textEdit : TextEdit.t option) + (() : unit) : t = { additionalTextEdits; label; textEdit } @@ -19411,11 +19415,11 @@ module ColorPresentationParams = struct type t = { color : Color.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; range : Range.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -19596,12 +19600,12 @@ module ColorPresentationParams = struct [@@@end] let create - ~(color : Color.t) - ?(partialResultToken : ProgressToken.t option) - ~(range : Range.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(color : Color.t) + ?(partialResultToken : ProgressToken.t option) + ~(range : Range.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { color; partialResultToken; range; textDocument; workDoneToken } @@ -19611,7 +19615,7 @@ end module CompletionContext = struct type t = { triggerCharacter : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerKind : CompletionTriggerKind.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -19719,9 +19723,9 @@ module CompletionContext = struct [@@@end] let create - ?(triggerCharacter : string option) - ~(triggerKind : CompletionTriggerKind.t) - (() : unit) + ?(triggerCharacter : string option) + ~(triggerKind : CompletionTriggerKind.t) + (() : unit) : t = { triggerCharacter; triggerKind } @@ -19858,7 +19862,7 @@ end module CompletionItemLabelDetails = struct type t = { description : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; detail : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -20010,39 +20014,39 @@ module CompletionItem = struct type t = { additionalTextEdits : TextEdit.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; command : Command.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; commitCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : Json.t option [@yojson.option] ; deprecated : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; detail : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; documentation : documentation_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; filterText : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertText : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertTextFormat : InsertTextFormat.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertTextMode : InsertTextMode.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; kind : CompletionItemKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : string ; labelDetails : CompletionItemLabelDetails.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; preselect : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; sortText : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tags : CompletionItemTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textEdit : textEdit_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textEditText : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -20611,26 +20615,26 @@ module CompletionItem = struct [@@@end] let create - ?(additionalTextEdits : TextEdit.t list option) - ?(command : Command.t option) - ?(commitCharacters : string list option) - ?(data : Json.t option) - ?(deprecated : bool option) - ?(detail : string option) - ?(documentation : documentation_pvar option) - ?(filterText : string option) - ?(insertText : string option) - ?(insertTextFormat : InsertTextFormat.t option) - ?(insertTextMode : InsertTextMode.t option) - ?(kind : CompletionItemKind.t option) - ~(label : string) - ?(labelDetails : CompletionItemLabelDetails.t option) - ?(preselect : bool option) - ?(sortText : string option) - ?(tags : CompletionItemTag.t list option) - ?(textEdit : textEdit_pvar option) - ?(textEditText : string option) - (() : unit) + ?(additionalTextEdits : TextEdit.t list option) + ?(command : Command.t option) + ?(commitCharacters : string list option) + ?(data : Json.t option) + ?(deprecated : bool option) + ?(detail : string option) + ?(documentation : documentation_pvar option) + ?(filterText : string option) + ?(insertText : string option) + ?(insertTextFormat : InsertTextFormat.t option) + ?(insertTextMode : InsertTextMode.t option) + ?(kind : CompletionItemKind.t option) + ~(label : string) + ?(labelDetails : CompletionItemLabelDetails.t option) + ?(preselect : bool option) + ?(sortText : string option) + ?(tags : CompletionItemTag.t list option) + ?(textEdit : textEdit_pvar option) + ?(textEditText : string option) + (() : unit) : t = { additionalTextEdits @@ -20782,13 +20786,13 @@ module CompletionList = struct type itemDefaults = { commitCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; editRange : editRange_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertTextFormat : InsertTextFormat.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertTextMode : InsertTextMode.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : Json.t option [@yojson.option] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -20983,12 +20987,12 @@ module CompletionList = struct [@@@end] let create_itemDefaults - ?(commitCharacters : string list option) - ?(editRange : editRange_pvar option) - ?(insertTextFormat : InsertTextFormat.t option) - ?(insertTextMode : InsertTextMode.t option) - ?(data : Json.t option) - (() : unit) + ?(commitCharacters : string list option) + ?(editRange : editRange_pvar option) + ?(insertTextFormat : InsertTextFormat.t option) + ?(insertTextMode : InsertTextMode.t option) + ?(data : Json.t option) + (() : unit) : itemDefaults = { commitCharacters; editRange; insertTextFormat; insertTextMode; data } @@ -20997,7 +21001,7 @@ module CompletionList = struct type t = { isIncomplete : bool ; itemDefaults : itemDefaults Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; items : CompletionItem.t list } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -21125,10 +21129,10 @@ module CompletionList = struct [@@@end] let create - ~(isIncomplete : bool) - ?(itemDefaults : itemDefaults option) - ~(items : CompletionItem.t list) - (() : unit) + ~(isIncomplete : bool) + ?(itemDefaults : itemDefaults option) + ~(items : CompletionItem.t list) + (() : unit) : t = { isIncomplete; itemDefaults; items } @@ -21138,7 +21142,7 @@ end module CompletionOptions = struct type completionItem = { labelDetailsSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -21227,15 +21231,15 @@ module CompletionOptions = struct type t = { allCommitCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; completionItem : completionItem Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -21433,12 +21437,12 @@ module CompletionOptions = struct [@@@end] let create - ?(allCommitCharacters : string list option) - ?(completionItem : completionItem option) - ?(resolveProvider : bool option) - ?(triggerCharacters : string list option) - ?(workDoneProgress : bool option) - (() : unit) + ?(allCommitCharacters : string list option) + ?(completionItem : completionItem option) + ?(resolveProvider : bool option) + ?(triggerCharacters : string list option) + ?(workDoneProgress : bool option) + (() : unit) : t = { allCommitCharacters @@ -21453,13 +21457,13 @@ end module CompletionParams = struct type t = { context : CompletionContext.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -21649,12 +21653,12 @@ module CompletionParams = struct [@@@end] let create - ?(context : CompletionContext.t option) - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(context : CompletionContext.t option) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { context; partialResultToken; position; textDocument; workDoneToken } @@ -21664,7 +21668,7 @@ end module CompletionRegistrationOptions = struct type completionItem = { labelDetailsSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -21753,17 +21757,17 @@ module CompletionRegistrationOptions = struct type t = { allCommitCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; completionItem : completionItem Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -21991,13 +21995,13 @@ module CompletionRegistrationOptions = struct [@@@end] let create - ?(allCommitCharacters : string list option) - ?(completionItem : completionItem option) - ?(documentSelector : DocumentSelector.t option) - ?(resolveProvider : bool option) - ?(triggerCharacters : string list option) - ?(workDoneProgress : bool option) - (() : unit) + ?(allCommitCharacters : string list option) + ?(completionItem : completionItem option) + ?(documentSelector : DocumentSelector.t option) + ?(resolveProvider : bool option) + ?(triggerCharacters : string list option) + ?(workDoneProgress : bool option) + (() : unit) : t = { allCommitCharacters @@ -22013,7 +22017,7 @@ end module ConfigurationItem = struct type t = { scopeUri : DocumentUri.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; section : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -22387,7 +22391,7 @@ end module LocationLink = struct type t = { originSelectionRange : Range.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; targetRange : Range.t ; targetSelectionRange : Range.t ; targetUri : DocumentUri.t @@ -22539,11 +22543,11 @@ module LocationLink = struct [@@@end] let create - ?(originSelectionRange : Range.t option) - ~(targetRange : Range.t) - ~(targetSelectionRange : Range.t) - ~(targetUri : DocumentUri.t) - (() : unit) + ?(originSelectionRange : Range.t option) + ~(targetRange : Range.t) + ~(targetSelectionRange : Range.t) + ~(targetUri : DocumentUri.t) + (() : unit) : t = { originSelectionRange; targetRange; targetSelectionRange; targetUri } @@ -22565,7 +22569,7 @@ end module DeclarationOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -22652,11 +22656,11 @@ end module DeclarationParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -22817,11 +22821,11 @@ module DeclarationParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; position; textDocument; workDoneToken } @@ -22831,10 +22835,10 @@ end module DeclarationRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -22970,10 +22974,10 @@ module DeclarationRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -23017,7 +23021,7 @@ end module DefinitionOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -23104,11 +23108,11 @@ end module DefinitionParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -23269,11 +23273,11 @@ module DefinitionParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; position; textDocument; workDoneToken } @@ -23283,9 +23287,9 @@ end module DefinitionRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -23395,9 +23399,9 @@ module DefinitionRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; workDoneProgress } @@ -23564,10 +23568,10 @@ end module DiagnosticOptions = struct type t = { identifier : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; interFileDependencies : bool ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspaceDiagnostics : bool } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -23722,11 +23726,11 @@ module DiagnosticOptions = struct [@@@end] let create - ?(identifier : string option) - ~(interFileDependencies : bool) - ?(workDoneProgress : bool option) - ~(workspaceDiagnostics : bool) - (() : unit) + ?(identifier : string option) + ~(interFileDependencies : bool) + ?(workDoneProgress : bool option) + ~(workspaceDiagnostics : bool) + (() : unit) : t = { identifier; interFileDependencies; workDoneProgress; workspaceDiagnostics } @@ -23736,13 +23740,13 @@ end module DiagnosticRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; identifier : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; interFileDependencies : bool ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspaceDiagnostics : bool } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -23952,13 +23956,13 @@ module DiagnosticRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(identifier : string option) - ~(interFileDependencies : bool) - ?(workDoneProgress : bool option) - ~(workspaceDiagnostics : bool) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(identifier : string option) + ~(interFileDependencies : bool) + ?(workDoneProgress : bool option) + ~(workspaceDiagnostics : bool) + (() : unit) : t = { documentSelector @@ -24154,7 +24158,7 @@ module DidChangeConfigurationRegistrationOptions = struct type t = { section : section_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -24343,7 +24347,7 @@ module TextDocumentContentChangeEvent = struct type t = { range : Range.t Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; rangeLength : int Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; text : string } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -24472,10 +24476,10 @@ module TextDocumentContentChangeEvent = struct [@@@end] let create - ?(range : Range.t option) - ?(rangeLength : int option) - ~(text : string) - (() : unit) + ?(range : Range.t option) + ?(rangeLength : int option) + ~(text : string) + (() : unit) : t = { range; rangeLength; text } @@ -24700,10 +24704,10 @@ module NotebookCell = struct type t = { document : DocumentUri.t ; executionSummary : ExecutionSummary.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; kind : NotebookCellKind.t ; metadata : Json.Object.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -24862,11 +24866,11 @@ module NotebookCell = struct [@@@end] let create - ~(document : DocumentUri.t) - ?(executionSummary : ExecutionSummary.t option) - ~(kind : NotebookCellKind.t) - ?(metadata : Json.Object.t option) - (() : unit) + ~(document : DocumentUri.t) + ?(executionSummary : ExecutionSummary.t option) + ~(kind : NotebookCellKind.t) + ?(metadata : Json.Object.t option) + (() : unit) : t = { document; executionSummary; kind; metadata } @@ -25016,10 +25020,10 @@ module TextDocumentItem = struct [@@@end] let create - ~(languageId : string) - ~(text : string) - ~(uri : DocumentUri.t) - ~(version : int) + ~(languageId : string) + ~(text : string) + ~(uri : DocumentUri.t) + ~(version : int) : t = { languageId; text; uri; version } @@ -25029,7 +25033,7 @@ end module NotebookCellArrayChange = struct type t = { cells : NotebookCell.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; deleteCount : int ; start : int } @@ -25160,10 +25164,10 @@ module NotebookCellArrayChange = struct [@@@end] let create - ?(cells : NotebookCell.t list option) - ~(deleteCount : int) - ~(start : int) - (() : unit) + ?(cells : NotebookCell.t list option) + ~(deleteCount : int) + ~(start : int) + (() : unit) : t = { cells; deleteCount; start } @@ -25273,8 +25277,8 @@ module NotebookDocumentChangeEvent = struct [@@@end] let create_textContent - ~(document : VersionedTextDocumentIdentifier.t) - ~(changes : TextDocumentContentChangeEvent.t list) + ~(document : VersionedTextDocumentIdentifier.t) + ~(changes : TextDocumentContentChangeEvent.t list) : textContent = { document; changes } @@ -25283,9 +25287,9 @@ module NotebookDocumentChangeEvent = struct type structure = { array : NotebookCellArrayChange.t ; didOpen : TextDocumentItem.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; didClose : TextDocumentIdentifier.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -25425,10 +25429,10 @@ module NotebookDocumentChangeEvent = struct [@@@end] let create_structure - ~(array : NotebookCellArrayChange.t) - ?(didOpen : TextDocumentItem.t list option) - ?(didClose : TextDocumentIdentifier.t list option) - (() : unit) + ~(array : NotebookCellArrayChange.t) + ?(didOpen : TextDocumentItem.t list option) + ?(didClose : TextDocumentIdentifier.t list option) + (() : unit) : structure = { array; didOpen; didClose } @@ -25436,11 +25440,11 @@ module NotebookDocumentChangeEvent = struct type cells = { structure : structure Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : NotebookCell.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textContent : textContent list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -25576,10 +25580,10 @@ module NotebookDocumentChangeEvent = struct [@@@end] let create_cells - ?(structure : structure option) - ?(data : NotebookCell.t list option) - ?(textContent : textContent list option) - (() : unit) + ?(structure : structure option) + ?(data : NotebookCell.t list option) + ?(textContent : textContent list option) + (() : unit) : cells = { structure; data; textContent } @@ -25588,7 +25592,7 @@ module NotebookDocumentChangeEvent = struct type t = { cells : cells Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; metadata : Json.Object.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -25800,8 +25804,8 @@ module DidChangeNotebookDocumentParams = struct [@@@end] let create - ~(change : NotebookDocumentChangeEvent.t) - ~(notebookDocument : VersionedNotebookDocumentIdentifier.t) + ~(change : NotebookDocumentChangeEvent.t) + ~(notebookDocument : VersionedNotebookDocumentIdentifier.t) : t = { change; notebookDocument } @@ -25915,8 +25919,8 @@ module DidChangeTextDocumentParams = struct [@@@end] let create - ~(contentChanges : TextDocumentContentChangeEvent.t list) - ~(textDocument : VersionedTextDocumentIdentifier.t) + ~(contentChanges : TextDocumentContentChangeEvent.t list) + ~(textDocument : VersionedTextDocumentIdentifier.t) : t = { contentChanges; textDocument } @@ -26348,7 +26352,7 @@ module FileSystemWatcher = struct type t = { globPattern : GlobPattern.t ; kind : WatchKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -26909,8 +26913,8 @@ module DidCloseNotebookDocumentParams = struct [@@@end] let create - ~(cellTextDocuments : TextDocumentIdentifier.t list) - ~(notebookDocument : NotebookDocumentIdentifier.t) + ~(cellTextDocuments : TextDocumentIdentifier.t list) + ~(notebookDocument : NotebookDocumentIdentifier.t) : t = { cellTextDocuments; notebookDocument } @@ -27001,7 +27005,7 @@ module NotebookDocument = struct type t = { cells : NotebookCell.t list ; metadata : Json.Object.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; notebookType : string ; uri : DocumentUri.t ; version : int @@ -27173,12 +27177,12 @@ module NotebookDocument = struct [@@@end] let create - ~(cells : NotebookCell.t list) - ?(metadata : Json.Object.t option) - ~(notebookType : string) - ~(uri : DocumentUri.t) - ~(version : int) - (() : unit) + ~(cells : NotebookCell.t list) + ?(metadata : Json.Object.t option) + ~(notebookType : string) + ~(uri : DocumentUri.t) + ~(version : int) + (() : unit) : t = { cells; metadata; notebookType; uri; version } @@ -27289,8 +27293,8 @@ module DidOpenNotebookDocumentParams = struct [@@@end] let create - ~(cellTextDocuments : TextDocumentItem.t list) - ~(notebookDocument : NotebookDocument.t) + ~(cellTextDocuments : TextDocumentItem.t list) + ~(notebookDocument : NotebookDocument.t) : t = { cellTextDocuments; notebookDocument } @@ -27564,9 +27568,9 @@ module DidSaveTextDocumentParams = struct [@@@end] let create - ?(text : string option) - ~(textDocument : TextDocumentIdentifier.t) - (() : unit) + ?(text : string option) + ~(textDocument : TextDocumentIdentifier.t) + (() : unit) : t = { text; textDocument } @@ -27576,7 +27580,7 @@ end module DocumentColorOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -27663,10 +27667,10 @@ end module DocumentColorParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -27807,10 +27811,10 @@ module DocumentColorParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; textDocument; workDoneToken } @@ -27820,10 +27824,10 @@ end module DocumentColorRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -27959,10 +27963,10 @@ module DocumentColorRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -27972,14 +27976,14 @@ end module DocumentDiagnosticParams = struct type t = { identifier : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; previousResultId : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -28172,12 +28176,12 @@ module DocumentDiagnosticParams = struct [@@@end] let create - ?(identifier : string option) - ?(partialResultToken : ProgressToken.t option) - ?(previousResultId : string option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(identifier : string option) + ?(partialResultToken : ProgressToken.t option) + ?(previousResultId : string option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { identifier; partialResultToken; previousResultId; textDocument; workDoneToken } @@ -28275,7 +28279,7 @@ module FullDocumentDiagnosticReport = struct type t = { items : Diagnostic.t list ; resultId : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -28419,7 +28423,7 @@ module RelatedUnchangedDocumentDiagnosticReport = struct type t = { relatedDocuments : (DocumentUri.t, relatedDocuments_pvar) Json.Assoc.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resultId : string } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -28534,9 +28538,9 @@ module RelatedUnchangedDocumentDiagnosticReport = struct [@@@end] let create - ?(relatedDocuments : (DocumentUri.t, relatedDocuments_pvar) Json.Assoc.t option) - ~(resultId : string) - (() : unit) + ?(relatedDocuments : (DocumentUri.t, relatedDocuments_pvar) Json.Assoc.t option) + ~(resultId : string) + (() : unit) : t = { relatedDocuments; resultId } @@ -28582,9 +28586,9 @@ module RelatedFullDocumentDiagnosticReport = struct { items : Diagnostic.t list ; relatedDocuments : (DocumentUri.t, relatedDocuments_pvar) Json.Assoc.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resultId : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -28724,10 +28728,10 @@ module RelatedFullDocumentDiagnosticReport = struct [@@@end] let create - ~(items : Diagnostic.t list) - ?(relatedDocuments : (DocumentUri.t, relatedDocuments_pvar) Json.Assoc.t option) - ?(resultId : string option) - (() : unit) + ~(items : Diagnostic.t list) + ?(relatedDocuments : (DocumentUri.t, relatedDocuments_pvar) Json.Assoc.t option) + ?(resultId : string option) + (() : unit) : t = { items; relatedDocuments; resultId } @@ -28744,7 +28748,7 @@ module DocumentDiagnosticReport = struct type t = [ `RelatedFullDocumentDiagnosticReport of RelatedFullDocumentDiagnosticReport.t | `RelatedUnchangedDocumentDiagnosticReport of - RelatedUnchangedDocumentDiagnosticReport.t + RelatedUnchangedDocumentDiagnosticReport.t ] let t_of_yojson (json : Json.t) : t = @@ -28891,7 +28895,7 @@ end module DocumentFormattingOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -28978,13 +28982,13 @@ end module FormattingOptions = struct type t = { insertFinalNewline : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertSpaces : bool ; tabSize : int ; trimFinalNewlines : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; trimTrailingWhitespace : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29167,12 +29171,12 @@ module FormattingOptions = struct [@@@end] let create - ?(insertFinalNewline : bool option) - ~(insertSpaces : bool) - ~(tabSize : int) - ?(trimFinalNewlines : bool option) - ?(trimTrailingWhitespace : bool option) - (() : unit) + ?(insertFinalNewline : bool option) + ~(insertSpaces : bool) + ~(tabSize : int) + ?(trimFinalNewlines : bool option) + ?(trimTrailingWhitespace : bool option) + (() : unit) : t = { insertFinalNewline @@ -29189,7 +29193,7 @@ module DocumentFormattingParams = struct { options : FormattingOptions.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29320,10 +29324,10 @@ module DocumentFormattingParams = struct [@@@end] let create - ~(options : FormattingOptions.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(options : FormattingOptions.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { options; textDocument; workDoneToken } @@ -29333,9 +29337,9 @@ end module DocumentFormattingRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29445,9 +29449,9 @@ module DocumentFormattingRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; workDoneProgress } @@ -29457,7 +29461,7 @@ end module DocumentHighlight = struct type t = { kind : DocumentHighlightKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; range : Range.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29573,7 +29577,7 @@ end module DocumentHighlightOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29660,11 +29664,11 @@ end module DocumentHighlightParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29825,11 +29829,11 @@ module DocumentHighlightParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; position; textDocument; workDoneToken } @@ -29839,9 +29843,9 @@ end module DocumentHighlightRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -29951,9 +29955,9 @@ module DocumentHighlightRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; workDoneProgress } @@ -29965,7 +29969,7 @@ module DocumentLink = struct { data : Json.t option [@yojson.option] ; range : Range.t ; target : DocumentUri.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tooltip : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -30116,11 +30120,11 @@ module DocumentLink = struct [@@@end] let create - ?(data : Json.t option) - ~(range : Range.t) - ?(target : DocumentUri.t option) - ?(tooltip : string option) - (() : unit) + ?(data : Json.t option) + ~(range : Range.t) + ?(target : DocumentUri.t option) + ?(tooltip : string option) + (() : unit) : t = { data; range; target; tooltip } @@ -30130,9 +30134,9 @@ end module DocumentLinkOptions = struct type t = { resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -30239,9 +30243,9 @@ module DocumentLinkOptions = struct [@@@end] let create - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { resolveProvider; workDoneProgress } @@ -30251,10 +30255,10 @@ end module DocumentLinkParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -30395,10 +30399,10 @@ module DocumentLinkParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; textDocument; workDoneToken } @@ -30408,11 +30412,11 @@ end module DocumentLinkRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -30550,10 +30554,10 @@ module DocumentLinkRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; resolveProvider; workDoneProgress } @@ -30564,7 +30568,7 @@ module DocumentOnTypeFormattingOptions = struct type t = { firstTriggerCharacter : string ; moreTriggerCharacter : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -30676,9 +30680,9 @@ module DocumentOnTypeFormattingOptions = struct [@@@end] let create - ~(firstTriggerCharacter : string) - ?(moreTriggerCharacter : string list option) - (() : unit) + ~(firstTriggerCharacter : string) + ?(moreTriggerCharacter : string list option) + (() : unit) : t = { firstTriggerCharacter; moreTriggerCharacter } @@ -30832,10 +30836,10 @@ module DocumentOnTypeFormattingParams = struct [@@@end] let create - ~(ch : string) - ~(options : FormattingOptions.t) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) + ~(ch : string) + ~(options : FormattingOptions.t) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) : t = { ch; options; position; textDocument } @@ -30845,10 +30849,10 @@ end module DocumentOnTypeFormattingRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; firstTriggerCharacter : string ; moreTriggerCharacter : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -30990,10 +30994,10 @@ module DocumentOnTypeFormattingRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ~(firstTriggerCharacter : string) - ?(moreTriggerCharacter : string list option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ~(firstTriggerCharacter : string) + ?(moreTriggerCharacter : string list option) + (() : unit) : t = { documentSelector; firstTriggerCharacter; moreTriggerCharacter } @@ -31003,9 +31007,9 @@ end module DocumentRangeFormattingOptions = struct type t = { rangesSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -31122,7 +31126,7 @@ module DocumentRangeFormattingParams = struct ; range : Range.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -31273,11 +31277,11 @@ module DocumentRangeFormattingParams = struct [@@@end] let create - ~(options : FormattingOptions.t) - ~(range : Range.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(options : FormattingOptions.t) + ~(range : Range.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { options; range; textDocument; workDoneToken } @@ -31287,11 +31291,11 @@ end module DocumentRangeFormattingRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rangesSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -31427,10 +31431,10 @@ module DocumentRangeFormattingRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(rangesSupport : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(rangesSupport : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; rangesSupport; workDoneProgress } @@ -31443,7 +31447,7 @@ module DocumentRangesFormattingParams = struct ; ranges : Range.t list ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -31594,11 +31598,11 @@ module DocumentRangesFormattingParams = struct [@@@end] let create - ~(options : FormattingOptions.t) - ~(ranges : Range.t list) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(options : FormattingOptions.t) + ~(ranges : Range.t list) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { options; ranges; textDocument; workDoneToken } @@ -31608,16 +31612,16 @@ end module DocumentSymbol = struct type t = { children : t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; deprecated : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; detail : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; kind : SymbolKind.t ; name : string ; range : Range.t ; selectionRange : Range.t ; tags : SymbolTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -31868,15 +31872,15 @@ module DocumentSymbol = struct [@@@end] let create - ?(children : t list option) - ?(deprecated : bool option) - ?(detail : string option) - ~(kind : SymbolKind.t) - ~(name : string) - ~(range : Range.t) - ~(selectionRange : Range.t) - ?(tags : SymbolTag.t list option) - (() : unit) + ?(children : t list option) + ?(deprecated : bool option) + ?(detail : string option) + ~(kind : SymbolKind.t) + ~(name : string) + ~(range : Range.t) + ~(selectionRange : Range.t) + ?(tags : SymbolTag.t list option) + (() : unit) : t = { children; deprecated; detail; kind; name; range; selectionRange; tags } @@ -31887,7 +31891,7 @@ module DocumentSymbolOptions = struct type t = { label : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -31999,10 +32003,10 @@ end module DocumentSymbolParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32143,10 +32147,10 @@ module DocumentSymbolParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; textDocument; workDoneToken } @@ -32156,10 +32160,10 @@ end module DocumentSymbolRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32295,10 +32299,10 @@ module DocumentSymbolRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(label : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(label : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; label; workDoneProgress } @@ -32309,7 +32313,7 @@ module ExecuteCommandOptions = struct type t = { commands : string list ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32422,10 +32426,10 @@ end module ExecuteCommandParams = struct type t = { arguments : Json.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; command : string ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32564,10 +32568,10 @@ module ExecuteCommandParams = struct [@@@end] let create - ?(arguments : Json.t list option) - ~(command : string) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(arguments : Json.t list option) + ~(command : string) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { arguments; command; workDoneToken } @@ -32578,7 +32582,7 @@ module ExecuteCommandRegistrationOptions = struct type t = { commands : string list ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32691,7 +32695,7 @@ end module FileOperationPatternOptions = struct type t = { ignoreCase : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32775,9 +32779,9 @@ module FileOperationPattern = struct type t = { glob : string ; matches : FileOperationPatternKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; options : FileOperationPatternOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -32915,10 +32919,10 @@ module FileOperationPattern = struct [@@@end] let create - ~(glob : string) - ?(matches : FileOperationPatternKind.t option) - ?(options : FileOperationPatternOptions.t option) - (() : unit) + ~(glob : string) + ?(matches : FileOperationPatternKind.t option) + ?(options : FileOperationPatternOptions.t option) + (() : unit) : t = { glob; matches; options } @@ -33122,17 +33126,17 @@ end module FileOperationOptions = struct type t = { didCreate : FileOperationRegistrationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; didDelete : FileOperationRegistrationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; didRename : FileOperationRegistrationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willCreate : FileOperationRegistrationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willDelete : FileOperationRegistrationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; willRename : FileOperationRegistrationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -33375,13 +33379,13 @@ module FileOperationOptions = struct [@@@end] let create - ?(didCreate : FileOperationRegistrationOptions.t option) - ?(didDelete : FileOperationRegistrationOptions.t option) - ?(didRename : FileOperationRegistrationOptions.t option) - ?(willCreate : FileOperationRegistrationOptions.t option) - ?(willDelete : FileOperationRegistrationOptions.t option) - ?(willRename : FileOperationRegistrationOptions.t option) - (() : unit) + ?(didCreate : FileOperationRegistrationOptions.t option) + ?(didDelete : FileOperationRegistrationOptions.t option) + ?(didRename : FileOperationRegistrationOptions.t option) + ?(willCreate : FileOperationRegistrationOptions.t option) + ?(willDelete : FileOperationRegistrationOptions.t option) + ?(willRename : FileOperationRegistrationOptions.t option) + (() : unit) : t = { didCreate; didDelete; didRename; willCreate; willDelete; willRename } @@ -33494,14 +33498,14 @@ end module FoldingRange = struct type t = { collapsedText : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; endCharacter : int Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; endLine : int ; kind : FoldingRangeKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; startCharacter : int Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; startLine : int } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -33710,13 +33714,13 @@ module FoldingRange = struct [@@@end] let create - ?(collapsedText : string option) - ?(endCharacter : int option) - ~(endLine : int) - ?(kind : FoldingRangeKind.t option) - ?(startCharacter : int option) - ~(startLine : int) - (() : unit) + ?(collapsedText : string option) + ?(endCharacter : int option) + ~(endLine : int) + ?(kind : FoldingRangeKind.t option) + ?(startCharacter : int option) + ~(startLine : int) + (() : unit) : t = { collapsedText; endCharacter; endLine; kind; startCharacter; startLine } @@ -33726,7 +33730,7 @@ end module FoldingRangeOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -33813,10 +33817,10 @@ end module FoldingRangeParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -33957,10 +33961,10 @@ module FoldingRangeParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; textDocument; workDoneToken } @@ -33970,10 +33974,10 @@ end module FoldingRangeRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -34109,10 +34113,10 @@ module FoldingRangeRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -34256,7 +34260,7 @@ end module HoverOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -34345,7 +34349,7 @@ module HoverParams = struct { position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -34476,10 +34480,10 @@ module HoverParams = struct [@@@end] let create - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { position; textDocument; workDoneToken } @@ -34489,9 +34493,9 @@ end module HoverRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -34601,9 +34605,9 @@ module HoverRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; workDoneProgress } @@ -34613,7 +34617,7 @@ end module ImplementationOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -34700,11 +34704,11 @@ end module ImplementationParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -34865,11 +34869,11 @@ module ImplementationParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; position; textDocument; workDoneToken } @@ -34879,10 +34883,10 @@ end module ImplementationRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -35018,10 +35022,10 @@ module ImplementationRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -35221,21 +35225,21 @@ module InitializeParams = struct type t = { capabilities : ClientCapabilities.t ; clientInfo : clientInfo Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; initializationOptions : Json.t option [@yojson.option] ; locale : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; processId : int Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; rootPath : string Json.Nullable_option.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rootUri : DocumentUri.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; trace : TraceValues.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspaceFolders : WorkspaceFolder.t list Json.Nullable_option.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -35559,17 +35563,17 @@ module InitializeParams = struct [@@@end] let create - ~(capabilities : ClientCapabilities.t) - ?(clientInfo : clientInfo option) - ?(initializationOptions : Json.t option) - ?(locale : string option) - ?(processId : int option) - ?(rootPath : string option option) - ?(rootUri : DocumentUri.t option) - ?(trace : TraceValues.t option) - ?(workDoneToken : ProgressToken.t option) - ?(workspaceFolders : WorkspaceFolder.t list option option) - (() : unit) + ~(capabilities : ClientCapabilities.t) + ?(clientInfo : clientInfo option) + ?(initializationOptions : Json.t option) + ?(locale : string option) + ?(processId : int option) + ?(rootPath : string option option) + ?(rootUri : DocumentUri.t option) + ?(trace : TraceValues.t option) + ?(workDoneToken : ProgressToken.t option) + ?(workspaceFolders : WorkspaceFolder.t list option option) + (() : unit) : t = { capabilities @@ -35589,9 +35593,9 @@ end module WorkspaceSymbolOptions = struct type t = { resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -35698,9 +35702,9 @@ module WorkspaceSymbolOptions = struct [@@@end] let create - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { resolveProvider; workDoneProgress } @@ -35721,7 +35725,7 @@ module WorkspaceFoldersServerCapabilities = struct ;; let yojson_of_changeNotifications_pvar - (changeNotifications_pvar : changeNotifications_pvar) + (changeNotifications_pvar : changeNotifications_pvar) : Json.t = match changeNotifications_pvar with @@ -35731,7 +35735,7 @@ module WorkspaceFoldersServerCapabilities = struct type t = { changeNotifications : changeNotifications_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; supported : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -35840,9 +35844,9 @@ module WorkspaceFoldersServerCapabilities = struct [@@@end] let create - ?(changeNotifications : changeNotifications_pvar option) - ?(supported : bool option) - (() : unit) + ?(changeNotifications : changeNotifications_pvar option) + ?(supported : bool option) + (() : unit) : t = { changeNotifications; supported } @@ -35852,10 +35856,10 @@ end module TypeHierarchyRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -35991,10 +35995,10 @@ module TypeHierarchyRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -36004,7 +36008,7 @@ end module TypeHierarchyOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -36091,10 +36095,10 @@ end module TypeDefinitionRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -36230,10 +36234,10 @@ module TypeDefinitionRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -36243,7 +36247,7 @@ end module TypeDefinitionOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -36330,7 +36334,7 @@ end module SaveOptions = struct type t = { includeText : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -36434,12 +36438,12 @@ module TextDocumentSyncOptions = struct type t = { change : TextDocumentSyncKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; openClose : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; save : save_pvar Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; willSave : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; willSaveWaitUntil : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -36627,12 +36631,12 @@ module TextDocumentSyncOptions = struct [@@@end] let create - ?(change : TextDocumentSyncKind.t option) - ?(openClose : bool option) - ?(save : save_pvar option) - ?(willSave : bool option) - ?(willSaveWaitUntil : bool option) - (() : unit) + ?(change : TextDocumentSyncKind.t option) + ?(openClose : bool option) + ?(save : save_pvar option) + ?(willSave : bool option) + ?(willSaveWaitUntil : bool option) + (() : unit) : t = { change; openClose; save; willSave; willSaveWaitUntil } @@ -36642,11 +36646,11 @@ end module SignatureHelpOptions = struct type t = { retriggerCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -36790,10 +36794,10 @@ module SignatureHelpOptions = struct [@@@end] let create - ?(retriggerCharacters : string list option) - ?(triggerCharacters : string list option) - ?(workDoneProgress : bool option) - (() : unit) + ?(retriggerCharacters : string list option) + ?(triggerCharacters : string list option) + ?(workDoneProgress : bool option) + (() : unit) : t = { retriggerCharacters; triggerCharacters; workDoneProgress } @@ -37008,13 +37012,13 @@ module SemanticTokensRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; full : full_pvar Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; legend : SemanticTokensLegend.t ; range : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -37228,13 +37232,13 @@ module SemanticTokensRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(full : full_pvar option) - ?(id : string option) - ~(legend : SemanticTokensLegend.t) - ?(range : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(full : full_pvar option) + ?(id : string option) + ~(legend : SemanticTokensLegend.t) + ?(range : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; full; id; legend; range; workDoneProgress } @@ -37347,7 +37351,7 @@ module SemanticTokensOptions = struct ; legend : SemanticTokensLegend.t ; range : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -37506,11 +37510,11 @@ module SemanticTokensOptions = struct [@@@end] let create - ?(full : full_pvar option) - ~(legend : SemanticTokensLegend.t) - ?(range : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(full : full_pvar option) + ~(legend : SemanticTokensLegend.t) + ?(range : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { full; legend; range; workDoneProgress } @@ -37520,10 +37524,10 @@ end module SelectionRangeRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -37659,10 +37663,10 @@ module SelectionRangeRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -37672,7 +37676,7 @@ end module SelectionRangeOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -37759,9 +37763,9 @@ end module RenameOptions = struct type t = { prepareProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -37868,9 +37872,9 @@ module RenameOptions = struct [@@@end] let create - ?(prepareProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(prepareProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { prepareProvider; workDoneProgress } @@ -37880,7 +37884,7 @@ end module ReferenceOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -37967,9 +37971,9 @@ end module MonikerRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38079,9 +38083,9 @@ module MonikerRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; workDoneProgress } @@ -38091,7 +38095,7 @@ end module MonikerOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38178,10 +38182,10 @@ end module LinkedEditingRangeRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38317,10 +38321,10 @@ module LinkedEditingRangeRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -38330,7 +38334,7 @@ end module LinkedEditingRangeOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38417,10 +38421,10 @@ end module InlineValueRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38556,10 +38560,10 @@ module InlineValueRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -38569,7 +38573,7 @@ end module InlineValueOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38656,7 +38660,7 @@ end module InlineCompletionOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38743,12 +38747,12 @@ end module InlayHintRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -38914,11 +38918,11 @@ module InlayHintRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; resolveProvider; workDoneProgress } @@ -38928,9 +38932,9 @@ end module InlayHintOptions = struct type t = { resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -39037,9 +39041,9 @@ module InlayHintOptions = struct [@@@end] let create - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { resolveProvider; workDoneProgress } @@ -39049,9 +39053,9 @@ end module ServerCapabilities = struct type workspace = { workspaceFolders : WorkspaceFoldersServerCapabilities.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; fileOperations : FileOperationOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -39165,9 +39169,9 @@ module ServerCapabilities = struct [@@@end] let create_workspace - ?(workspaceFolders : WorkspaceFoldersServerCapabilities.t option) - ?(fileOperations : FileOperationOptions.t option) - (() : unit) + ?(workspaceFolders : WorkspaceFoldersServerCapabilities.t option) + ?(fileOperations : FileOperationOptions.t option) + (() : unit) : workspace = { workspaceFolders; fileOperations } @@ -39175,7 +39179,7 @@ module ServerCapabilities = struct type diagnostic = { markupMessageSupport : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -39262,7 +39266,7 @@ module ServerCapabilities = struct type textDocument = { diagnostic : diagnostic Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -39366,7 +39370,7 @@ module ServerCapabilities = struct ;; let yojson_of_callHierarchyProvider_pvar - (callHierarchyProvider_pvar : callHierarchyProvider_pvar) + (callHierarchyProvider_pvar : callHierarchyProvider_pvar) : Json.t = match callHierarchyProvider_pvar with @@ -39392,7 +39396,7 @@ module ServerCapabilities = struct ;; let yojson_of_codeActionProvider_pvar - (codeActionProvider_pvar : codeActionProvider_pvar) + (codeActionProvider_pvar : codeActionProvider_pvar) : Json.t = match codeActionProvider_pvar with @@ -39449,7 +39453,7 @@ module ServerCapabilities = struct ;; let yojson_of_declarationProvider_pvar - (declarationProvider_pvar : declarationProvider_pvar) + (declarationProvider_pvar : declarationProvider_pvar) : Json.t = match declarationProvider_pvar with @@ -39474,7 +39478,7 @@ module ServerCapabilities = struct ;; let yojson_of_definitionProvider_pvar - (definitionProvider_pvar : definitionProvider_pvar) + (definitionProvider_pvar : definitionProvider_pvar) : Json.t = match definitionProvider_pvar with @@ -39498,7 +39502,7 @@ module ServerCapabilities = struct ;; let yojson_of_diagnosticProvider_pvar - (diagnosticProvider_pvar : diagnosticProvider_pvar) + (diagnosticProvider_pvar : diagnosticProvider_pvar) : Json.t = match diagnosticProvider_pvar with @@ -39526,7 +39530,7 @@ module ServerCapabilities = struct ;; let yojson_of_documentFormattingProvider_pvar - (documentFormattingProvider_pvar : documentFormattingProvider_pvar) + (documentFormattingProvider_pvar : documentFormattingProvider_pvar) : Json.t = match documentFormattingProvider_pvar with @@ -39554,7 +39558,7 @@ module ServerCapabilities = struct ;; let yojson_of_documentHighlightProvider_pvar - (documentHighlightProvider_pvar : documentHighlightProvider_pvar) + (documentHighlightProvider_pvar : documentHighlightProvider_pvar) : Json.t = match documentHighlightProvider_pvar with @@ -39583,7 +39587,7 @@ module ServerCapabilities = struct ;; let yojson_of_documentRangeFormattingProvider_pvar - (documentRangeFormattingProvider_pvar : documentRangeFormattingProvider_pvar) + (documentRangeFormattingProvider_pvar : documentRangeFormattingProvider_pvar) : Json.t = match documentRangeFormattingProvider_pvar with @@ -39607,7 +39611,7 @@ module ServerCapabilities = struct ;; let yojson_of_documentSymbolProvider_pvar - (documentSymbolProvider_pvar : documentSymbolProvider_pvar) + (documentSymbolProvider_pvar : documentSymbolProvider_pvar) : Json.t = match documentSymbolProvider_pvar with @@ -39636,7 +39640,7 @@ module ServerCapabilities = struct ;; let yojson_of_foldingRangeProvider_pvar - (foldingRangeProvider_pvar : foldingRangeProvider_pvar) + (foldingRangeProvider_pvar : foldingRangeProvider_pvar) : Json.t = match foldingRangeProvider_pvar with @@ -39687,7 +39691,7 @@ module ServerCapabilities = struct ;; let yojson_of_implementationProvider_pvar - (implementationProvider_pvar : implementationProvider_pvar) + (implementationProvider_pvar : implementationProvider_pvar) : Json.t = match implementationProvider_pvar with @@ -39745,7 +39749,7 @@ module ServerCapabilities = struct ;; let yojson_of_inlineCompletionProvider_pvar - (inlineCompletionProvider_pvar : inlineCompletionProvider_pvar) + (inlineCompletionProvider_pvar : inlineCompletionProvider_pvar) : Json.t = match inlineCompletionProvider_pvar with @@ -39774,7 +39778,7 @@ module ServerCapabilities = struct ;; let yojson_of_inlineValueProvider_pvar - (inlineValueProvider_pvar : inlineValueProvider_pvar) + (inlineValueProvider_pvar : inlineValueProvider_pvar) : Json.t = match inlineValueProvider_pvar with @@ -39807,7 +39811,7 @@ module ServerCapabilities = struct ;; let yojson_of_linkedEditingRangeProvider_pvar - (linkedEditingRangeProvider_pvar : linkedEditingRangeProvider_pvar) + (linkedEditingRangeProvider_pvar : linkedEditingRangeProvider_pvar) : Json.t = match linkedEditingRangeProvider_pvar with @@ -39848,7 +39852,7 @@ module ServerCapabilities = struct type notebookDocumentSync_pvar = [ `NotebookDocumentSyncOptions of NotebookDocumentSyncOptions.t | `NotebookDocumentSyncRegistrationOptions of - NotebookDocumentSyncRegistrationOptions.t + NotebookDocumentSyncRegistrationOptions.t ] let notebookDocumentSync_pvar_of_yojson (json : Json.t) : notebookDocumentSync_pvar = @@ -39864,7 +39868,7 @@ module ServerCapabilities = struct ;; let yojson_of_notebookDocumentSync_pvar - (notebookDocumentSync_pvar : notebookDocumentSync_pvar) + (notebookDocumentSync_pvar : notebookDocumentSync_pvar) : Json.t = match notebookDocumentSync_pvar with @@ -39889,7 +39893,7 @@ module ServerCapabilities = struct ;; let yojson_of_referencesProvider_pvar - (referencesProvider_pvar : referencesProvider_pvar) + (referencesProvider_pvar : referencesProvider_pvar) : Json.t = match referencesProvider_pvar with @@ -39939,7 +39943,7 @@ module ServerCapabilities = struct ;; let yojson_of_selectionRangeProvider_pvar - (selectionRangeProvider_pvar : selectionRangeProvider_pvar) + (selectionRangeProvider_pvar : selectionRangeProvider_pvar) : Json.t = match selectionRangeProvider_pvar with @@ -39966,7 +39970,7 @@ module ServerCapabilities = struct ;; let yojson_of_semanticTokensProvider_pvar - (semanticTokensProvider_pvar : semanticTokensProvider_pvar) + (semanticTokensProvider_pvar : semanticTokensProvider_pvar) : Json.t = match semanticTokensProvider_pvar with @@ -40018,7 +40022,7 @@ module ServerCapabilities = struct ;; let yojson_of_typeDefinitionProvider_pvar - (typeDefinitionProvider_pvar : typeDefinitionProvider_pvar) + (typeDefinitionProvider_pvar : typeDefinitionProvider_pvar) : Json.t = match typeDefinitionProvider_pvar with @@ -40049,7 +40053,7 @@ module ServerCapabilities = struct ;; let yojson_of_typeHierarchyProvider_pvar - (typeHierarchyProvider_pvar : typeHierarchyProvider_pvar) + (typeHierarchyProvider_pvar : typeHierarchyProvider_pvar) : Json.t = match typeHierarchyProvider_pvar with @@ -40078,7 +40082,7 @@ module ServerCapabilities = struct ;; let yojson_of_workspaceSymbolProvider_pvar - (workspaceSymbolProvider_pvar : workspaceSymbolProvider_pvar) + (workspaceSymbolProvider_pvar : workspaceSymbolProvider_pvar) : Json.t = match workspaceSymbolProvider_pvar with @@ -40088,80 +40092,80 @@ module ServerCapabilities = struct type t = { callHierarchyProvider : callHierarchyProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; codeActionProvider : codeActionProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; codeLensProvider : CodeLensOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; colorProvider : colorProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; completionProvider : CompletionOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; declarationProvider : declarationProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; definitionProvider : definitionProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; diagnosticProvider : diagnosticProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentFormattingProvider : documentFormattingProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentHighlightProvider : documentHighlightProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentLinkProvider : DocumentLinkOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentOnTypeFormattingProvider : DocumentOnTypeFormattingOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentRangeFormattingProvider : documentRangeFormattingProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentSymbolProvider : documentSymbolProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; executeCommandProvider : ExecuteCommandOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; experimental : Json.t option [@yojson.option] ; foldingRangeProvider : foldingRangeProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; hoverProvider : hoverProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; implementationProvider : implementationProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlayHintProvider : inlayHintProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlineCompletionProvider : inlineCompletionProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; inlineValueProvider : inlineValueProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; linkedEditingRangeProvider : linkedEditingRangeProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; monikerProvider : monikerProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; notebookDocumentSync : notebookDocumentSync_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; positionEncoding : PositionEncodingKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; referencesProvider : referencesProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; renameProvider : renameProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; selectionRangeProvider : selectionRangeProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; semanticTokensProvider : semanticTokensProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; signatureHelpProvider : SignatureHelpOptions.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : textDocument Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocumentSync : textDocumentSync_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; typeDefinitionProvider : typeDefinitionProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; typeHierarchyProvider : typeHierarchyProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspace : workspace Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workspaceSymbolProvider : workspaceSymbolProvider_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -41316,44 +41320,44 @@ module ServerCapabilities = struct [@@@end] let create - ?(callHierarchyProvider : callHierarchyProvider_pvar option) - ?(codeActionProvider : codeActionProvider_pvar option) - ?(codeLensProvider : CodeLensOptions.t option) - ?(colorProvider : colorProvider_pvar option) - ?(completionProvider : CompletionOptions.t option) - ?(declarationProvider : declarationProvider_pvar option) - ?(definitionProvider : definitionProvider_pvar option) - ?(diagnosticProvider : diagnosticProvider_pvar option) - ?(documentFormattingProvider : documentFormattingProvider_pvar option) - ?(documentHighlightProvider : documentHighlightProvider_pvar option) - ?(documentLinkProvider : DocumentLinkOptions.t option) - ?(documentOnTypeFormattingProvider : DocumentOnTypeFormattingOptions.t option) - ?(documentRangeFormattingProvider : documentRangeFormattingProvider_pvar option) - ?(documentSymbolProvider : documentSymbolProvider_pvar option) - ?(executeCommandProvider : ExecuteCommandOptions.t option) - ?(experimental : Json.t option) - ?(foldingRangeProvider : foldingRangeProvider_pvar option) - ?(hoverProvider : hoverProvider_pvar option) - ?(implementationProvider : implementationProvider_pvar option) - ?(inlayHintProvider : inlayHintProvider_pvar option) - ?(inlineCompletionProvider : inlineCompletionProvider_pvar option) - ?(inlineValueProvider : inlineValueProvider_pvar option) - ?(linkedEditingRangeProvider : linkedEditingRangeProvider_pvar option) - ?(monikerProvider : monikerProvider_pvar option) - ?(notebookDocumentSync : notebookDocumentSync_pvar option) - ?(positionEncoding : PositionEncodingKind.t option) - ?(referencesProvider : referencesProvider_pvar option) - ?(renameProvider : renameProvider_pvar option) - ?(selectionRangeProvider : selectionRangeProvider_pvar option) - ?(semanticTokensProvider : semanticTokensProvider_pvar option) - ?(signatureHelpProvider : SignatureHelpOptions.t option) - ?(textDocument : textDocument option) - ?(textDocumentSync : textDocumentSync_pvar option) - ?(typeDefinitionProvider : typeDefinitionProvider_pvar option) - ?(typeHierarchyProvider : typeHierarchyProvider_pvar option) - ?(workspace : workspace option) - ?(workspaceSymbolProvider : workspaceSymbolProvider_pvar option) - (() : unit) + ?(callHierarchyProvider : callHierarchyProvider_pvar option) + ?(codeActionProvider : codeActionProvider_pvar option) + ?(codeLensProvider : CodeLensOptions.t option) + ?(colorProvider : colorProvider_pvar option) + ?(completionProvider : CompletionOptions.t option) + ?(declarationProvider : declarationProvider_pvar option) + ?(definitionProvider : definitionProvider_pvar option) + ?(diagnosticProvider : diagnosticProvider_pvar option) + ?(documentFormattingProvider : documentFormattingProvider_pvar option) + ?(documentHighlightProvider : documentHighlightProvider_pvar option) + ?(documentLinkProvider : DocumentLinkOptions.t option) + ?(documentOnTypeFormattingProvider : DocumentOnTypeFormattingOptions.t option) + ?(documentRangeFormattingProvider : documentRangeFormattingProvider_pvar option) + ?(documentSymbolProvider : documentSymbolProvider_pvar option) + ?(executeCommandProvider : ExecuteCommandOptions.t option) + ?(experimental : Json.t option) + ?(foldingRangeProvider : foldingRangeProvider_pvar option) + ?(hoverProvider : hoverProvider_pvar option) + ?(implementationProvider : implementationProvider_pvar option) + ?(inlayHintProvider : inlayHintProvider_pvar option) + ?(inlineCompletionProvider : inlineCompletionProvider_pvar option) + ?(inlineValueProvider : inlineValueProvider_pvar option) + ?(linkedEditingRangeProvider : linkedEditingRangeProvider_pvar option) + ?(monikerProvider : monikerProvider_pvar option) + ?(notebookDocumentSync : notebookDocumentSync_pvar option) + ?(positionEncoding : PositionEncodingKind.t option) + ?(referencesProvider : referencesProvider_pvar option) + ?(renameProvider : renameProvider_pvar option) + ?(selectionRangeProvider : selectionRangeProvider_pvar option) + ?(semanticTokensProvider : semanticTokensProvider_pvar option) + ?(signatureHelpProvider : SignatureHelpOptions.t option) + ?(textDocument : textDocument option) + ?(textDocumentSync : textDocumentSync_pvar option) + ?(typeDefinitionProvider : typeDefinitionProvider_pvar option) + ?(typeHierarchyProvider : typeHierarchyProvider_pvar option) + ?(workspace : workspace option) + ?(workspaceSymbolProvider : workspaceSymbolProvider_pvar option) + (() : unit) : t = { callHierarchyProvider @@ -41512,7 +41516,7 @@ module InitializeResult = struct type t = { capabilities : ServerCapabilities.t ; serverInfo : serverInfo Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -41618,9 +41622,9 @@ module InitializeResult = struct [@@@end] let create - ~(capabilities : ServerCapabilities.t) - ?(serverInfo : serverInfo option) - (() : unit) + ~(capabilities : ServerCapabilities.t) + ?(serverInfo : serverInfo option) + (() : unit) : t = { capabilities; serverInfo } @@ -41742,18 +41746,18 @@ module InitializedParams_ = struct type t = { capabilities : ClientCapabilities.t ; clientInfo : clientInfo Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; initializationOptions : Json.t option [@yojson.option] ; locale : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; processId : int Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; rootPath : string Json.Nullable_option.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; rootUri : DocumentUri.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; trace : TraceValues.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -42044,16 +42048,16 @@ module InitializedParams_ = struct [@@@end] let create - ~(capabilities : ClientCapabilities.t) - ?(clientInfo : clientInfo option) - ?(initializationOptions : Json.t option) - ?(locale : string option) - ?(processId : int option) - ?(rootPath : string option option) - ?(rootUri : DocumentUri.t option) - ?(trace : TraceValues.t option) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(capabilities : ClientCapabilities.t) + ?(clientInfo : clientInfo option) + ?(initializationOptions : Json.t option) + ?(locale : string option) + ?(processId : int option) + ?(rootPath : string option option) + ?(rootUri : DocumentUri.t option) + ?(trace : TraceValues.t option) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { capabilities @@ -42093,11 +42097,11 @@ module InlayHintLabelPart = struct type t = { command : Command.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; location : Location.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tooltip : tooltip_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; value : string } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -42257,11 +42261,11 @@ module InlayHintLabelPart = struct [@@@end] let create - ?(command : Command.t option) - ?(location : Location.t option) - ?(tooltip : tooltip_pvar option) - ~(value : string) - (() : unit) + ?(command : Command.t option) + ?(location : Location.t option) + ?(tooltip : tooltip_pvar option) + ~(value : string) + (() : unit) : t = { command; location; tooltip; value } @@ -42314,17 +42318,17 @@ module InlayHint = struct type t = { data : Json.t option [@yojson.option] ; kind : InlayHintKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : label_pvar ; paddingLeft : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; paddingRight : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textEdits : TextEdit.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; tooltip : tooltip_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -42582,15 +42586,15 @@ module InlayHint = struct [@@@end] let create - ?(data : Json.t option) - ?(kind : InlayHintKind.t option) - ~(label : label_pvar) - ?(paddingLeft : bool option) - ?(paddingRight : bool option) - ~(position : Position.t) - ?(textEdits : TextEdit.t list option) - ?(tooltip : tooltip_pvar option) - (() : unit) + ?(data : Json.t option) + ?(kind : InlayHintKind.t option) + ~(label : label_pvar) + ?(paddingLeft : bool option) + ?(paddingRight : bool option) + ~(position : Position.t) + ?(textEdits : TextEdit.t list option) + ?(tooltip : tooltip_pvar option) + (() : unit) : t = { data; kind; label; paddingLeft; paddingRight; position; textEdits; tooltip } @@ -42602,7 +42606,7 @@ module InlayHintParams = struct { range : Range.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -42731,10 +42735,10 @@ module InlayHintParams = struct [@@@end] let create - ~(range : Range.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(range : Range.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { range; textDocument; workDoneToken } @@ -42847,7 +42851,7 @@ end module InlineCompletionContext = struct type t = { selectedCompletionInfo : SelectedCompletionInfo.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerKind : InlineCompletionTriggerKind.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -42959,9 +42963,9 @@ module InlineCompletionContext = struct [@@@end] let create - ?(selectedCompletionInfo : SelectedCompletionInfo.t option) - ~(triggerKind : InlineCompletionTriggerKind.t) - (() : unit) + ?(selectedCompletionInfo : SelectedCompletionInfo.t option) + ~(triggerKind : InlineCompletionTriggerKind.t) + (() : unit) : t = { selectedCompletionInfo; triggerKind } @@ -43075,9 +43079,9 @@ module InlineCompletionItem = struct type t = { command : Command.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; filterText : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; insertText : insertText_pvar ; range : Range.t Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } @@ -43236,11 +43240,11 @@ module InlineCompletionItem = struct [@@@end] let create - ?(command : Command.t option) - ?(filterText : string option) - ~(insertText : insertText_pvar) - ?(range : Range.t option) - (() : unit) + ?(command : Command.t option) + ?(filterText : string option) + ~(insertText : insertText_pvar) + ?(range : Range.t option) + (() : unit) : t = { command; filterText; insertText; range } @@ -43334,7 +43338,7 @@ module InlineCompletionParams = struct ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -43485,11 +43489,11 @@ module InlineCompletionParams = struct [@@@end] let create - ~(context : InlineCompletionContext.t) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(context : InlineCompletionContext.t) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { context; position; textDocument; workDoneToken } @@ -43499,10 +43503,10 @@ end module InlineCompletionRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; id : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -43638,10 +43642,10 @@ module InlineCompletionRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(id : string option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(id : string option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; id; workDoneProgress } @@ -43651,7 +43655,7 @@ end module InlineValueEvaluatableExpression = struct type t = { expression : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; range : Range.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -43765,7 +43769,7 @@ module InlineValueVariableLookup = struct { caseSensitiveLookup : bool ; range : Range.t ; variableName : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -43892,10 +43896,10 @@ module InlineValueVariableLookup = struct [@@@end] let create - ~(caseSensitiveLookup : bool) - ~(range : Range.t) - ?(variableName : string option) - (() : unit) + ~(caseSensitiveLookup : bool) + ~(range : Range.t) + ?(variableName : string option) + (() : unit) : t = { caseSensitiveLookup; range; variableName } @@ -44145,7 +44149,7 @@ module InlineValueParams = struct ; range : Range.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -44296,11 +44300,11 @@ module InlineValueParams = struct [@@@end] let create - ~(context : InlineValueContext.t) - ~(range : Range.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(context : InlineValueContext.t) + ~(range : Range.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { context; range; textDocument; workDoneToken } @@ -44312,7 +44316,7 @@ module LinkedEditingRangeParams = struct { position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -44443,10 +44447,10 @@ module LinkedEditingRangeParams = struct [@@@end] let create - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { position; textDocument; workDoneToken } @@ -44457,7 +44461,7 @@ module LinkedEditingRanges = struct type t = { ranges : Range.t list ; wordPattern : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -44861,7 +44865,7 @@ module Moniker = struct type t = { identifier : string ; kind : MonikerKind.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; scheme : string ; unique : UniquenessLevel.t } @@ -45007,11 +45011,11 @@ module Moniker = struct [@@@end] let create - ~(identifier : string) - ?(kind : MonikerKind.t option) - ~(scheme : string) - ~(unique : UniquenessLevel.t) - (() : unit) + ~(identifier : string) + ?(kind : MonikerKind.t option) + ~(scheme : string) + ~(unique : UniquenessLevel.t) + (() : unit) : t = { identifier; kind; scheme; unique } @@ -45021,11 +45025,11 @@ end module MonikerParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -45186,11 +45190,11 @@ module MonikerParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; position; textDocument; workDoneToken } @@ -45242,7 +45246,7 @@ module ParameterInformation = struct type t = { documentation : documentation_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : label_pvar } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -45352,9 +45356,9 @@ module ParameterInformation = struct [@@@end] let create - ?(documentation : documentation_pvar option) - ~(label : label_pvar) - (() : unit) + ?(documentation : documentation_pvar option) + ~(label : label_pvar) + (() : unit) : t = { documentation; label } @@ -45364,7 +45368,7 @@ end module PartialResultParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -45458,7 +45462,7 @@ module PrepareRenameParams = struct { position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -45589,10 +45593,10 @@ module PrepareRenameParams = struct [@@@end] let create - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { position; textDocument; workDoneToken } @@ -45829,10 +45833,10 @@ module PublishDiagnosticsParams = struct [@@@end] let create - ~(diagnostics : Diagnostic.t list) - ~(uri : DocumentUri.t) - ?(version : int option) - (() : unit) + ~(diagnostics : Diagnostic.t list) + ~(uri : DocumentUri.t) + ?(version : int option) + (() : unit) : t = { diagnostics; uri; version } @@ -45923,11 +45927,11 @@ module ReferenceParams = struct type t = { context : ReferenceContext.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -46108,12 +46112,12 @@ module ReferenceParams = struct [@@@end] let create - ~(context : ReferenceContext.t) - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(context : ReferenceContext.t) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { context; partialResultToken; position; textDocument; workDoneToken } @@ -46123,9 +46127,9 @@ end module ReferenceRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -46235,9 +46239,9 @@ module ReferenceRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; workDoneProgress } @@ -46367,10 +46371,10 @@ module Registration = struct [@@@end] let create - ~(id : string) - ~(method_ : string) - ?(registerOptions : Json.t option) - (() : unit) + ~(id : string) + ~(method_ : string) + ?(registerOptions : Json.t option) + (() : unit) : t = { id; method_; registerOptions } @@ -46542,7 +46546,7 @@ module RenameParams = struct ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -46693,11 +46697,11 @@ module RenameParams = struct [@@@end] let create - ~(newName : string) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(newName : string) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { newName; position; textDocument; workDoneToken } @@ -46707,11 +46711,11 @@ end module RenameRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; prepareProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -46849,10 +46853,10 @@ module RenameRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(prepareProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(prepareProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; prepareProvider; workDoneProgress } @@ -46862,7 +46866,7 @@ end module ResourceOperation = struct type t = { annotationId : ChangeAnnotationIdentifier.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; kind : string } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -46972,9 +46976,9 @@ module ResourceOperation = struct [@@@end] let create - ?(annotationId : ChangeAnnotationIdentifier.t option) - ~(kind : string) - (() : unit) + ?(annotationId : ChangeAnnotationIdentifier.t option) + ~(kind : string) + (() : unit) : t = { annotationId; kind } @@ -47093,11 +47097,11 @@ end module SelectionRangeParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; positions : Position.t list ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -47258,11 +47262,11 @@ module SelectionRangeParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(positions : Position.t list) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(positions : Position.t list) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; positions; textDocument; workDoneToken } @@ -47273,7 +47277,7 @@ module SemanticTokens = struct type t = { data : int array ; resultId : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -47523,7 +47527,7 @@ module SemanticTokensDelta = struct type t = { edits : SemanticTokensEdit.t list ; resultId : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -47638,11 +47642,11 @@ end module SemanticTokensDeltaParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; previousResultId : string ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -47803,11 +47807,11 @@ module SemanticTokensDeltaParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(previousResultId : string) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(previousResultId : string) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; previousResultId; textDocument; workDoneToken } @@ -47898,10 +47902,10 @@ end module SemanticTokensParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -48042,10 +48046,10 @@ module SemanticTokensParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; textDocument; workDoneToken } @@ -48133,11 +48137,11 @@ end module SemanticTokensRangeParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; range : Range.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -48298,11 +48302,11 @@ module SemanticTokensRangeParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(range : Range.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(range : Range.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; range; textDocument; workDoneToken } @@ -48391,9 +48395,9 @@ end module ShowDocumentParams = struct type t = { external_ : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] [@key "external"] + [@default None] [@yojson_drop_default ( = )] [@key "external"] ; selection : Range.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; takeFocus : bool Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; uri : DocumentUri.t } @@ -48552,11 +48556,11 @@ module ShowDocumentParams = struct [@@@end] let create - ?(external_ : bool option) - ?(selection : Range.t option) - ?(takeFocus : bool option) - ~(uri : DocumentUri.t) - (() : unit) + ?(external_ : bool option) + ?(selection : Range.t option) + ?(takeFocus : bool option) + ~(uri : DocumentUri.t) + (() : unit) : t = { external_; selection; takeFocus; uri } @@ -48748,7 +48752,7 @@ end module ShowMessageRequestParams = struct type t = { actions : MessageActionItem.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; message : string ; type_ : MessageType.t [@key "type"] } @@ -48880,10 +48884,10 @@ module ShowMessageRequestParams = struct [@@@end] let create - ?(actions : MessageActionItem.t list option) - ~(message : string) - ~(type_ : MessageType.t) - (() : unit) + ?(actions : MessageActionItem.t list option) + ~(message : string) + ~(type_ : MessageType.t) + (() : unit) : t = { actions; message; type_ } @@ -48914,12 +48918,12 @@ module SignatureInformation = struct type t = { activeParameter : int Json.Nullable_option.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; documentation : documentation_pvar Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; label : string ; parameters : ParameterInformation.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -49093,11 +49097,11 @@ module SignatureInformation = struct [@@@end] let create - ?(activeParameter : int option option) - ?(documentation : documentation_pvar option) - ~(label : string) - ?(parameters : ParameterInformation.t list option) - (() : unit) + ?(activeParameter : int option option) + ?(documentation : documentation_pvar option) + ~(label : string) + ?(parameters : ParameterInformation.t list option) + (() : unit) : t = { activeParameter; documentation; label; parameters } @@ -49107,9 +49111,9 @@ end module SignatureHelp = struct type t = { activeParameter : int Json.Nullable_option.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; activeSignature : int Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; signatures : SignatureInformation.t list } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -49250,10 +49254,10 @@ module SignatureHelp = struct [@@@end] let create - ?(activeParameter : int option option) - ?(activeSignature : int option) - ~(signatures : SignatureInformation.t list) - (() : unit) + ?(activeParameter : int option option) + ?(activeSignature : int option) + ~(signatures : SignatureInformation.t list) + (() : unit) : t = { activeParameter; activeSignature; signatures } @@ -49263,10 +49267,10 @@ end module SignatureHelpContext = struct type t = { activeSignatureHelp : SignatureHelp.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; isRetrigger : bool ; triggerCharacter : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerKind : SignatureHelpTriggerKind.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -49426,11 +49430,11 @@ module SignatureHelpContext = struct [@@@end] let create - ?(activeSignatureHelp : SignatureHelp.t option) - ~(isRetrigger : bool) - ?(triggerCharacter : string option) - ~(triggerKind : SignatureHelpTriggerKind.t) - (() : unit) + ?(activeSignatureHelp : SignatureHelp.t option) + ~(isRetrigger : bool) + ?(triggerCharacter : string option) + ~(triggerKind : SignatureHelpTriggerKind.t) + (() : unit) : t = { activeSignatureHelp; isRetrigger; triggerCharacter; triggerKind } @@ -49440,11 +49444,11 @@ end module SignatureHelpParams = struct type t = { context : SignatureHelpContext.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -49604,11 +49608,11 @@ module SignatureHelpParams = struct [@@@end] let create - ?(context : SignatureHelpContext.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(context : SignatureHelpContext.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { context; position; textDocument; workDoneToken } @@ -49618,13 +49622,13 @@ end module SignatureHelpRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; retriggerCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; triggerCharacters : string list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -49798,11 +49802,11 @@ module SignatureHelpRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(retriggerCharacters : string list option) - ?(triggerCharacters : string list option) - ?(workDoneProgress : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(retriggerCharacters : string list option) + ?(triggerCharacters : string list option) + ?(workDoneProgress : bool option) + (() : unit) : t = { documentSelector; retriggerCharacters; triggerCharacters; workDoneProgress } @@ -49893,14 +49897,14 @@ end module SymbolInformation = struct type t = { containerName : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; deprecated : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; kind : SymbolKind.t ; location : Location.t ; name : string ; tags : SymbolTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -50104,13 +50108,13 @@ module SymbolInformation = struct [@@@end] let create - ?(containerName : string option) - ?(deprecated : bool option) - ~(kind : SymbolKind.t) - ~(location : Location.t) - ~(name : string) - ?(tags : SymbolTag.t list option) - (() : unit) + ?(containerName : string option) + ?(deprecated : bool option) + ~(kind : SymbolKind.t) + ~(location : Location.t) + ~(name : string) + ?(tags : SymbolTag.t list option) + (() : unit) : t = { containerName; deprecated; kind; location; name; tags } @@ -50120,7 +50124,7 @@ end module TextDocumentChangeRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; syncKind : TextDocumentSyncKind.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -50230,9 +50234,9 @@ module TextDocumentChangeRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ~(syncKind : TextDocumentSyncKind.t) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ~(syncKind : TextDocumentSyncKind.t) + (() : unit) : t = { documentSelector; syncKind } @@ -50347,7 +50351,7 @@ end module TextDocumentRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -50439,9 +50443,9 @@ end module TextDocumentSaveRegistrationOptions = struct type t = { documentSelector : DocumentSelector.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; includeText : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -50549,9 +50553,9 @@ module TextDocumentSaveRegistrationOptions = struct [@@@end] let create - ?(documentSelector : DocumentSelector.t option) - ?(includeText : bool option) - (() : unit) + ?(documentSelector : DocumentSelector.t option) + ?(includeText : bool option) + (() : unit) : t = { documentSelector; includeText } @@ -50561,11 +50565,11 @@ end module TypeDefinitionParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -50726,11 +50730,11 @@ module TypeDefinitionParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; position; textDocument; workDoneToken } @@ -50746,7 +50750,7 @@ module TypeHierarchyItem = struct ; range : Range.t ; selectionRange : Range.t ; tags : SymbolTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; uri : DocumentUri.t } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -50984,15 +50988,15 @@ module TypeHierarchyItem = struct [@@@end] let create - ?(data : Json.t option) - ?(detail : string option) - ~(kind : SymbolKind.t) - ~(name : string) - ~(range : Range.t) - ~(selectionRange : Range.t) - ?(tags : SymbolTag.t list option) - ~(uri : DocumentUri.t) - (() : unit) + ?(data : Json.t option) + ?(detail : string option) + ~(kind : SymbolKind.t) + ~(name : string) + ~(range : Range.t) + ~(selectionRange : Range.t) + ?(tags : SymbolTag.t list option) + ~(uri : DocumentUri.t) + (() : unit) : t = { data; detail; kind; name; range; selectionRange; tags; uri } @@ -51004,7 +51008,7 @@ module TypeHierarchyPrepareParams = struct { position : Position.t ; textDocument : TextDocumentIdentifier.t ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -51135,10 +51139,10 @@ module TypeHierarchyPrepareParams = struct [@@@end] let create - ~(position : Position.t) - ~(textDocument : TextDocumentIdentifier.t) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(position : Position.t) + ~(textDocument : TextDocumentIdentifier.t) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { position; textDocument; workDoneToken } @@ -51149,9 +51153,9 @@ module TypeHierarchySubtypesParams = struct type t = { item : TypeHierarchyItem.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -51292,10 +51296,10 @@ module TypeHierarchySubtypesParams = struct [@@@end] let create - ~(item : TypeHierarchyItem.t) - ?(partialResultToken : ProgressToken.t option) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(item : TypeHierarchyItem.t) + ?(partialResultToken : ProgressToken.t option) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { item; partialResultToken; workDoneToken } @@ -51306,9 +51310,9 @@ module TypeHierarchySupertypesParams = struct type t = { item : TypeHierarchyItem.t ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -51449,10 +51453,10 @@ module TypeHierarchySupertypesParams = struct [@@@end] let create - ~(item : TypeHierarchyItem.t) - ?(partialResultToken : ProgressToken.t option) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ~(item : TypeHierarchyItem.t) + ?(partialResultToken : ProgressToken.t option) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { item; partialResultToken; workDoneToken } @@ -51743,8 +51747,8 @@ module WillSaveTextDocumentParams = struct [@@@end] let create - ~(reason : TextDocumentSaveReason.t) - ~(textDocument : TextDocumentIdentifier.t) + ~(reason : TextDocumentSaveReason.t) + ~(textDocument : TextDocumentIdentifier.t) : t = { reason; textDocument } @@ -51754,7 +51758,7 @@ end module WorkDoneProgressBegin = struct type t = { cancellable : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; message : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; percentage : int Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; title : string @@ -51914,11 +51918,11 @@ module WorkDoneProgressBegin = struct [@@@end] let create - ?(cancellable : bool option) - ?(message : string option) - ?(percentage : int option) - ~(title : string) - (() : unit) + ?(cancellable : bool option) + ?(message : string option) + ?(percentage : int option) + ~(title : string) + (() : unit) : t = { cancellable; message; percentage; title } @@ -52179,7 +52183,7 @@ end module WorkDoneProgressOptions = struct type t = { workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -52266,7 +52270,7 @@ end module WorkDoneProgressParams = struct type t = { workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -52353,7 +52357,7 @@ end module WorkDoneProgressReport = struct type t = { cancellable : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; message : string Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; percentage : int Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } @@ -52481,10 +52485,10 @@ module WorkDoneProgressReport = struct [@@@end] let create - ?(cancellable : bool option) - ?(message : string option) - ?(percentage : int option) - (() : unit) + ?(cancellable : bool option) + ?(message : string option) + ?(percentage : int option) + (() : unit) : t = { cancellable; message; percentage } @@ -52500,12 +52504,12 @@ end module WorkspaceDiagnosticParams = struct type t = { identifier : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; previousResultIds : PreviousResultId.t list ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -52671,11 +52675,11 @@ module WorkspaceDiagnosticParams = struct [@@@end] let create - ?(identifier : string option) - ?(partialResultToken : ProgressToken.t option) - ~(previousResultIds : PreviousResultId.t list) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(identifier : string option) + ?(partialResultToken : ProgressToken.t option) + ~(previousResultIds : PreviousResultId.t list) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { identifier; partialResultToken; previousResultIds; workDoneToken } @@ -52810,10 +52814,10 @@ module WorkspaceUnchangedDocumentDiagnosticReport = struct [@@@end] let create - ~(resultId : string) - ~(uri : DocumentUri.t) - ?(version : int option) - (() : unit) + ~(resultId : string) + ~(uri : DocumentUri.t) + ?(version : int option) + (() : unit) : t = { resultId; uri; version } @@ -52832,7 +52836,7 @@ module WorkspaceFullDocumentDiagnosticReport = struct type t = { items : Diagnostic.t list ; resultId : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; uri : DocumentUri.t ; version : int Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] } @@ -52982,11 +52986,11 @@ module WorkspaceFullDocumentDiagnosticReport = struct [@@@end] let create - ~(items : Diagnostic.t list) - ?(resultId : string option) - ~(uri : DocumentUri.t) - ?(version : int option) - (() : unit) + ~(items : Diagnostic.t list) + ?(resultId : string option) + ~(uri : DocumentUri.t) + ?(version : int option) + (() : unit) : t = { items; resultId; uri; version } @@ -53003,7 +53007,7 @@ module WorkspaceDocumentDiagnosticReport = struct type t = [ `WorkspaceFullDocumentDiagnosticReport of WorkspaceFullDocumentDiagnosticReport.t | `WorkspaceUnchangedDocumentDiagnosticReport of - WorkspaceUnchangedDocumentDiagnosticReport.t + WorkspaceUnchangedDocumentDiagnosticReport.t ] let t_of_yojson (json : Json.t) : t = @@ -53198,7 +53202,7 @@ module WorkspaceFoldersInitializeParams = struct type t = { workspaceFolders : WorkspaceFolder.t list Json.Nullable_option.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -53293,13 +53297,13 @@ end module WorkspaceSymbol = struct type t = { containerName : string Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; data : Json.t option [@yojson.option] ; kind : SymbolKind.t ; location : Location.t ; name : string ; tags : SymbolTag.t list Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -53498,13 +53502,13 @@ module WorkspaceSymbol = struct [@@@end] let create - ?(containerName : string option) - ?(data : Json.t option) - ~(kind : SymbolKind.t) - ~(location : Location.t) - ~(name : string) - ?(tags : SymbolTag.t list option) - (() : unit) + ?(containerName : string option) + ?(data : Json.t option) + ~(kind : SymbolKind.t) + ~(location : Location.t) + ~(name : string) + ?(tags : SymbolTag.t list option) + (() : unit) : t = { containerName; data; kind; location; name; tags } @@ -53514,10 +53518,10 @@ end module WorkspaceSymbolParams = struct type t = { partialResultToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; query : string ; workDoneToken : ProgressToken.t Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -53658,10 +53662,10 @@ module WorkspaceSymbolParams = struct [@@@end] let create - ?(partialResultToken : ProgressToken.t option) - ~(query : string) - ?(workDoneToken : ProgressToken.t option) - (() : unit) + ?(partialResultToken : ProgressToken.t option) + ~(query : string) + ?(workDoneToken : ProgressToken.t option) + (() : unit) : t = { partialResultToken; query; workDoneToken } @@ -53671,9 +53675,9 @@ end module WorkspaceSymbolRegistrationOptions = struct type t = { resolveProvider : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] ; workDoneProgress : bool Json.Nullable_option.t - [@default None] [@yojson_drop_default ( = )] + [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -53780,9 +53784,9 @@ module WorkspaceSymbolRegistrationOptions = struct [@@@end] let create - ?(resolveProvider : bool option) - ?(workDoneProgress : bool option) - (() : unit) + ?(resolveProvider : bool option) + ?(workDoneProgress : bool option) + (() : unit) : t = { resolveProvider; workDoneProgress } diff --git a/lsp/src/types.mli b/lsp/src/types.mli index 16cd38f29..7957fe9b1 100644 --- a/lsp/src/types.mli +++ b/lsp/src/types.mli @@ -3053,7 +3053,7 @@ module DocumentDiagnosticReport : sig type t = [ `RelatedFullDocumentDiagnosticReport of RelatedFullDocumentDiagnosticReport.t | `RelatedUnchangedDocumentDiagnosticReport of - RelatedUnchangedDocumentDiagnosticReport.t + RelatedUnchangedDocumentDiagnosticReport.t ] include Json.Jsonable.S with type t := t @@ -4201,7 +4201,7 @@ module ServerCapabilities : sig [ `Bool of bool | `LinkedEditingRangeOptions of LinkedEditingRangeOptions.t | `LinkedEditingRangeRegistrationOptions of - LinkedEditingRangeRegistrationOptions.t + LinkedEditingRangeRegistrationOptions.t ] option ; monikerProvider : @@ -4213,7 +4213,7 @@ module ServerCapabilities : sig ; notebookDocumentSync : [ `NotebookDocumentSyncOptions of NotebookDocumentSyncOptions.t | `NotebookDocumentSyncRegistrationOptions of - NotebookDocumentSyncRegistrationOptions.t + NotebookDocumentSyncRegistrationOptions.t ] option ; positionEncoding : PositionEncodingKind.t option @@ -4320,7 +4320,7 @@ module ServerCapabilities : sig [ `Bool of bool | `LinkedEditingRangeOptions of LinkedEditingRangeOptions.t | `LinkedEditingRangeRegistrationOptions of - LinkedEditingRangeRegistrationOptions.t + LinkedEditingRangeRegistrationOptions.t ] -> ?monikerProvider: [ `Bool of bool @@ -4330,7 +4330,7 @@ module ServerCapabilities : sig -> ?notebookDocumentSync: [ `NotebookDocumentSyncOptions of NotebookDocumentSyncOptions.t | `NotebookDocumentSyncRegistrationOptions of - NotebookDocumentSyncRegistrationOptions.t + NotebookDocumentSyncRegistrationOptions.t ] -> ?positionEncoding:PositionEncodingKind.t -> ?referencesProvider:[ `Bool of bool | `ReferenceOptions of ReferenceOptions.t ] @@ -5563,7 +5563,7 @@ module WorkspaceDocumentDiagnosticReport : sig type t = [ `WorkspaceFullDocumentDiagnosticReport of WorkspaceFullDocumentDiagnosticReport.t | `WorkspaceUnchangedDocumentDiagnosticReport of - WorkspaceUnchangedDocumentDiagnosticReport.t + WorkspaceUnchangedDocumentDiagnosticReport.t ] include Json.Jsonable.S with type t := t diff --git a/lsp/test/diff_tests.ml b/lsp/test/diff_tests.ml index 5ce731998..55d5e5ee2 100644 --- a/lsp/test/diff_tests.ml +++ b/lsp/test/diff_tests.ml @@ -31,7 +31,8 @@ let test ~from ~to_ = let%expect_test "empty strings" = test ~from:"" ~to_:""; - [%expect {| + [%expect + {| [] |}] ;; @@ -94,7 +95,8 @@ let%expect_test "to empty" = let%expect_test "no change" = test ~from:"foobar" ~to_:"foobar"; - [%expect {| + [%expect + {| [] |}] ;; @@ -145,11 +147,15 @@ let%expect_test "delete empty line" = let%expect_test "regerssion test 1" = Printexc.record_backtrace false; - test ~from:{|a + test + ~from: + {|a y z u -|} ~to_:{|x +|} + ~to_: + {|x y z |}; diff --git a/lsp/test/string_zipper_tests.ml b/lsp/test/string_zipper_tests.ml index 61e166e23..3fad28329 100644 --- a/lsp/test/string_zipper_tests.ml +++ b/lsp/test/string_zipper_tests.ml @@ -89,7 +89,8 @@ let%expect_test "goto line" = line 0: "|foo\nX\nY" line 0: "|foo\nX\nY" |}]; test `String (String_zipper.of_string "") [ `Goto_line 100; `Goto_line 0 ]; - [%expect {| + [%expect + {| line 0: "|" line 0: "|" |}]; test `String foo [ `Insert "baz"; `Goto_line 1; `Insert "1" ]; @@ -103,13 +104,16 @@ let%expect_test "goto line" = let%expect_test "insertions" = let foo = String_zipper.of_string "foo" in test `String foo [ `Insert "" ]; - [%expect {| + [%expect + {| line 0: "|foo" |}]; test `String foo [ `Insert "a" ]; - [%expect {| + [%expect + {| line 0: "|afoo" |}]; test `String foo [ `Insert "a"; `Insert "b" ]; - [%expect {| + [%expect + {| line 0: "|afoo" line 0: "|bafoo" |}] ;; @@ -130,13 +134,15 @@ let%expect_test "drop_until" = let t' = String_zipper.goto_line t 2 in let t = String_zipper.drop_until t t' in printfn "%S" (String_zipper.to_string_debug t); - [%expect {| + [%expect + {| "foo\n|xxx" |}]; let t = String_zipper.of_string "foo\nbar\n" in let t = String_zipper.goto_line t 2 in let t = String_zipper.drop_until t t in printfn "%S" (String_zipper.to_string_debug t); - [%expect {| + [%expect + {| "foo\nbar\n|" |}]; let t = String_zipper.of_string "123\n" in let t = String_zipper.goto_line t 1 in @@ -152,7 +158,8 @@ let%expect_test "squashing" = let t, str' = String_zipper.squash t in assert (String.equal str str'); printfn "squashing: %S" (String_zipper.to_string_debug t); - [%expect {| + [%expect + {| squashing: "foo\n|bar" |}] ;; @@ -163,7 +170,8 @@ let%expect_test "add buffer between" = let b = Buffer.create 0 in String_zipper.add_buffer_between b t t'; printfn "result: %S" (Buffer.contents b); - [%expect {| + [%expect + {| result: "foo\n" |}] ;; @@ -173,9 +181,11 @@ let%expect_test "drop_until bug" = let t = String_zipper.goto_line t 2 in let t = String_zipper.drop_until t t' in printfn "%S" (String_zipper.to_string_debug t); - [%expect {| + [%expect + {| "foo\nbar\n|" |}]; printfn "abs_pos: %d" (String_zipper.Private.reflect t).abs_pos; - [%expect {| + [%expect + {| abs_pos: 8 |}] ;; diff --git a/lsp/test/substring_tests.ml b/lsp/test/substring_tests.ml index 11a1116b7..e34c52641 100644 --- a/lsp/test/substring_tests.ml +++ b/lsp/test/substring_tests.ml @@ -59,13 +59,16 @@ let%expect_test "rsplit_at" = in let s = Substring.of_string "foo|bar" in test s 0; - [%expect {| + [%expect + {| "foo|bar" "" |}]; test s 4; - [%expect {| + [%expect + {| "foo" "|bar" |}]; test s 7; - [%expect {| + [%expect + {| "" "foo|bar" |}] ;; @@ -88,23 +91,28 @@ let test f sub ~pos ~len = let%expect_test "move_left" = let test = test Substring.move_left in test "foobar" ~pos:3 ~len:2; - [%expect {| + [%expect + {| [definitive] newlines = 0 consumed = 2 |}]; test "foobar" ~pos:3 ~len:0; - [%expect {| + [%expect + {| [definitive] newlines = 0 consumed = 0 |}]; test "fo\no\nbar" ~pos:4 ~len:3; - [%expect {| + [%expect + {| [definitive] newlines = 1 consumed = 3 |}]; test "fo\no\nbar" ~pos:4 ~len:2; - [%expect {| + [%expect + {| [definitive] newlines = 1 consumed = 2 |}]; test "fo" ~pos:1 ~len:2; - [%expect {| + [%expect + {| [definitive] newlines = 0 consumed = 1 |}] ;; @@ -112,19 +120,23 @@ let%expect_test "move_left" = let%expect_test "move_right" = let test = test Substring.move_right in test "foobar" ~pos:3 ~len:2; - [%expect {| + [%expect + {| [definitive] newlines = 0 consumed = 2 |}]; test "foobar" ~pos:3 ~len:0; - [%expect {| + [%expect + {| [definitive] newlines = 0 consumed = 0 |}]; test "\n\nf" ~pos:2 ~len:3; - [%expect {| + [%expect + {| [definitive] newlines = 0 consumed = 1 |}]; test "fo\no\nbar" ~pos:4 ~len:2; - [%expect {| + [%expect + {| [definitive] newlines = 1 consumed = 2 |}] ;; @@ -154,23 +166,28 @@ let%expect_test "rindex_from" = print res')) in test "foo" 0; - [%expect {| + [%expect + {| [definitive] not found |}]; test "foo" 1; - [%expect {| + [%expect + {| [definitive] not found |}]; test "\nfoo" 1; - [%expect {| + [%expect + {| [definitive] 0 |}]; test "\nfoo" 2; - [%expect {| + [%expect + {| [definitive] 0 |}]; test "\nfoo" 4; - [%expect {| + [%expect + {| [definitive] 0 |}]; test "\nfoo" 5; @@ -179,7 +196,8 @@ let%expect_test "rindex_from" = [definitive] exception: Invalid_argument("Substring.rindex_from: out of bounds") |}]; test "" 0; - [%expect {| + [%expect + {| [definitive] not found |}]; test "" 1; diff --git a/lsp/test/text_document_tests.ml b/lsp/test/text_document_tests.ml index 2edae8a5e..2f703508e 100644 --- a/lsp/test/text_document_tests.ml +++ b/lsp/test/text_document_tests.ml @@ -63,19 +63,22 @@ let test_multiple text changes = let%expect_test "first line insert" = let range = tuple_range (0, 1) (0, 3) in test "foo bar baz" range ~change:"XXXX"; - [%expect {| + [%expect + {| result: fXXXX bar baz |}] ;; let%expect_test "null edit" = test "foo bar" (tuple_range (0, 2) (0, 2)) ~change:""; - [%expect {| + [%expect + {| result: foo bar |}] ;; let%expect_test "no range" = test_general "foo bar baz" [ None, "XXXX" ]; - [%expect {| + [%expect + {| result: XXXX |}] ;; @@ -86,7 +89,8 @@ let%expect_test "char by char" = ; tuple_range (0, 1) (0, 1), "o" ; tuple_range (0, 2) (0, 2), "o" ]; - [%expect {| + [%expect + {| result: foo |}] ;; @@ -98,7 +102,8 @@ let%expect_test "char by char - 2" = ; tuple_range (1, 10) (1, 10), "r" ; tuple_range (1, 1) (1, 2), "" ]; - [%expect {| + [%expect + {| result: char by char - 2\nbr |}] ;; @@ -109,113 +114,133 @@ let%expect_test "char by char - 3" = ; tuple_range (1, 3) (1, 4), "" ; tuple_range (1, 3) (1, 3), "x" ]; - [%expect {| + [%expect + {| result: first line skip\nchaxby char - 2\n |}] ;; let%expect_test "insert last" = test "x" (tuple_range (0, 1) (0, 1)) ~change:"y"; - [%expect {| + [%expect + {| result: xy |}]; test "x\ny" (tuple_range (1, 1) (1, 1)) ~change:"z"; - [%expect {| + [%expect + {| result: x\nyz |}]; test "x\ny" (tuple_range (1, 10) (1, 10)) ~change:"z"; - [%expect {| + [%expect + {| result: x\nyz |}] ;; let%expect_test "replace second line" = let range = tuple_range (1, 0) (2, 0) in test "foo\nbar\nbaz\n" range ~change:"XXXX\n"; - [%expect {| + [%expect + {| result: foo\nXXXX\nbaz\n |}] ;; let%expect_test "edit in second line" = let range = tuple_range (1, 1) (1, 2) in test "foo\nbar\nbaz\n" range ~change:"-XXX-"; - [%expect {| + [%expect + {| result: foo\nb-XXX-r\nbaz\n |}] ;; let%expect_test "insert at the end" = let range = tuple_range (3, 0) (3, 0) in test "foo\nbar\nbaz\n" range ~change:"XXX"; - [%expect {| + [%expect + {| result: foo\nbar\nbaz\nXXX |}]; let range = tuple_range (3, 0) (4, 0) in test "foo\nbar\nbaz\n" range ~change:"XXX"; - [%expect {| + [%expect + {| result: foo\nbar\nbaz\nXXX |}] ;; let%expect_test "insert at the beginning" = let range = tuple_range (0, 0) (0, 0) in test "foo\n\bar\nbaz\n" range ~change:"XXX\n"; - [%expect {| + [%expect + {| result: XXX\nfoo\n\bar\nbaz\n |}] ;; let%expect_test "insert in the middle" = test "ab" (tuple_range (0, 1) (0, 1)) ~change:"---"; - [%expect {| + [%expect + {| result: a---b |}] ;; let%expect_test "replace first line" = let range = tuple_range (0, 0) (1, 0) in test "foo\nbar\n" range ~change:"baz\n"; - [%expect {| + [%expect + {| result: baz\nbar\n |}] ;; let%expect_test "beyond max char" = let range = tuple_range (0, 0) (0, 100) in test "foo\nbar\n" range ~change:"baz"; - [%expect {| + [%expect + {| result: baz\nbar\n |}] ;; let%expect_test "entire line without newline" = test "xxx\n" (tuple_range (0, 0) (0, 3)) ~change:"baz"; - [%expect {| + [%expect + {| result: baz\n |}]; test "xxx\n" (tuple_range (0, 0) (0, 4)) ~change:"baz"; - [%expect {| + [%expect + {| result: baz\n |}]; test "xxx\n" (tuple_range (0, 0) (1, 0)) ~change:"baz"; - [%expect {| + [%expect + {| result: baz |}] ;; let%expect_test "replace two lines" = test "a\nb\nc\n" (tuple_range (0, 0) (2, 0)) ~change:"XXX\n"; - [%expect {| + [%expect + {| result: XXX\nc\n |}] ;; let%expect_test "join lines" = test "a\nb" (tuple_range (0, 1) (1, 0)) ~change:""; - [%expect {| + [%expect + {| result: ab |}] ;; let%expect_test "remove text" = test "a---b" (tuple_range (0, 1) (0, 4)) ~change:""; - [%expect {| + [%expect + {| result: ab |}] ;; let%expect_test "remove newline - 1" = test "\n" (tuple_range (0, 0) (0, 1)) ~change:""; - [%expect {| + [%expect + {| result: \n |}] ;; let%expect_test "remove newlines - 2" = test_multiple "\nXXX\n" [ tuple_range (0, 0) (0, 1), "" ]; - [%expect {| + [%expect + {| result: \nXXX\n |}] ;; @@ -223,13 +248,15 @@ let%expect_test "remove newlines - 3" = test_multiple "\nXXX\n\n" [ tuple_range (0, 0) (0, 1), ""; tuple_range (0, 1) (0, 2), "" ]; - [%expect {| + [%expect + {| result: \nXXX\n\n |}] ;; let%expect_test "update when inserting a line at the end of the doc" = test "let x = 1;\n\nlet y = 2;" (tuple_range (2, 10) (2, 10)) ~change:"\n-ZZZ"; - [%expect {| + [%expect + {| result: let x = 1;\n\nlet y = 2;\n-ZZZ |}] ;; @@ -237,7 +264,8 @@ let%expect_test "update when inserting a line at the end of the doc" = test_multiple "1\n2\n3\n" [ tuple_range (1, 9) (1, 9), "l"; tuple_range (1, 9) (1, 10), "" ]; - [%expect {| + [%expect + {| result: 1\n2l\n3\n |}] ;; @@ -268,7 +296,8 @@ let%expect_test "replace second line first line is \\n" = let edit = TextEdit.create ~newText:"change" ~range in let new_doc = Text_document.apply_text_document_edits doc [ edit ] in new_doc |> Text_document.text |> String.escaped |> print_endline; - [%expect {| + [%expect + {| \nfochangeo\nbar\nbaz\n |}] ;; @@ -280,7 +309,8 @@ let%expect_test "get position after change" = let pos = Text_document.absolute_position new_doc range.start in new_doc |> Text_document.text |> String.escaped |> print_endline; printf "pos: %d\n" pos; - [%expect {| + [%expect + {| \nfochangeo\nbar\nbaz\n pos: 22 |}] ;; diff --git a/ocaml-lsp-server.opam b/ocaml-lsp-server.opam index 0ea34162c..bf21a7132 100644 --- a/ocaml-lsp-server.opam +++ b/ocaml-lsp-server.opam @@ -39,7 +39,7 @@ depends: [ "astring" "camlp-streams" "ppx_expect" {>= "v0.17.0" & with-test} - "ocamlformat" {with-test & = "0.26.2"} + "ocamlformat" {with-test & = "0.27.0"} "ocamlc-loc" {>= "3.7.0"} "pp" {>= "1.1.2"} "csexp" {>= "1.5"} diff --git a/ocaml-lsp-server/src/code_actions/action_destruct_line.ml b/ocaml-lsp-server/src/code_actions/action_destruct_line.ml index 5502bc052..f9258065a 100644 --- a/ocaml-lsp-server/src/code_actions/action_destruct_line.ml +++ b/ocaml-lsp-server/src/code_actions/action_destruct_line.ml @@ -58,8 +58,8 @@ let is_hole (case_line : string) (cursor_pos : int) = let arrow_pos = String.substr_index_exn case_line ~pattern:"->" in if cursor_pos <= 0 || cursor_pos >= arrow_pos then false (* We're only looking for '_' if the cursor is between "|" and "->". *) - else if Char.equal case_line.[cursor_pos] '_' - || Char.equal case_line.[cursor_pos - 1] '_' + else if + Char.equal case_line.[cursor_pos] '_' || Char.equal case_line.[cursor_pos - 1] '_' then true else false ;; diff --git a/ocaml-lsp-server/src/code_actions/action_inline.ml b/ocaml-lsp-server/src/code_actions/action_inline.ml index 6114ce5dd..629c12b14 100644 --- a/ocaml-lsp-server/src/code_actions/action_inline.ml +++ b/ocaml-lsp-server/src/code_actions/action_inline.ml @@ -272,10 +272,10 @@ let inline_edits pipeline task = in (* inlining into an argument context has some special cases *) let arg_iter - env - (iter : I.iterator) - (label : Asttypes.arg_label) - (m_arg_expr : Typedtree.expression option) + env + (iter : I.iterator) + (label : Asttypes.arg_label) + (m_arg_expr : Typedtree.expression option) = match label, m_arg_expr with (* handle the labeled argument shorthand `f ~x` when inlining `x` *) diff --git a/ocaml-lsp-server/src/code_actions/action_jump.ml b/ocaml-lsp-server/src/code_actions/action_jump.ml index c33a0c451..19e4cdf29 100644 --- a/ocaml-lsp-server/src/code_actions/action_jump.ml +++ b/ocaml-lsp-server/src/code_actions/action_jump.ml @@ -62,9 +62,9 @@ let process_jump_request ~merlin ~position ~target = ;; let code_actions - (doc : Document.t) - (params : CodeActionParams.t) - (capabilities : ShowDocumentClientCapabilities.t option) + (doc : Document.t) + (params : CodeActionParams.t) + (capabilities : ShowDocumentClientCapabilities.t option) = match Document.kind doc with | `Merlin merlin when available capabilities -> diff --git a/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml b/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml index 0b3d8f23a..c3e070856 100644 --- a/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml +++ b/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml @@ -76,8 +76,9 @@ let rec mark_value_unused_edit name contexts = | { loc = field_loc; _ }, _, { pat_desc = Tpat_var (ident, _, _); pat_loc; _ } when Ident.name ident = name -> (* Special case for record shorthand *) - if field_loc.loc_start = pat_loc.loc_start - && field_loc.loc_end = pat_loc.loc_end + if + field_loc.loc_start = pat_loc.loc_start + && field_loc.loc_end = pat_loc.loc_end then let+ end_pos = Position.of_lexical_position pat_loc.loc_end in TextEdit. @@ -144,10 +145,10 @@ let enclosing_value_binding_range name = (* Create a code action that removes [range] and refers to [diagnostic]. *) let code_action_remove_range - ?(title = "Remove unused") - doc - (diagnostic : Diagnostic.t) - range + ?(title = "Remove unused") + doc + (diagnostic : Diagnostic.t) + range = let edit = Document.edit doc [ { range; newText = "" } ] in CodeAction.create diff --git a/ocaml-lsp-server/src/code_actions/action_refactor_open.ml b/ocaml-lsp-server/src/code_actions/action_refactor_open.ml index ffb1aefe7..844a74f01 100644 --- a/ocaml-lsp-server/src/code_actions/action_refactor_open.ml +++ b/ocaml-lsp-server/src/code_actions/action_refactor_open.ml @@ -1,11 +1,11 @@ open Import let code_action - (mode : [ `Qualify | `Unqualify ]) - (action_kind : string) - pipeline - _ - (params : CodeActionParams.t) + (mode : [ `Qualify | `Unqualify ]) + (action_kind : string) + pipeline + _ + (params : CodeActionParams.t) = let res = let command = diff --git a/ocaml-lsp-server/src/code_actions/code_action.ml b/ocaml-lsp-server/src/code_actions/code_action.ml index b3904c153..468dd250c 100644 --- a/ocaml-lsp-server/src/code_actions/code_action.ml +++ b/ocaml-lsp-server/src/code_actions/code_action.ml @@ -9,7 +9,7 @@ type t = { kind : CodeActionKind.t ; run : [ `Batchable of - Mpipeline.t -> Document.t -> CodeActionParams.t -> CodeAction.t option + Mpipeline.t -> Document.t -> CodeActionParams.t -> CodeAction.t option | `Non_batchable of Document.t -> CodeActionParams.t -> CodeAction.t option Fiber.t ] } diff --git a/ocaml-lsp-server/src/code_actions/code_action.mli b/ocaml-lsp-server/src/code_actions/code_action.mli index aa877d5d3..37f2439fe 100644 --- a/ocaml-lsp-server/src/code_actions/code_action.mli +++ b/ocaml-lsp-server/src/code_actions/code_action.mli @@ -4,10 +4,10 @@ type t = { kind : CodeActionKind.t ; run : [ `Batchable of - Mpipeline.t -> Document.t -> CodeActionParams.t -> CodeAction.t option + Mpipeline.t -> Document.t -> CodeActionParams.t -> CodeAction.t option | `Non_batchable of Document.t -> CodeActionParams.t -> CodeAction.t option Fiber.t ] - (** A code action is either "batchable" or "non-batchable". Batchable + (** A code action is either "batchable" or "non-batchable". Batchable actions do not use fibers internally, so they can be safely run inside a [with_pipeline] context. Non-batchable actions can use fibers. *) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 87cd889a4..3ef48110e 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -95,11 +95,11 @@ let sortText_of_index idx = Printf.sprintf "%04d" idx module Complete_by_prefix = struct let completionItem_of_completion_entry - idx - (entry : Query_protocol.Compl.entry) - ~compl_params - ~range - ~deprecated + idx + (entry : Query_protocol.Compl.entry) + ~compl_params + ~range + ~deprecated = let kind = completion_kind entry.kind in let textEdit = `TextEdit { TextEdit.range; newText = entry.name } in @@ -122,12 +122,12 @@ module Complete_by_prefix = struct ;; let process_dispatch_resp - ~deprecated - ~resolve - ~prefix - doc - pos - (completion : Query_protocol.completions) + ~deprecated + ~resolve + ~prefix + doc + pos + (completion : Query_protocol.completions) = let range = let logical_pos = Position.logical pos in @@ -181,9 +181,9 @@ module Complete_by_prefix = struct ~label:"in" ~textEdit: (`TextEdit - (TextEdit.create - ~newText:"in" - ~range:(range_prefix completion_position prefix))) + (TextEdit.create + ~newText:"in" + ~range:(range_prefix completion_position prefix))) ~kind:CompletionItemKind.Keyword () in @@ -227,9 +227,10 @@ module Complete_with_construct = struct | Some (loc, constructed_exprs) -> let range = Range.of_loc loc in let deparen_constr_expr expr = - if (not (String.equal expr "()")) - && String.is_prefix expr ~prefix:"(" - && String.is_suffix expr ~suffix:")" + if + (not (String.equal expr "()")) + && String.is_prefix expr ~prefix:"(" + && String.is_suffix expr ~suffix:")" then String.sub expr ~pos:1 ~len:(String.length expr - 2) else expr in @@ -260,8 +261,8 @@ module Complete_with_construct = struct end let complete - (state : State.t) - ({ textDocument = { uri }; position = pos; context; _ } : CompletionParams.t) + (state : State.t) + ({ textDocument = { uri }; position = pos; context; _ } : CompletionParams.t) = Fiber.of_thunk (fun () -> let doc = Document_store.get state.store uri in diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index b561b4a92..eac3cf654 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -532,17 +532,17 @@ end type t = { codelens : Lens.t Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; extended_hover : ExtendedHover.t Json.Nullable_option.t - [@key "extendedHover"] [@default None] [@yojson_drop_default ( = )] + [@key "extendedHover"] [@default None] [@yojson_drop_default ( = )] ; standard_hover : StandardHover.t Json.Nullable_option.t - [@key "standardHover"] [@default None] [@yojson_drop_default ( = )] + [@key "standardHover"] [@default None] [@yojson_drop_default ( = )] ; inlay_hints : InlayHints.t Json.Nullable_option.t - [@key "inlayHints"] [@default None] [@yojson_drop_default ( = )] + [@key "inlayHints"] [@default None] [@yojson_drop_default ( = )] ; dune_diagnostics : DuneDiagnostics.t Json.Nullable_option.t - [@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )] + [@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )] ; syntax_documentation : SyntaxDocumentation.t Json.Nullable_option.t - [@key "syntaxDocumentation"] [@default None] [@yojson_drop_default ( = )] + [@key "syntaxDocumentation"] [@default None] [@yojson_drop_default ( = )] ; merlin_jump_code_actions : MerlinJumpCodeActions.t Json.Nullable_option.t - [@key "merlinJumpCodeActions"] [@default None] [@yojson_drop_default ( = )] + [@key "merlinJumpCodeActions"] [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] diff --git a/ocaml-lsp-server/src/custom_requests/util.mli b/ocaml-lsp-server/src/custom_requests/util.mli index d2fb9d565..3b50f9b1c 100644 --- a/ocaml-lsp-server/src/custom_requests/util.mli +++ b/ocaml-lsp-server/src/custom_requests/util.mli @@ -1,9 +1,9 @@ type 't req_params_spec = { params_schema : Jsonrpc.Structured.t - (** used to document the structure of the params; example: + (** used to document the structure of the params; example: [`Assoc [ "uri" , `String "" ]]; *) ; of_jsonrpc_params : Jsonrpc.Structured.t -> 't option - (** parses given structured JSON if it's of the expected schema; + (** parses given structured JSON if it's of the expected schema; otherwise, return [None] *) } diff --git a/ocaml-lsp-server/src/diagnostics.ml b/ocaml-lsp-server/src/diagnostics.ml index 0e265d8ee..2458516b2 100644 --- a/ocaml-lsp-server/src/diagnostics.ml +++ b/ocaml-lsp-server/src/diagnostics.ml @@ -89,9 +89,9 @@ type t = } let create - (capabilities : PublishDiagnosticsClientCapabilities.t option) - send - ~report_dune_diagnostics + (capabilities : PublishDiagnosticsClientCapabilities.t option) + send + ~report_dune_diagnostics = let related_information, tags = match capabilities with @@ -125,17 +125,18 @@ let send = (match diagnostics with | None -> [ diagnostic ] | Some diagnostics -> - if List.exists diagnostics ~f:(fun (d : Diagnostic.t) -> - match d.source with - | None -> assert false - | Some source -> - String.equal ocamllsp_source source - && - (match d.message, diagnostic.message with - | `String m1, `String m2 -> equal_message m1 m2 - | `MarkupContent { kind; value }, `MarkupContent mc -> - Poly.equal kind mc.kind && equal_message value mc.value - | _, _ -> false)) + if + List.exists diagnostics ~f:(fun (d : Diagnostic.t) -> + match d.source with + | None -> assert false + | Some source -> + String.equal ocamllsp_source source + && + (match d.message, diagnostic.message with + | `String m1, `String m2 -> equal_message m1 m2 + | `MarkupContent { kind; value }, `MarkupContent mc -> + Poly.equal kind mc.kind && equal_message value mc.value + | _, _ -> false)) then diagnostics else diagnostic :: diagnostics)) in @@ -161,8 +162,8 @@ let send = if annotate_dune_pid then fun pid (d : Diagnostic.t) -> - let source = Some (sprintf "dune (pid=%d)" (Pid.to_int pid)) in - { d with source } + let source = Some (sprintf "dune (pid=%d)" (Pid.to_int pid)) in + { d with source } else fun _pid x -> x in if t.report_dune_diagnostics diff --git a/ocaml-lsp-server/src/doc_to_md.ml b/ocaml-lsp-server/src/doc_to_md.ml index 8d0e569b4..7e08c22e5 100644 --- a/ocaml-lsp-server/src/doc_to_md.ml +++ b/ocaml-lsp-server/src/doc_to_md.ml @@ -38,7 +38,7 @@ let style_inline ~meta (style : Odoc_parser.Ast.style) inline = ;; let rec inline_element_to_inline - (inline : Odoc_parser.Ast.inline_element Odoc_parser.Loc.with_location) + (inline : Odoc_parser.Ast.inline_element Odoc_parser.Loc.with_location) : Inline.t = match inline with @@ -96,7 +96,8 @@ and inline_element_list_to_inlines inlines = ;; let rec nestable_block_element_to_block - (nestable : Odoc_parser.Ast.nestable_block_element Odoc_parser.Loc.with_location) + (nestable : + Odoc_parser.Ast.nestable_block_element Odoc_parser.Loc.with_location) = match nestable with | { value = `Paragraph text; location } -> @@ -227,7 +228,7 @@ let rec nestable_block_element_to_block Block.Ext_math_block (code_block, meta) and nestable_block_element_to_inlines - (nestable : Odoc_parser.Ast.nestable_block_element Odoc_parser.Loc.with_location) + (nestable : Odoc_parser.Ast.nestable_block_element Odoc_parser.Loc.with_location) = match nestable with | { value = `Paragraph text; location = _ } -> inline_element_list_to_inlines text @@ -382,7 +383,7 @@ let tag_to_block ~meta (tag : Odoc_parser.Ast.tag) = ;; let rec block_element_to_block - (block_element : Odoc_parser.Ast.block_element Odoc_parser.Loc.with_location) + (block_element : Odoc_parser.Ast.block_element Odoc_parser.Loc.with_location) = match block_element with | { value = `Heading (level, _, content); location } -> diff --git a/ocaml-lsp-server/src/document_symbol.ml b/ocaml-lsp-server/src/document_symbol.ml index e803a6594..37504a2da 100644 --- a/ocaml-lsp-server/src/document_symbol.ml +++ b/ocaml-lsp-server/src/document_symbol.ml @@ -136,10 +136,10 @@ let module_binding_document_symbol (pmod : Parsetree.module_binding) ~children = ;; let binding_document_symbol - (binding : Parsetree.value_binding) - ~ppx - ~is_top_level - ~children + (binding : Parsetree.value_binding) + ~ppx + ~is_top_level + ~children = let variables_in_pattern (pattern : Parsetree.pattern) = let symbols = ref [] in @@ -205,8 +205,8 @@ let binding_document_symbol let symbols_from_parsetree parsetree = let current = ref [] in let descend - (iter : unit -> unit) - (get_current_symbol : children:DocumentSymbol.t list -> DocumentSymbol.t) + (iter : unit -> unit) + (get_current_symbol : children:DocumentSymbol.t list -> DocumentSymbol.t) = let outer = !current in current := []; @@ -231,9 +231,9 @@ let symbols_from_parsetree parsetree = | _ -> Ast_iterator.default_iterator.signature_item iterator item in let rec structure_item - ~ppx - (iterator : Ast_iterator.iterator) - (item : Parsetree.structure_item) + ~ppx + (iterator : Ast_iterator.iterator) + (item : Parsetree.structure_item) = match item.pstr_desc with | Pstr_type (_, decls) -> current := !current @ List.map decls ~f:type_document_symbol diff --git a/ocaml-lsp-server/src/dune.ml b/ocaml-lsp-server/src/dune.ml index 7df41aa60..9ebacc37b 100644 --- a/ocaml-lsp-server/src/dune.ml +++ b/ocaml-lsp-server/src/dune.ml @@ -258,17 +258,17 @@ end = struct Fiber.fork_and_join_unit (fun () -> Progress.build_progress progress p) (fun () -> - match p with - | Failed | Interrupted | Success -> - let* () = - Document_store.parallel_iter document_store ~f:(fun doc -> - match Document.kind doc with - | `Other -> Fiber.return () - | `Merlin merlin -> - Diagnostics.merlin_diagnostics diagnostics merlin) - in - Diagnostics.send diagnostics `All - | _ -> Fiber.return ()) + match p with + | Failed | Interrupted | Success -> + let* () = + Document_store.parallel_iter document_store ~f:(fun doc -> + match Document.kind doc with + | `Other -> Fiber.return () + | `Merlin merlin -> + Diagnostics.merlin_diagnostics diagnostics merlin) + in + Diagnostics.send diagnostics `All + | _ -> Fiber.return ()) in Some ()) ;; @@ -333,13 +333,13 @@ end = struct Diagnostics.set diagnostics (`Dune - ( running.diagnostics_id - , id - , uri - , lsp_of_dune - diagnostics - ~include_promotions:config.include_promotions - d )); + ( running.diagnostics_id + , id + , uri + , lsp_of_dune + diagnostics + ~include_promotions:config.include_promotions + d )); promotions, requests :: add, remove) in promotions, List.flatten add, List.flatten remove @@ -362,9 +362,9 @@ end = struct let+ () = Fiber.fork_and_join_unit (fun () -> - Document_store.unregister_promotions config.document_store (uris remove)) + Document_store.unregister_promotions config.document_store (uris remove)) (fun () -> - Document_store.register_promotions config.document_store (uris add)) + Document_store.register_promotions config.document_store (uris add)) in Some ()) ;; @@ -644,9 +644,10 @@ let poll active last_error = let is_running dune = String.Map.mem active.instances (Registry.Dune.root dune) in Registry.current active.registry |> List.fold_left ~init:[] ~f:(fun acc dune -> - if (not (is_running dune)) - && List.exists workspace_folders ~f:(fun (wsf : WorkspaceFolder.t) -> - uri_dune_overlap wsf.uri dune) + if + (not (is_running dune)) + && List.exists workspace_folders ~f:(fun (wsf : WorkspaceFolder.t) -> + uri_dune_overlap wsf.uri dune) then Instance.create dune active.config :: acc else acc) in @@ -746,18 +747,18 @@ let stop (t : t) = Fiber.fork_and_join_unit (fun () -> Fiber.Pool.stop active.pool) (fun () -> - String.Map.values active.instances |> Fiber.parallel_iter ~f:Instance.stop)) + String.Map.values active.instances |> Fiber.parallel_iter ~f:Instance.stop)) ;; let env = Sys.getenv_opt let create - workspaces - (client_capabilities : ClientCapabilities.t) - diagnostics - progress - document_store - ~log + workspaces + (client_capabilities : ClientCapabilities.t) + diagnostics + progress + document_store + ~log = let config = let include_promotions = @@ -788,12 +789,12 @@ let create ;; let create - workspaces - (client_capabilities : ClientCapabilities.t) - diagnostics - progress - document_store - ~log + workspaces + (client_capabilities : ClientCapabilities.t) + diagnostics + progress + document_store + ~log = if inside_test then ref Closed diff --git a/ocaml-lsp-server/src/folding_range.ml b/ocaml-lsp-server/src/folding_range.ml index 546adf835..68c00e6ac 100644 --- a/ocaml-lsp-server/src/folding_range.ml +++ b/ocaml-lsp-server/src/folding_range.ml @@ -19,14 +19,14 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = in let iterator = let type_declaration - (_self : Ast_iterator.iterator) - (typ_decl : Parsetree.type_declaration) + (_self : Ast_iterator.iterator) + (typ_decl : Parsetree.type_declaration) = Range.of_loc typ_decl.ptype_loc |> push in let type_extension - (_self : Ast_iterator.iterator) - (typ_ext : Parsetree.type_extension) + (_self : Ast_iterator.iterator) + (typ_ext : Parsetree.type_extension) = let loc = typ_ext.ptyext_path.loc in let last_constr = List.last typ_ext.ptyext_constructors in @@ -38,8 +38,8 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = Range.of_loc loc |> push in let module_type_declaration - (self : Ast_iterator.iterator) - (mod_typ_decl : Parsetree.module_type_declaration) + (self : Ast_iterator.iterator) + (mod_typ_decl : Parsetree.module_type_declaration) = Range.of_loc mod_typ_decl.pmtd_loc |> push; Option.iter mod_typ_decl.pmtd_type ~f:(fun mod_typ -> self.module_type self mod_typ) @@ -54,8 +54,8 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = Ast_iterator.default_iterator.module_type self module_type in let module_declaration - (self : Ast_iterator.iterator) - (module_declaration : Parsetree.module_declaration) + (self : Ast_iterator.iterator) + (module_declaration : Parsetree.module_declaration) = let range = Range.of_loc module_declaration.pmd_loc in push range; @@ -73,15 +73,15 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = Ast_iterator.default_iterator.module_expr self module_expr in let class_declaration - (self : Ast_iterator.iterator) - (class_decl : Parsetree.class_declaration) + (self : Ast_iterator.iterator) + (class_decl : Parsetree.class_declaration) = class_decl.Parsetree.pci_loc |> Range.of_loc |> push; self.class_expr self class_decl.pci_expr in let class_description - (self : Ast_iterator.iterator) - (class_desc : Parsetree.class_description) + (self : Ast_iterator.iterator) + (class_desc : Parsetree.class_description) = class_desc.pci_loc |> Range.of_loc |> push; self.class_type self class_desc.pci_expr @@ -99,22 +99,22 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = Ast_iterator.default_iterator.class_type self class_type in let class_type_declaration - (self : Ast_iterator.iterator) - (class_type_decl : Parsetree.class_type_declaration) + (self : Ast_iterator.iterator) + (class_type_decl : Parsetree.class_type_declaration) = Range.of_loc class_type_decl.pci_loc |> push; Ast_iterator.default_iterator.class_type_declaration self class_type_decl in let class_type_field - (self : Ast_iterator.iterator) - (class_type_field : Parsetree.class_type_field) + (self : Ast_iterator.iterator) + (class_type_field : Parsetree.class_type_field) = Range.of_loc class_type_field.pctf_loc |> push; Ast_iterator.default_iterator.class_type_field self class_type_field in let value_binding - (self : Ast_iterator.iterator) - (value_binding : Parsetree.value_binding) + (self : Ast_iterator.iterator) + (value_binding : Parsetree.value_binding) = let range = Range.of_loc value_binding.pvb_loc in push range; @@ -220,22 +220,22 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = | Pexp_unreachable -> Ast_iterator.default_iterator.expr self expr in let module_binding - (self : Ast_iterator.iterator) - (module_binding : Parsetree.module_binding) + (self : Ast_iterator.iterator) + (module_binding : Parsetree.module_binding) = Range.of_loc module_binding.pmb_loc |> push; self.module_expr self module_binding.pmb_expr in let open_declaration - (self : Ast_iterator.iterator) - (open_decl : Parsetree.open_declaration) + (self : Ast_iterator.iterator) + (open_decl : Parsetree.open_declaration) = Range.of_loc open_decl.popen_loc |> push; self.module_expr self open_decl.popen_expr in let value_description - (_self : Ast_iterator.iterator) - (value_desc : Parsetree.value_description) + (_self : Ast_iterator.iterator) + (value_desc : Parsetree.value_description) = Range.of_loc value_desc.pval_loc |> push in diff --git a/ocaml-lsp-server/src/hover_req.ml b/ocaml-lsp-server/src/hover_req.ml index a64b0470b..3ad6eb739 100644 --- a/ocaml-lsp-server/src/hover_req.ml +++ b/ocaml-lsp-server/src/hover_req.ml @@ -100,8 +100,8 @@ let hover_at_cursor parsetree (`Logical (cursor_line, cursor_col)) = in (* Hover a value declaration in a signature *) let value_description - (self : Ast_iterator.iterator) - (desc : Parsetree.value_description) + (self : Ast_iterator.iterator) + (desc : Parsetree.value_description) = if is_at_cursor desc.pval_name.loc then result := Some `Type_enclosing; Ast_iterator.default_iterator.value_description self desc @@ -135,7 +135,10 @@ let hover_at_cursor parsetree (`Logical (cursor_line, cursor_col)) = | Pmod_ident { loc; _ } -> if is_at_cursor loc then result := Some `Type_enclosing | Pmod_structure _ -> let is_at_keyword = - let keyword_len = 6 (* struct *) in + let keyword_len = + 6 + (* struct *) + in let pos_cnum = expr.pmod_loc.loc_start.pos_cnum + keyword_len in is_at_cursor { loc_start = expr.pmod_loc.loc_start @@ -202,11 +205,11 @@ let format_as_code_block ~highlighter strings = ;; let format_type_enclosing - ~syntax - ~markdown - ~typ - ~doc - ~(syntax_doc : Query_protocol.syntax_doc_result option) + ~syntax + ~markdown + ~typ + ~doc + ~(syntax_doc : Query_protocol.syntax_doc_result option) = (* TODO for vscode, we should just use the language id. But that will not work for all editors *) @@ -244,13 +247,13 @@ let format_ppx_expansion ~ppx ~expansion = ;; let type_enclosing_hover - ~(server : State.t Server.t) - ~(doc : Document.t) - ~with_syntax_doc - ~merlin - ~mode - ~uri - ~position + ~(server : State.t Server.t) + ~(doc : Document.t) + ~with_syntax_doc + ~merlin + ~mode + ~uri + ~position = let state = Server.state server in let verbosity = @@ -323,9 +326,9 @@ let type_enclosing_hover ;; let ppx_expression_hover - ~ppx_parsetree - ~(expr : Parsetree.expression) - ~(ppx : string Asttypes.loc) + ~ppx_parsetree + ~(expr : Parsetree.expression) + ~(ppx : string Asttypes.loc) = let expanded_ppx = ref None in let at_expr_location (loc : Ocaml_parsing.Location.t) = @@ -360,9 +363,9 @@ let ppx_expression_hover ;; let typedef_attribute_hover - ~ppx_parsetree - ~(decl : Parsetree.type_declaration) - ~(attr : Parsetree.attribute) + ~ppx_parsetree + ~(decl : Parsetree.type_declaration) + ~(attr : Parsetree.attribute) = match attr.attr_name.txt with | "deriving" -> diff --git a/ocaml-lsp-server/src/inference.ml b/ocaml-lsp-server/src/inference.ml index 44dabd582..d51401e31 100644 --- a/ocaml-lsp-server/src/inference.ml +++ b/ocaml-lsp-server/src/inference.ml @@ -196,13 +196,13 @@ let text_edit_opt shared_signature ~formatter = different string on the [signature_item]s from the old interface and the new implementation. *) let build_signature_edits - ~(old_intf : Typedtree.signature) - ~(* Extracted by Merlin from the interface. *) - (range : Range.t) - ~(* Selected range in the interface. *) - (new_sigs : Types.signature) - ~(* Inferred by Merlin from the implementation. *) - (formatter : Types.signature_item -> string Fiber.t) + ~(old_intf : Typedtree.signature) + ~(* Extracted by Merlin from the interface. *) + (range : Range.t) + ~(* Selected range in the interface. *) + (new_sigs : Types.signature) + ~(* Inferred by Merlin from the implementation. *) + (formatter : Types.signature_item -> string Fiber.t) = (* These are [Typedtree.signature_item]s, and we need them for the location. *) let in_range_tree_items = @@ -232,10 +232,10 @@ let build_signature_edits (** Called by the code action for update-signatures. *) let update_signatures - ~(state : State.t) - ~(intf_merlin : Document.Merlin.t) - ~(doc : Document.t) - ~(range : Range.t) + ~(state : State.t) + ~(intf_merlin : Document.Merlin.t) + ~(doc : Document.t) + ~(range : Range.t) = Fiber.of_thunk (fun () -> let intf_uri = Document.uri doc in diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 1fca2b6fe..4d2fe1b0a 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -103,10 +103,11 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes in let executeCommandProvider = let commands = - if Action_open_related.available - (let open Option.O in - let* window = client_capabilities.window in - window.showDocument) + if + Action_open_related.available + (let open Option.O in + let* window = client_capabilities.window in + window.showDocument) then view_metrics_command_name :: Action_open_related.command_name @@ -382,8 +383,8 @@ let text_document_lens (state : State.t) { CodeLensParams.textDocument = { uri } ;; let selection_range - (state : State.t) - { SelectionRangeParams.textDocument = { uri }; positions; _ } + (state : State.t) + { SelectionRangeParams.textDocument = { uri }; positions; _ } = let doc = Document_store.get state.store uri in match Document.kind doc with @@ -415,9 +416,9 @@ let selection_range ;; let references - rpc - (state : State.t) - { ReferenceParams.textDocument = { uri }; position; _ } + rpc + (state : State.t) + { ReferenceParams.textDocument = { uri }; position; _ } = let doc = Document_store.get state.store uri in match Document.kind doc with @@ -461,8 +462,8 @@ let references ;; let highlight - (state : State.t) - { DocumentHighlightParams.textDocument = { uri }; position; _ } + (state : State.t) + { DocumentHighlightParams.textDocument = { uri }; position; _ } = let store = state.store in let doc = Document_store.get store uri in @@ -568,17 +569,17 @@ let on_request then later (fun state server -> - let store = state.store in - let+ () = Merlin_config_command.command_run server store in - `Null) + let store = state.store in + let+ () = Merlin_config_command.command_run server store in + `Null) server else if String.equal command.command Document_text_command.command_name then later (fun state server -> - let store = state.store in - let+ () = Document_text_command.command_run server store command.arguments in - `Null) + let store = state.store in + let+ () = Document_text_command.command_run server store command.arguments in + `Null) server else if String.equal command.command view_metrics_command_name then later (fun _state server -> view_metrics server) server @@ -590,38 +591,38 @@ let on_request else later (fun state () -> - let dune = State.dune state in - Dune.on_command dune command) + let dune = State.dune state in + Dune.on_command dune command) () | CompletionItemResolve ci -> later (fun state () -> - let markdown = - ClientCapabilities.markdown_support - (State.client_capabilities state) - ~field:(fun d -> - let open Option.O in - let+ completion = d.completion in - let* completion_item = completion.completionItem in - completion_item.documentationFormat) - in - let resolve = Compl.Resolve.of_completion_item ci in - match resolve with - | None -> Fiber.return ci - | Some resolve -> - let doc = - let uri = Compl.Resolve.uri resolve in - Document_store.get state.store uri - in - (match Document.kind doc with - | `Other -> Fiber.return ci - | `Merlin doc -> - Compl.resolve - doc - ci - resolve - (Document.Merlin.doc_comment ~name:"completion-resolve") - ~markdown)) + let markdown = + ClientCapabilities.markdown_support + (State.client_capabilities state) + ~field:(fun d -> + let open Option.O in + let+ completion = d.completion in + let* completion_item = completion.completionItem in + completion_item.documentationFormat) + in + let resolve = Compl.Resolve.of_completion_item ci in + match resolve with + | None -> Fiber.return ci + | Some resolve -> + let doc = + let uri = Compl.Resolve.uri resolve in + Document_store.get state.store uri + in + (match Document.kind doc with + | `Other -> Fiber.return ci + | `Merlin doc -> + Compl.resolve + doc + ci + resolve + (Document.Merlin.doc_comment ~name:"completion-resolve") + ~markdown)) () | CodeAction params -> Code_actions.compute server params | InlayHint params -> later (fun state () -> Inlay_hints.compute state params) () @@ -655,22 +656,22 @@ let on_request | TextDocumentPrepareRename { textDocument = { uri }; position; workDoneToken = _ } -> later (fun _ () -> - let doc = Document_store.get store uri in - match Document.kind doc with - | `Other -> Fiber.return None - | `Merlin doc -> - let+ locs, _synced = - Document.Merlin.dispatch_exn - ~name:"occurrences" - doc - (Occurrences (`Ident_at (Position.logical position), `Buffer)) - in - let loc = - List.find_opt locs ~f:(fun loc -> - let range = Range.of_loc loc in - Position.compare_inclusion position range = `Inside) - in - Option.map loc ~f:Range.of_loc) + let doc = Document_store.get store uri in + match Document.kind doc with + | `Other -> Fiber.return None + | `Merlin doc -> + let+ locs, _synced = + Document.Merlin.dispatch_exn + ~name:"occurrences" + doc + (Occurrences (`Ident_at (Position.logical position), `Buffer)) + in + let loc = + List.find_opt locs ~f:(fun loc -> + let range = Range.of_loc loc in + Position.compare_inclusion position range = `Inside) + in + Option.map loc ~f:Range.of_loc) () | TextDocumentRename req -> later Rename.rename req | TextDocumentFoldingRange req -> later Folding_range.compute req @@ -681,8 +682,8 @@ let on_request | TextDocumentFormatting { textDocument = { uri }; options = _; _ } -> later (fun _ () -> - let doc = Document_store.get store uri in - Formatter.run rpc doc) + let doc = Document_store.get store uri in + Formatter.run rpc doc) () | TextDocumentOnTypeFormatting _ -> now None | SelectionRange req -> later selection_range req diff --git a/ocaml-lsp-server/src/ocamlformat.ml b/ocaml-lsp-server/src/ocamlformat.ml index 6c20c21ac..28437f21f 100644 --- a/ocaml-lsp-server/src/ocamlformat.ml +++ b/ocaml-lsp-server/src/ocamlformat.ml @@ -56,9 +56,9 @@ let run_command cancel prog stdin_value args = Lev_fiber.Io.close stdin_o; Fiber.return ()) (fun () -> - Lev_fiber.Io.with_write stdin_o ~f:(fun w -> - Lev_fiber.Io.Writer.add_string w stdin_value; - Lev_fiber.Io.Writer.flush w)) + Lev_fiber.Io.with_write stdin_o ~f:(fun w -> + Lev_fiber.Io.Writer.add_string w stdin_value; + Lev_fiber.Io.Writer.flush w)) in let read from () = Fiber.finalize @@ -71,8 +71,8 @@ let run_command cancel prog stdin_value args = Fiber.fork_and_join (fun () -> Lev_fiber.waitpid ~pid:(Pid.to_int pid)) (fun () -> - Fiber.fork_and_join_unit stdin (fun () -> - Fiber.fork_and_join (read stdout_i) (read stderr_i))) + Fiber.fork_and_join_unit stdin (fun () -> + Fiber.fork_and_join (read stdout_i) (read stderr_i))) in { stdout; stderr; status }) ;; diff --git a/ocaml-lsp-server/src/semantic_highlighting.ml b/ocaml-lsp-server/src/semantic_highlighting.ml index 622c1cdc7..9aaa4eb07 100644 --- a/ocaml-lsp-server/src/semantic_highlighting.ml +++ b/ocaml-lsp-server/src/semantic_highlighting.ml @@ -207,13 +207,13 @@ end = struct ;; let set_token - arr - ~delta_line_index - ~delta_line - ~delta_start - ~length - ~token_type - ~token_modifiers + arr + ~delta_line_index + ~delta_line + ~delta_start + ~length + ~token_type + ~token_modifiers = arr.(delta_line_index) <- delta_line; arr.(delta_line_index + 1) <- delta_start; @@ -299,10 +299,10 @@ end = struct (* TODO: make sure we follow specs when parsing - https://v2.ocaml.org/manual/names.html#sss:refer-named *) let lident - ({ loc; _ } : Longident.t Loc.loc) - rightmost_name - ?(modifiers = Token_modifiers_set.empty) - () + ({ loc; _ } : Longident.t Loc.loc) + rightmost_name + ?(modifiers = Token_modifiers_set.empty) + () = if loc.loc_ghost then () @@ -350,8 +350,8 @@ end = struct ;; let constructor_arguments - (self : Ast_iterator.iterator) - (ca : Parsetree.constructor_arguments) + (self : Ast_iterator.iterator) + (ca : Parsetree.constructor_arguments) = match ca with | Pcstr_tuple l -> List.iter l ~f:(fun ct -> self.typ self ct) @@ -359,8 +359,8 @@ end = struct ;; let module_binding - (self : Ast_iterator.iterator) - ({ pmb_name; pmb_expr; pmb_attributes; pmb_loc = _ } : Parsetree.module_binding) + (self : Ast_iterator.iterator) + ({ pmb_name; pmb_expr; pmb_attributes; pmb_loc = _ } : Parsetree.module_binding) = add_token pmb_name.loc Token_type.module_ (Token_modifiers_set.singleton Definition); self.module_expr self pmb_expr; @@ -368,9 +368,9 @@ end = struct ;; let typ - (self : Ast_iterator.iterator) - ({ ptyp_desc; ptyp_attributes; ptyp_loc; ptyp_loc_stack = _ } as ct : - Parsetree.core_type) + (self : Ast_iterator.iterator) + ({ ptyp_desc; ptyp_attributes; ptyp_loc; ptyp_loc_stack = _ } as ct : + Parsetree.core_type) = let iter = match ptyp_desc with @@ -402,9 +402,9 @@ end = struct ;; let constructor_declaration - (self : Ast_iterator.iterator) - ({ pcd_name; pcd_vars; pcd_args; pcd_res; pcd_loc = _; pcd_attributes } : - Parsetree.constructor_declaration) + (self : Ast_iterator.iterator) + ({ pcd_name; pcd_vars; pcd_args; pcd_res; pcd_loc = _; pcd_attributes } : + Parsetree.constructor_declaration) = add_token pcd_name.loc @@ -418,9 +418,9 @@ end = struct ;; let label_declaration - (self : Ast_iterator.iterator) - ({ pld_name; pld_mutable = _; pld_type; pld_loc = _; pld_attributes } : - Parsetree.label_declaration) + (self : Ast_iterator.iterator) + ({ pld_name; pld_mutable = _; pld_type; pld_loc = _; pld_attributes } : + Parsetree.label_declaration) = add_token pld_name.loc (Token_type.of_builtin Property) Token_modifiers_set.empty; self.typ self pld_type; @@ -428,8 +428,8 @@ end = struct ;; let value_binding - (self : Ast_iterator.iterator) - ({ pvb_pat; pvb_expr; pvb_attributes; _ } as vb : Parsetree.value_binding) + (self : Ast_iterator.iterator) + ({ pvb_pat; pvb_expr; pvb_attributes; _ } as vb : Parsetree.value_binding) = match match pvb_pat.ppat_desc, pvb_expr.pexp_desc with @@ -464,17 +464,17 @@ end = struct ;; let type_declaration - (self : Ast_iterator.iterator) - ({ ptype_name - ; ptype_params - ; ptype_cstrs - ; ptype_kind - ; ptype_private = _ - ; ptype_manifest - ; ptype_attributes - ; ptype_loc = _ - } : - Parsetree.type_declaration) + (self : Ast_iterator.iterator) + ({ ptype_name + ; ptype_params + ; ptype_cstrs + ; ptype_kind + ; ptype_private = _ + ; ptype_manifest + ; ptype_attributes + ; ptype_loc = _ + } : + Parsetree.type_declaration) = List.iter ptype_params @@ -546,9 +546,9 @@ end = struct ;; let expr - (self : Ast_iterator.iterator) - ({ pexp_desc; pexp_loc; pexp_loc_stack = _; pexp_attributes } as exp : - Parsetree.expression) + (self : Ast_iterator.iterator) + ({ pexp_desc; pexp_loc; pexp_loc_stack = _; pexp_attributes } as exp : + Parsetree.expression) = match match pexp_desc with @@ -630,8 +630,9 @@ end = struct (let_ :: ands) ~f:(fun { Parsetree.pbop_op = _; pbop_pat; pbop_exp; pbop_loc = _ } -> self.pat self pbop_pat; - if Loc.compare pbop_pat.ppat_loc pbop_exp.pexp_loc - <> 0 (* handles punning as in e.g. [let* foo in ]*) + if + Loc.compare pbop_pat.ppat_loc pbop_exp.pexp_loc + <> 0 (* handles punning as in e.g. [let* foo in ]*) then self.expr self pbop_exp); self.expr self body; `Custom_iterator @@ -655,9 +656,9 @@ end = struct ;; let pat - (self : Ast_iterator.iterator) - ({ ppat_desc; ppat_loc; ppat_loc_stack = _; ppat_attributes } as pat : - Parsetree.pattern) + (self : Ast_iterator.iterator) + ({ ppat_desc; ppat_loc; ppat_loc_stack = _; ppat_attributes } as pat : + Parsetree.pattern) = match match ppat_desc with @@ -725,8 +726,8 @@ end = struct ;; let module_expr - (self : Ast_iterator.iterator) - ({ pmod_desc; pmod_loc = _; pmod_attributes } as me : Parsetree.module_expr) + (self : Ast_iterator.iterator) + ({ pmod_desc; pmod_loc = _; pmod_attributes } as me : Parsetree.module_expr) = match match pmod_desc with @@ -761,9 +762,9 @@ end = struct ;; let module_type_declaration - (self : Ast_iterator.iterator) - ({ pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc = _ } : - Parsetree.module_type_declaration) + (self : Ast_iterator.iterator) + ({ pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc = _ } : + Parsetree.module_type_declaration) = add_token pmtd_name.loc Token_type.module_type Token_modifiers_set.empty; Option.iter pmtd_type ~f:(fun mdtt -> self.module_type self mdtt); @@ -771,9 +772,9 @@ end = struct ;; let value_description - (self : Ast_iterator.iterator) - ({ pval_name; pval_type; pval_prim = _; pval_attributes; pval_loc = _ } : - Parsetree.value_description) + (self : Ast_iterator.iterator) + ({ pval_name; pval_type; pval_prim = _; pval_attributes; pval_loc = _ } : + Parsetree.value_description) = add_token pval_name.loc @@ -796,8 +797,9 @@ end = struct ;; let module_declaration - (self : Ast_iterator.iterator) - ({ pmd_name; pmd_type; pmd_attributes; pmd_loc = _ } : Parsetree.module_declaration) + (self : Ast_iterator.iterator) + ({ pmd_name; pmd_type; pmd_attributes; pmd_loc = _ } : + Parsetree.module_declaration) = add_token pmd_name.loc Token_type.module_ (Token_modifiers_set.singleton Declaration); self.module_type self pmd_type; @@ -985,7 +987,8 @@ let find_diff ~(old : int array) ~(new_ : int array) : SemanticTokensEdit.t list ;; let on_request_full_delta - : State.t -> SemanticTokensDeltaParams.t + : State.t + -> SemanticTokensDeltaParams.t -> [ `SemanticTokens of SemanticTokens.t | `SemanticTokensDelta of SemanticTokensDelta.t ] diff --git a/ocaml-lsp-server/src/state.ml b/ocaml-lsp-server/src/state.ml index 8d9422f38..4745879f3 100644 --- a/ocaml-lsp-server/src/state.ml +++ b/ocaml-lsp-server/src/state.ml @@ -85,12 +85,12 @@ let diagnostics t = ;; let initialize - t - ~position_encoding - (params : InitializeParams.t) - workspaces - dune - diagnostics + t + ~position_encoding + (params : InitializeParams.t) + workspaces + dune + diagnostics = assert (t.init = Uninitialized); { t with diff --git a/ocaml-lsp-server/src/state.mli b/ocaml-lsp-server/src/state.mli index 11ea459e4..0cecbe122 100644 --- a/ocaml-lsp-server/src/state.mli +++ b/ocaml-lsp-server/src/state.mli @@ -14,7 +14,7 @@ type init = (** State specific to the hoverExtended request. *) type hover_extended = { mutable history : (Uri.t * Position.t * int) option - (** File, position, and verbosity level of the last call to + (** File, position, and verbosity level of the last call to hoverExtended. This value is used to pick a verbosity level when it is not specific by the client. *) } diff --git a/ocaml-lsp-server/src/workspace_symbol.ml b/ocaml-lsp-server/src/workspace_symbol.ml index 27457ab26..60bed61de 100644 --- a/ocaml-lsp-server/src/workspace_symbol.ml +++ b/ocaml-lsp-server/src/workspace_symbol.ml @@ -299,9 +299,9 @@ let find_cm_files dir = ;; let run - ({ query; _ } : WorkspaceSymbolParams.t) - (workspace_folders : WorkspaceFolder.t list) - (cancel : Fiber.Cancel.t option) + ({ query; _ } : WorkspaceSymbolParams.t) + (workspace_folders : WorkspaceFolder.t list) + (cancel : Fiber.Cancel.t option) = let filter = match query with @@ -375,7 +375,7 @@ let run server (state : State.t) (params : WorkspaceSymbolParams.t) = let msg = let message = List.map errors ~f:(function Build_dir_not_found workspace_name -> - workspace_name) + workspace_name) |> String.concat ~sep:", " |> sprintf "No build directory found in workspace(s): %s" in diff --git a/ocaml-lsp-server/test/e2e-new/action_extract.ml b/ocaml-lsp-server/test/e2e-new/action_extract.ml index e9985d4be..dcef2d2e4 100644 --- a/ocaml-lsp-server/test/e2e-new/action_extract.ml +++ b/ocaml-lsp-server/test/e2e-new/action_extract.ml @@ -2,18 +2,21 @@ let extract_local_test = Code_actions.code_action_test ~title:"Extract local" let extract_function_test = Code_actions.code_action_test ~title:"Extract function" let%expect_test "extract local constant" = - extract_local_test {| + extract_local_test + {| let f = 0 + $1$ |}; - [%expect {| + [%expect + {| let f = let var_name = 1 in 0 + var_name |}] ;; let%expect_test "extract local expression" = - extract_local_test {| + extract_local_test + {| let f = let x = 2 in $0 + 1 + x$ + 1 @@ -27,11 +30,13 @@ let f = ;; let%expect_test "extract function single parameter" = - extract_function_test {| + extract_function_test + {| let f x = $(x * 2)$ + 3 |}; - [%expect {| + [%expect + {| let fun_name x = (x * 2) let f x = @@ -39,7 +44,8 @@ let f x = ;; let%expect_test "extract function multiple parameter" = - extract_function_test {| + extract_function_test + {| let f x = let y = 0 in $(x * y)$ + 3 @@ -67,7 +73,8 @@ let f x = (* TODO: This extraction shouldn't be allowed. *) let%expect_test "extract function with local exception" = - extract_function_test {| + extract_function_test + {| let f x = let exception Local in $raise Local$ @@ -82,11 +89,13 @@ let f x = ;; let%expect_test "extract function with shadowed parameter" = - extract_function_test {| + extract_function_test + {| let x = 0 let f x = $x + 1$ |}; - [%expect {| + [%expect + {| let x = 0 let fun_name x = x + 1 @@ -94,7 +103,8 @@ let f x = $x + 1$ ;; let%expect_test "extract function with bound variable" = - extract_function_test {| + extract_function_test + {| let x = 0 let y = 1 let f x = $x + y$ @@ -109,7 +119,8 @@ let f x = $x + y$ ;; let%expect_test "extract higher order function" = - extract_function_test {| + extract_function_test + {| let f x = $List.map (fun y -> y + 1) x$ |}; @@ -122,7 +133,8 @@ let f x = ;; let%expect_test "extract higher order function" = - extract_function_test {| + extract_function_test + {| let f y = $List.map (fun y -> y + 1) y$ |}; @@ -135,7 +147,8 @@ let f y = ;; let%expect_test "extract higher order function" = - extract_function_test {| + extract_function_test + {| let f y = $List.map (fun y -> y + 1) y$ |}; @@ -148,7 +161,8 @@ let f y = ;; let%expect_test "extract inside let binding" = - extract_function_test {| + extract_function_test + {| let f y = let y = y + 1 in $y + 2$ @@ -163,11 +177,13 @@ let f y = ;; let%expect_test "extract free variable" = - extract_function_test {| + extract_function_test + {| let f () = $z + 1$ |}; - [%expect {| + [%expect + {| let fun_name () = z + 1 let f () = diff --git a/ocaml-lsp-server/test/e2e-new/action_inline.ml b/ocaml-lsp-server/test/e2e-new/action_inline.ml index 228312bc9..d940d0548 100644 --- a/ocaml-lsp-server/test/e2e-new/action_inline.ml +++ b/ocaml-lsp-server/test/e2e-new/action_inline.ml @@ -1,19 +1,22 @@ let inline_test = Code_actions.code_action_test ~title:"Inline into uses" let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = 0 in x + 1 |}; - [%expect {| + [%expect + {| let _ = let x = 0 in (0) + 1 |}] ;; let%expect_test "shadow-1" = - inline_test {| + inline_test + {| let _ = let y = 1 in let $x = y in @@ -24,7 +27,8 @@ let _ = ;; let%expect_test "shadow-2" = - inline_test {| + inline_test + {| let _ = let y = 1 in let $x y = y in @@ -41,7 +45,8 @@ let _ = ;; let%expect_test "shadow-3" = - inline_test {| + inline_test + {| let _ = let y = 1 in let $x z = y + z in @@ -94,43 +99,50 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = 0 + 1 in (fun x -> x) x |}; - [%expect {| + [%expect + {| let _ = let x = 0 + 1 in (fun x -> x) (0 + 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = 0 + 1 in (fun ~x -> x) ~x |}; - [%expect {| + [%expect + {| let _ = let x = 0 + 1 in (fun ~x -> x) ~x:(0 + 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = 0 + 1 in (fun ?(x = 2) -> x) ~x |}; - [%expect {| + [%expect + {| let _ = let x = 0 + 1 in (fun ?(x = 2) -> x) ~x:(0 + 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = Some 0 in (fun ?(x = 2) -> x) ?x @@ -139,115 +151,134 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = 0 in (fun ~x -> x) ~x:(x + 1) |}; - [%expect {| + [%expect + {| let _ = let x = 0 in (fun ~x -> x) ~x:((0) + 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $x = 0 in (fun ?(x = 1) -> x) ~x:(x + 1) |}; - [%expect {| + [%expect + {| let _ = let x = 0 in (fun ?(x = 1) -> x) ~x:((0) + 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = x in f 1 |}; - [%expect {| + [%expect + {| let _ = let f x = x in (1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f _ = 0 in f 1 |}; - [%expect {| + [%expect + {| let _ = let f _ = 0 in (0) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = x + x in f 1 |}; - [%expect {| + [%expect + {| let _ = let f x = x + x in (1 + 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = x + x in f (g 1) |}; - [%expect {| + [%expect + {| let _ = let f x = x + x in (let x = g 1 in x + x) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x y = x + y in f 0 |}; - [%expect {| + [%expect + {| let _ = let f x y = x + y in ((fun x y -> x + y) 0) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x ~y = x + y in f ~y:0 |}; - [%expect {| + [%expect + {| let _ = let f x ~y = x + y in ((fun x ~y -> x + y) ~y:0) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f ~x y = x + y in f ~x:0 |}; - [%expect {| + [%expect + {| let _ = let f ~x y = x + y in ((fun ~x y -> x + y) ~x:0) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f ~x ~y = x + y in f ~y:0 @@ -260,12 +291,14 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f (x : int) = x + 1 in f 0 |}; - [%expect {| + [%expect + {| let _ = let f (x : int) = x + 1 in (0 + 1) |}] @@ -273,7 +306,8 @@ let _ = (* TODO: allow beta reduction with locally abstract types *) let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f (type a) (x : a) = x in f 0 @@ -287,7 +321,8 @@ let _ = (* FIXME this test broke with the update to OCaml 5.2 *) let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f : int -> int = fun x -> x in f 0 @@ -296,7 +331,8 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f = function Some x -> x | None -> 0 in f (Some 1) @@ -310,7 +346,8 @@ let _ = (* TODO: allow beta reduction with `as` *) let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f (x as y) = y + 1 in f 1 @@ -323,31 +360,36 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f 1 = 2 in f 2 |}; - [%expect {| + [%expect + {| let _ = let f 1 = 2 in (let 1 = 2 in 2) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f (x, y) = x + y in f (1, 2) |}; - [%expect {| + [%expect + {| let _ = let f (x, y) = x + y in (1 + 2) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f (x, y) = x + y + y in f (1, 2 + 3) @@ -360,7 +402,8 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f (x, y) = x + y + y in let z = (1, 2) in @@ -409,66 +452,77 @@ let _ = ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = [%test] x in f 1 |}; - [%expect {| + [%expect + {| let _ = let f x = [%test] x in (([%test ]) 1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = x in [%test] (f 1) |}; - [%expect {| + [%expect + {| let _ = let f x = x in [%test] (1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = (* test comment *) x in f 1 |}; - [%expect {| + [%expect + {| let _ = let f x = (* test comment *) x in (1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f x = x in (* test comment *) f 1 |}; - [%expect {| + [%expect + {| let _ = let f x = x in (* test comment *) (1) |}] ;; let%expect_test "" = - inline_test {| + inline_test + {| let $f x = x let g y = f y |}; - [%expect {| + [%expect + {| let f x = x let g y = (y) |}] ;; (* TODO *) let%expect_test "" = - inline_test {| + inline_test + {| module M = struct let $f x = x let g y = f y @@ -485,12 +539,14 @@ let h = M.f ;; let%expect_test "" = - inline_test {| + inline_test + {| let _ = let $f _ = 0 in f (print_endline "hi") |}; - [%expect {| + [%expect + {| let _ = let f _ = 0 in (let _ = print_endline "hi" in 0) |}] diff --git a/ocaml-lsp-server/test/e2e-new/action_mark_remove.ml b/ocaml-lsp-server/test/e2e-new/action_mark_remove.ml index 204a5c698..a76d71b5c 100644 --- a/ocaml-lsp-server/test/e2e-new/action_mark_remove.ml +++ b/ocaml-lsp-server/test/e2e-new/action_mark_remove.ml @@ -31,12 +31,15 @@ let remove_test = function ;; let%expect_test "mark value in let" = - mark_test `Value {| + mark_test + `Value + {| let f = let $x$ = 1 in 0 |}; - [%expect {| + [%expect + {| let f = let _x = 1 in 0 |}] @@ -44,41 +47,52 @@ let f = (* todo *) let%expect_test "mark value in top level let" = - mark_test `Value {| + mark_test + `Value + {| let $f$ = let x = 1 in 0 |}; - [%expect {| + [%expect + {| let _f = let x = 1 in 0 |}] ;; let%expect_test "mark value in match" = - mark_test `Value {| + mark_test + `Value + {| let f = function | $x$ -> 0 |}; - [%expect {| + [%expect + {| let f = function | _x -> 0 |}] ;; let%expect_test "remove value in let" = - remove_test `Value {| + remove_test + `Value + {| let f = let $x$ = 1 in 0 |}; - [%expect {| + [%expect + {| let f = 0 |}] ;; (* todo *) let%expect_test "remove value in top level let" = - remove_test `Value {| + remove_test + `Value + {| let $f$ = let x = 1 in 0 @@ -86,20 +100,25 @@ let $f$ = ;; let%expect_test "mark open" = - mark_test `Open {| + mark_test + `Open + {| $open M$ |}; [%expect {| open! M |}] ;; let%expect_test "mark for loop index" = - mark_test `For_loop_index {| + mark_test + `For_loop_index + {| let () = for $i$ = 0 to 10 do () done |}; - [%expect {| + [%expect + {| let () = for _i = 0 to 10 do () @@ -107,20 +126,28 @@ let () = ;; let%expect_test "remove open" = - remove_test `Open {| + remove_test + `Open + {| open A $open B$ |}; [%expect {| open A |}] ;; -let%expect_test "remove open!" = remove_test `Open_bang {| +let%expect_test "remove open!" = + remove_test + `Open_bang + {| open A $open! B$ |} +;; let%expect_test "remove type" = - remove_test `Type {| + remove_test + `Type + {| $type t = int$ type s = bool |}; @@ -128,7 +155,9 @@ type s = bool ;; let%expect_test "remove module" = - remove_test `Module {| + remove_test + `Module + {| $module A = struct end$ module B = struct end |}; @@ -136,60 +165,76 @@ module B = struct end ;; let%expect_test "remove case" = - remove_test `Case {| + remove_test + `Case + {| let f = function | 0 -> 0 | $0 -> 1$ |}; - [%expect {| + [%expect + {| let f = function | 0 -> 0 |}] ;; let%expect_test "remove rec flag" = - remove_test `Rec {| + remove_test + `Rec + {| let rec $f$ = 0 |}; [%expect {| let f = 0 |}] ;; let%expect_test "remove constructor" = - remove_test `Constructor {| + remove_test + `Constructor + {| type t = A $| B$ |}; [%expect {| type t = A |}] ;; let%expect_test "remove constructor" = - remove_test `Constructor {| + remove_test + `Constructor + {| type t = | A $| B$ |}; - [%expect {| + [%expect + {| type t = | A |}] ;; let%expect_test "remove constructor" = - remove_test `Constructor {| + remove_test + `Constructor + {| type t = $| A$ | B |}; - [%expect {| + [%expect + {| type t = | B |}] ;; let%expect_test "remove constructor" = - remove_test `Constructor {| + remove_test + `Constructor + {| type t = $A$ | B |}; - [%expect {| + [%expect + {| type t = | B |}] diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 10c99da3b..bf9d571c6 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -11,11 +11,11 @@ let iter_code_actions ?prep ?path ?(diagnostics = []) ~source range = ;; let print_code_actions - ?(prep = fun _ -> Fiber.return ()) - ?(path = "foo.ml") - ?(filter = fun _ -> true) - source - range + ?(prep = fun _ -> Fiber.return ()) + ?(path = "foo.ml") + ?(filter = fun _ -> true) + source + range = iter_code_actions ~prep ~path ~source range (function | None -> print_endline "No code actions" @@ -45,9 +45,11 @@ let find_annotate_action = find_action "type-annotate" let find_remove_annotation_action = find_action "remove type annotation" let%expect_test "code actions" = - let source = {ocaml| + let source = + {ocaml| let foo = 123 -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:5 in let end_ = Position.create ~line:1 ~character:7 in @@ -93,10 +95,12 @@ let foo = 123 ;; let%expect_test "can type-annotate a function argument" = - let source = {ocaml| + let source = + {ocaml| type t = Foo of int | Bar of bool let f x = Foo x -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:2 ~character:6 in let end_ = Position.create ~line:2 ~character:7 in @@ -130,9 +134,11 @@ let f x = Foo x ;; let%expect_test "can type-annotate a toplevel value" = - let source = {ocaml| + let source = + {ocaml| let iiii = 3 + 4 -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:4 in let end_ = Position.create ~line:1 ~character:5 in @@ -179,9 +185,11 @@ let iiii = 3 + 4 ;; let%expect_test "does not type-annotate function" = - let source = {ocaml| + let source = + {ocaml| let my_fun x y = 1 -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:5 in let end_ = Position.create ~line:1 ~character:6 in @@ -233,11 +241,13 @@ let () = ;; let%expect_test "can type-annotate a variant with its name only" = - let source = {ocaml| + let source = + {ocaml| type t = Foo of int | Bar of bool let f (x : t) = x -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:3 ~character:16 in let end_ = Position.create ~line:3 ~character:17 in @@ -271,11 +281,13 @@ let f (x : t) = x ;; let%expect_test "does not type-annotate in a non expression context" = - let source = {ocaml| + let source = + {ocaml| type x = | Foo of int | Baz of string -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:3 ~character:5 in let end_ = Position.create ~line:3 ~character:6 in @@ -286,9 +298,11 @@ type x = ;; let%expect_test "does not type-annotate already annotated argument" = - let source = {ocaml| + let source = + {ocaml| let f (x : int) = 1 -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:7 in let end_ = Position.create ~line:1 ~character:8 in @@ -299,9 +313,11 @@ let f (x : int) = 1 ;; let%expect_test "does not type-annotate already annotated expression" = - let source = {ocaml| + let source = + {ocaml| let f x = (1 : int) -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:11 in let end_ = Position.create ~line:1 ~character:12 in @@ -312,9 +328,11 @@ let f x = (1 : int) ;; let%expect_test "does not type-annotate already annotated and coerced expression" = - let source = {ocaml| + let source = + {ocaml| let f x = (1 : int :> int) -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:11 in let end_ = Position.create ~line:1 ~character:12 in @@ -325,10 +343,12 @@ let f x = (1 : int :> int) ;; let%expect_test "can remove type annotation from a function argument" = - let source = {ocaml| + let source = + {ocaml| type t = Foo of int | Bar of bool let f (x : t) = Foo x -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:2 ~character:7 in let end_ = Position.create ~line:2 ~character:8 in @@ -362,9 +382,11 @@ let f (x : t) = Foo x ;; let%expect_test "can remove type annotation from a toplevel value" = - let source = {ocaml| + let source = + {ocaml| let (iiii : int) = 3 + 4 -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:5 in let end_ = Position.create ~line:1 ~character:6 in @@ -439,9 +461,11 @@ let f (x : int) = x + 1 ;; let%expect_test "can remove type annotation from a coerced expression" = - let source = {ocaml| + let source = + {ocaml| let x = (7 : int :> int) -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:9 in let end_ = Position.create ~line:1 ~character:10 in @@ -475,9 +499,11 @@ let x = (7 : int :> int) ;; let%expect_test "does not remove type annotation from function" = - let source = {ocaml| + let source = + {ocaml| let my_fun x y : int = 1 -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:5 in let end_ = Position.create ~line:1 ~character:6 in @@ -488,10 +514,12 @@ let my_fun x y : int = 1 ;; let%expect_test "can destruct sum types" = - let source = {ocaml| + let source = + {ocaml| type t = Foo of int | Bar of bool let f (x : t) = x -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:2 ~character:16 in let end_ = Position.create ~line:2 ~character:17 in @@ -526,10 +554,12 @@ let f (x : t) = x ;; let%expect_test "can destruct match line" = - let source = {ocaml| + let source = + {ocaml| let f (x:bool) = match x -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:2 ~character:5 in let end_ = Position.create ~line:2 ~character:5 in @@ -567,9 +597,11 @@ let f (x:bool) = ;; let%expect_test "can destruct match-with line" = - let source = {ocaml| + let source = + {ocaml| match (Ok 0) with -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:0 in let end_ = Position.create ~line:1 ~character:0 in @@ -896,10 +928,12 @@ let f (x: q) = ;; let%expect_test "can infer module interfaces" = - let impl_source = {ocaml| + let impl_source = + {ocaml| type t = Foo of int | Bar of bool let f (x : t) = x -|ocaml} in +|ocaml} + in let uri = DocumentUri.of_path "foo.ml" in let prep client = Test.openDocument ~client ~uri ~source:impl_source in let intf_source = "" in @@ -941,15 +975,19 @@ let f (x : t) = x ;; let%expect_test "inferred interface excludes existing names" = - let impl_source = {ocaml| + let impl_source = + {ocaml| type t = Foo of int | Bar of bool let f (x : t) = x -|ocaml} in +|ocaml} + in let uri = DocumentUri.of_path "foo.ml" in let prep client = Test.openDocument ~client ~uri ~source:impl_source in - let intf_source = {ocaml| + let intf_source = + {ocaml| val f : t -> t -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:0 ~character:0 in let end_ = Position.create ~line:0 ~character:0 in @@ -1000,10 +1038,12 @@ let f (x : t) (d : bool) = in let uri = DocumentUri.of_path "foo.ml" in let prep client = Test.openDocument ~client ~uri ~source:impl_source in - let intf_source = {ocaml| + let intf_source = + {ocaml| type t = Foo of int | Bar of bool val f : t -> bool -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:2 ~character:0 in let end_ = Position.create ~line:2 ~character:0 in @@ -1051,9 +1091,11 @@ let f i s b = in let uri = DocumentUri.of_path "foo.ml" in let prep client = Test.openDocument ~client ~uri ~source:impl_source in - let intf_source = {ocaml| + let intf_source = + {ocaml| val f : int -> string -> 'a list -> bool -> bool -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:10 in let end_ = Position.create ~line:1 ~character:10 in @@ -1101,9 +1143,11 @@ let f i s l b = in let uri = DocumentUri.of_path "foo.ml" in let prep client = Test.openDocument ~client ~uri ~source:impl_source in - let intf_source = {ocaml| + let intf_source = + {ocaml| val f : int -> string -> 'a list -> bool -> bool -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:1 in let end_ = Position.create ~line:1 ~character:12 in @@ -1231,9 +1275,11 @@ end in let uri = DocumentUri.of_path "foo.ml" in let prep client = Test.openDocument ~client ~uri ~source:impl_source in - let intf_source = {ocaml| + let intf_source = + {ocaml| module M : sig type t = I of int | B of bool end -|ocaml} in +|ocaml} + in let range = let start = Position.create ~line:1 ~character:0 in let end_ = Position.create ~line:1 ~character:0 in @@ -1594,7 +1640,8 @@ let%expect_test "shouldn't find the jump target on the same line" = source range ~filter:(find_action "merlin-jump-fun"); - [%expect {| + [%expect + {| No code actions |}] ;; diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index a6d7b52d5..5f2f874b3 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -1,11 +1,11 @@ open Test.Import let iter_completions - ?prep - ?path - ?(triggerCharacter = "") - ?(triggerKind = CompletionTriggerKind.Invoked) - ~position + ?prep + ?path + ?(triggerCharacter = "") + ?(triggerKind = CompletionTriggerKind.Invoked) + ~position = let makeRequest textDocument = let context = CompletionContext.create ~triggerCharacter ~triggerKind () in @@ -16,12 +16,12 @@ let iter_completions ;; let print_completions - ?(prep = fun _ -> Fiber.return ()) - ?(path = "foo.ml") - ?(limit = 10) - ?(pre_print = fun x -> x) - source - position + ?(prep = fun _ -> Fiber.return ()) + ?(path = "foo.ml") + ?(limit = 10) + ?(pre_print = fun x -> x) + source + position = iter_completions ~prep ~path ~source ~position (function | None -> print_endline "No completion Items" @@ -287,8 +287,10 @@ let%expect_test "can start completion in dot chain with tab" = ;; let%expect_test "can start completion in dot chain with newline" = - let source = {ocaml|[1;2] |> List. -ma|ocaml} in + let source = + {ocaml|[1;2] |> List. +ma|ocaml} + in let position = Position.create ~line:1 ~character:2 in print_completions source position; [%expect @@ -386,8 +388,10 @@ let%expect_test "can start completion in dot chain with space" = ;; let%expect_test "can start completion after dereference" = - let source = {ocaml|let apple=ref 10 in -!ap|ocaml} in + let source = + {ocaml|let apple=ref 10 in +!ap|ocaml} + in let position = Position.create ~line:1 ~character:3 in print_completions source position; [%expect @@ -410,8 +414,10 @@ let%expect_test "can start completion after dereference" = ;; let%expect_test "can complete symbol passed as a named argument" = - let source = {ocaml|let g ~f = f 0 in -g ~f:ig|ocaml} in + let source = + {ocaml|let g ~f = f 0 in +g ~f:ig|ocaml} + in let position = Position.create ~line:1 ~character:7 in print_completions source position; [%expect @@ -461,10 +467,12 @@ g ~f:M.ig|ocaml} ;; let%expect_test "can complete symbol passed as an optional argument" = - let source = {ocaml| + let source = + {ocaml| let g ?f = f in g ?f:ig - |ocaml} in + |ocaml} + in let position = Position.create ~line:2 ~character:7 in print_completions source position; [%expect @@ -559,10 +567,12 @@ let x = Test. ;; let%expect_test "completes infix operators" = - let source = {ocaml| + let source = + {ocaml| let (>>|) = (+) let y = 1 > -|ocaml} in +|ocaml} + in let position = Position.create ~line:2 ~character:11 in print_completions source position; [%expect @@ -788,11 +798,13 @@ let u = f `In ;; let%expect_test "works for polymorphic variants" = - let source = {ocaml| + let source = + {ocaml| type t = [ `Int | `String ] let x : t = `I - |ocaml} in + |ocaml} + in let position = Position.create ~line:3 ~character:15 in print_completions source position; [%expect @@ -1096,9 +1108,11 @@ let%expect_test "completion doesn't autocomplete record fields" = ;; let%expect_test "completion for `in` keyword - no prefix" = - let source = {ocaml| + let source = + {ocaml| let foo param1 = - let bar = param1 |ocaml} in + let bar = param1 |ocaml} + in let position = Position.create ~line:2 ~character:19 in print_completions ~limit:3 source position; [%expect @@ -1145,10 +1159,12 @@ let foo param1 = ;; let%expect_test "completion for `in` keyword - prefix i" = - let source = {ocaml| + let source = + {ocaml| let foo param1 = let bar = param1 i -|ocaml} in +|ocaml} + in let position = Position.create ~line:2 ~character:20 in print_completions ~limit:3 source position; [%expect @@ -1195,10 +1211,12 @@ let foo param1 = ;; let%expect_test "completion for `in` keyword - prefix in" = - let source = {ocaml| + let source = + {ocaml| let foo param1 = let bar = param1 in -|ocaml} in +|ocaml} + in let position = Position.create ~line:2 ~character:21 in print_completions ~limit:3 source position; [%expect diff --git a/ocaml-lsp-server/test/e2e-new/completions.ml b/ocaml-lsp-server/test/e2e-new/completions.ml index c055567f1..7076bad69 100644 --- a/ocaml-lsp-server/test/e2e-new/completions.ml +++ b/ocaml-lsp-server/test/e2e-new/completions.ml @@ -1,8 +1,8 @@ open Test.Import let print_completion - (completions : - [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] option) + (completions : + [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] option) = let print_items (items : CompletionItem.t list) = List.map items ~f:(fun item -> diff --git a/ocaml-lsp-server/test/e2e-new/doc_to_md.ml b/ocaml-lsp-server/test/e2e-new/doc_to_md.ml index a3e64affd..6c4f44fb0 100644 --- a/ocaml-lsp-server/test/e2e-new/doc_to_md.ml +++ b/ocaml-lsp-server/test/e2e-new/doc_to_md.ml @@ -22,19 +22,23 @@ let%expect_test "table" = {| {table {tr {td some content} {td some other content}} {tr {td in another} {td row}}} |} in translate doc |> print_doc; - [%expect {| + [%expect + {| | some content | some other content | | in another | row | |}] ;; let%expect_test "table2" = - let doc = {| + let doc = + {| {t | z | f | |:-----|---:| | fse | e | } - |} in + |} + in translate doc |> print_doc; - [%expect {| + [%expect + {| | z | f | |:-|-:| | fse | e | |}] @@ -43,14 +47,16 @@ let%expect_test "table2" = let%expect_test "problematic_translation" = let doc = {| {table {tr {td {ul {li first item} {li second item}}}} } |} in translate doc |> print_doc; - [%expect {| + [%expect + {| | - first item - second item | |}] ;; let%expect_test "code_with_output" = let doc = {| {@ocaml[foo][output {b foo}]} |} in translate doc |> print_doc; - [%expect {| + [%expect + {| ```ocaml foo ``` diff --git a/ocaml-lsp-server/test/e2e-new/document_flow.ml b/ocaml-lsp-server/test/e2e-new/document_flow.ml index bde75c2b3..28080b810 100644 --- a/ocaml-lsp-server/test/e2e-new/document_flow.ml +++ b/ocaml-lsp-server/test/e2e-new/document_flow.ml @@ -5,9 +5,9 @@ let%expect_test "it should allow double opening the same document" = let drain_diagnostics () = Fiber.Mvar.read diagnostics in let handler = let on_request - (type resp state) - (client : state Client.t) - (req : resp Lsp.Server_request.t) + (type resp state) + (client : state Client.t) + (req : resp Lsp.Server_request.t) : (resp Lsp_fiber.Rpc.Reply.t * state) Fiber.t = match req with @@ -17,10 +17,9 @@ let%expect_test "it should allow double opening the same document" = | _ -> assert false in Client.Handler.make - ~on_notification:(fun _ -> - function - | PublishDiagnostics _ -> Fiber.Mvar.write diagnostics () - | _ -> Fiber.return ()) + ~on_notification:(fun _ -> function + | PublishDiagnostics _ -> Fiber.Mvar.write diagnostics () + | _ -> Fiber.return ()) ~on_request:{ Client.Handler.on_request } () in diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index c8b81d53a..663a01bb8 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -131,7 +131,8 @@ let%expect_test "Documentation when List module is shadowed" = let character = 12 in let identifier = "Base.List.iter" in Util.test ~line ~character ~identifier source; - [%expect {| + [%expect + {| { "doc": { "kind": "plaintext", "value": "Base.List.iter" } } |}] ;; diff --git a/ocaml-lsp-server/test/e2e-new/exit_notification.ml b/ocaml-lsp-server/test/e2e-new/exit_notification.ml index f7ead949a..f2a9ac3d9 100644 --- a/ocaml-lsp-server/test/e2e-new/exit_notification.ml +++ b/ocaml-lsp-server/test/e2e-new/exit_notification.ml @@ -25,8 +25,8 @@ let test run = Fiber.fork_and_join_unit run_client (run client)) ;; -let%expect_test "ocamllsp process exits with code 0 after Shutdown and Exit \ - notifications are sent" +let%expect_test + "ocamllsp process exits with code 0 after Shutdown and Exit notifications are sent" = let run client () = let* (_ : InitializeResult.t) = Client.initialized client in @@ -34,7 +34,8 @@ let%expect_test "ocamllsp process exits with code 0 after Shutdown and Exit \ Client.notification client Exit in test run; - [%expect {| + [%expect + {| ocamllsp finished with code = 0 |}] ;; @@ -44,18 +45,20 @@ let%expect_test "ocamllsp does not exit if only Shutdown notification is sent" = Client.request client Shutdown in test run; - [%expect {| + [%expect + {| ocamllsp killed with signal = -7 |}] ;; -let%expect_test "ocamllsp process exits with code 0 after Exit notification is sent \ - (should be 1)" +let%expect_test + "ocamllsp process exits with code 0 after Exit notification is sent (should be 1)" = let run client () = let* (_ : InitializeResult.t) = Client.initialized client in Client.notification client Exit in test run; - [%expect {| + [%expect + {| ocamllsp finished with code = 0 |}] ;; diff --git a/ocaml-lsp-server/test/e2e-new/hover_extended.ml b/ocaml-lsp-server/test/e2e-new/hover_extended.ml index efc05a53b..a94219f24 100644 --- a/ocaml-lsp-server/test/e2e-new/hover_extended.ml +++ b/ocaml-lsp-server/test/e2e-new/hover_extended.ml @@ -41,11 +41,13 @@ let hover_extended client position verbosity = ;; let%expect_test "hover reference" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover client position in @@ -101,11 +103,13 @@ let f a b c d e f g h i = 1 + a + b + c + d + e + f + g + h + i ;; let%expect_test "hover extended" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover client position in @@ -134,11 +138,13 @@ let foo_value : foo = Some 1 ;; let%expect_test "default verbosity" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover_extended client position None in @@ -158,11 +164,13 @@ let foo_value : foo = Some 1 ;; let%expect_test "explicit verbosity 0" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover_extended client position (Some 0) in @@ -182,11 +190,13 @@ let foo_value : foo = Some 1 ;; let%expect_test "explicit verbosity 1" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover_extended client position (Some 1) in @@ -206,11 +216,13 @@ let foo_value : foo = Some 1 ;; let%expect_test "explicit verbosity 2" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover_extended client position (Some 2) in @@ -230,11 +242,13 @@ let foo_value : foo = Some 1 ;; let%expect_test "implicity verbosity increases" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = hover_extended client position None in diff --git a/ocaml-lsp-server/test/e2e-new/inlay_hints.ml b/ocaml-lsp-server/test/e2e-new/inlay_hints.ml index 51ce0a658..efaea9efb 100644 --- a/ocaml-lsp-server/test/e2e-new/inlay_hints.ml +++ b/ocaml-lsp-server/test/e2e-new/inlay_hints.ml @@ -1,12 +1,12 @@ open Test.Import let apply_inlay_hints - ?(path = "foo.ml") - ?range - ?(hint_pattern_variables = false) - ?(hint_let_bindings = false) - ~source - () + ?(path = "foo.ml") + ?range + ?(hint_pattern_variables = false) + ?(hint_let_bindings = false) + ~source + () = let range = match range with @@ -29,12 +29,12 @@ let apply_inlay_hints ~prep:(fun client -> Test.openDocument ~client ~uri ~source) ~settings: (`Assoc - [ ( "inlayHints" - , `Assoc - [ "hintPatternVariables", `Bool hint_pattern_variables - ; "hintLetBindings", `Bool hint_let_bindings - ] ) - ]) + [ ( "inlayHints" + , `Assoc + [ "hintPatternVariables", `Bool hint_pattern_variables + ; "hintLetBindings", `Bool hint_let_bindings + ] ) + ]) (InlayHint request) in match inlay_hints with diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml index 06b930e97..31c2e6fd2 100644 --- a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml @@ -12,23 +12,22 @@ let open_document ~client ~uri ~source = ;; let iter_lsp_response - ?(prep = fun _ -> Fiber.return ()) - ?(path = "foo.ml") - ~makeRequest - ~source - k + ?(prep = fun _ -> Fiber.return ()) + ?(path = "foo.ml") + ~makeRequest + ~source + k = let got_diagnostics = Fiber.Ivar.create () in let handler = Client.Handler.make - ~on_notification:(fun _ -> - function - | PublishDiagnostics _ -> - let* diag = Fiber.Ivar.peek got_diagnostics in - (match diag with - | Some _ -> Fiber.return () - | None -> Fiber.Ivar.fill got_diagnostics ()) - | _ -> Fiber.return ()) + ~on_notification:(fun _ -> function + | PublishDiagnostics _ -> + let* diag = Fiber.Ivar.peek got_diagnostics in + (match diag with + | Some _ -> Fiber.return () + | None -> Fiber.Ivar.fill got_diagnostics ()) + | _ -> Fiber.return ()) () in Test.run ~handler diff --git a/ocaml-lsp-server/test/e2e-new/merlin_call_compatible.ml b/ocaml-lsp-server/test/e2e-new/merlin_call_compatible.ml index 80e77d2cc..1059abd1d 100644 --- a/ocaml-lsp-server/test/e2e-new/merlin_call_compatible.ml +++ b/ocaml-lsp-server/test/e2e-new/merlin_call_compatible.ml @@ -17,8 +17,10 @@ let call_merlin_compatible client command args result_as_sexp = ;; let%expect_test "case-analysis on simple example" = - let source = {|type t = {a: int * int; b: string} -let f ({a; b} : t) = assert false|} in + let source = + {|type t = {a: int * int; b: string} +let f ({a; b} : t) = assert false|} + in let request client = let open Fiber.O in let args = [ "-start"; "2:9"; "-end"; "2:9" ] in @@ -53,8 +55,10 @@ let%expect_test "case-analysis on empty example" = ;; let%expect_test "case-analysis on simple example with result as sexp" = - let source = {|type t = {a: int * int; b: string} -let f ({a; b} : t) = assert false|} in + let source = + {|type t = {a: int * int; b: string} +let f ({a; b} : t) = assert false|} + in let request client = let open Fiber.O in let args = [ "-start"; "2:9"; "-end"; "2:9" ] in diff --git a/ocaml-lsp-server/test/e2e-new/merlin_jump.ml b/ocaml-lsp-server/test/e2e-new/merlin_jump.ml index 4b2aaa06c..809dae049 100644 --- a/ocaml-lsp-server/test/e2e-new/merlin_jump.ml +++ b/ocaml-lsp-server/test/e2e-new/merlin_jump.ml @@ -127,9 +127,11 @@ let%expect_test "Same line should output no locations" = ;; let%expect_test "Ask for a non-existing target" = - let source = {| + let source = + {| let find_vowel x = () -|} in +|} + in let line = 1 in let character = 2 in Util.test ~line ~character ~source ~target:"notatarget" (); diff --git a/ocaml-lsp-server/test/e2e-new/semantic_hl_helpers.ml b/ocaml-lsp-server/test/e2e-new/semantic_hl_helpers.ml index 1ccf0d0f1..c5acb0f92 100644 --- a/ocaml-lsp-server/test/e2e-new/semantic_hl_helpers.ml +++ b/ocaml-lsp-server/test/e2e-new/semantic_hl_helpers.ml @@ -34,10 +34,10 @@ let modifiers ~(legend : string array) (encoded_mods : int) = ;; let annotate_src_with_tokens - ~(legend : SemanticTokensLegend.t) - ~(encoded_tokens : int array) - ~(annot_mods : bool) - (src : string) + ~(legend : SemanticTokensLegend.t) + ~(encoded_tokens : int array) + ~(annot_mods : bool) + (src : string) : string = let token_types = legend.SemanticTokensLegend.tokenTypes |> Array.of_list in diff --git a/ocaml-lsp-server/test/e2e-new/semantic_hl_tests.ml b/ocaml-lsp-server/test/e2e-new/semantic_hl_tests.ml index 8fb2cb777..49c7b60b9 100644 --- a/ocaml-lsp-server/test/e2e-new/semantic_hl_tests.ml +++ b/ocaml-lsp-server/test/e2e-new/semantic_hl_tests.ml @@ -86,16 +86,15 @@ let test let wait_for_diagnostics = Fiber.Ivar.create () in let handler = Client.Handler.make - ~on_notification:(fun client -> - function - | Lsp.Server_notification.PublishDiagnostics _ -> - (* we don't want to close the connection from client-side before we + ~on_notification:(fun client -> function + | Lsp.Server_notification.PublishDiagnostics _ -> + (* we don't want to close the connection from client-side before we process diagnostics arrived on the channel. TODO: would a better solution be to simply flush on closing the connection because now semantic tokens tests is coupled to diagnostics *) - let+ () = Fiber.Ivar.fill wait_for_diagnostics () in - Client.state client - | _ -> Fiber.return ()) + let+ () = Fiber.Ivar.fill wait_for_diagnostics () in + Client.state client + | _ -> Fiber.return ()) () in Test.run ~handler (fun client -> @@ -216,13 +215,13 @@ let test_semantic_tokens_full_debug src = test ~src (fun p -> - UnknownRequest - { meth = semantic_tokens_full_debug - ; params = - Some (SemanticTokensParams.yojson_of_t p |> Jsonrpc.Structured.t_of_yojson) - }) + UnknownRequest + { meth = semantic_tokens_full_debug + ; params = + Some (SemanticTokensParams.yojson_of_t p |> Jsonrpc.Structured.t_of_yojson) + }) (fun { resp; _ } -> - resp |> Yojson.Safe.pretty_to_string ~std:false |> print_endline |> Fiber.return) + resp |> Yojson.Safe.pretty_to_string ~std:false |> print_endline |> Fiber.return) ;; let%expect_test "tokens for ocaml_lsp_server.ml" = @@ -672,7 +671,9 @@ let%expect_test "tokens for ocaml_lsp_server.ml" = ;; let%expect_test "highlighting longidents with space between identifiers" = - test_semantic_tokens_full @@ String.trim {| + test_semantic_tokens_full + @@ String.trim + {| let foo = Bar.jar let joo = Bar. jar @@ -686,7 +687,8 @@ let joo = Bar. jar let%expect_test "highlighting longidents with space between identifiers and infix fns" = test_semantic_tokens_full - @@ String.trim {| + @@ String.trim + {| Bar.(+) ;; Bar.( + ) ;; @@ -723,7 +725,8 @@ let x = { M . foo = 0 ; bar = "bar"} let%expect_test "operators" = test_semantic_tokens_full - @@ String.trim {| + @@ String.trim + {| let x = 1.0 *. 2.0 let y = 1 * 2 let z = 0 >>= 1 diff --git a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml index dbb86a928..35bdcddc1 100644 --- a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml +++ b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml @@ -62,9 +62,11 @@ let run_test text req = ;; let%expect_test "syntax doc should display" = - let source = {ocaml| + let source = + {ocaml| type color = Red|Blue -|ocaml} in +|ocaml} + in let position = create_postion 1 9 in let req client = let* () = change_config ~client activate_syntax_doc in @@ -89,9 +91,11 @@ type color = Red|Blue ;; let%expect_test "syntax doc should not display" = - let source = {ocaml| + let source = + {ocaml| type color = Red|Blue -|ocaml} in +|ocaml} + in let position = create_postion 1 9 in let req client = let* () = change_config ~client deactivate_syntax_doc in @@ -112,9 +116,11 @@ type color = Red|Blue ;; let%expect_test "syntax doc should print" = - let source = {ocaml| + let source = + {ocaml| type t = .. -|ocaml} in +|ocaml} + in let position = create_postion 1 5 in let req client = let* () = change_config ~client activate_syntax_doc in @@ -138,9 +144,11 @@ type t = .. ;; let%expect_test "should receive no hover response" = - let source = {ocaml| + let source = + {ocaml| let a = 1 - |ocaml} in + |ocaml} + in let position = create_postion 1 5 in let req client = let* () = change_config ~client activate_syntax_doc in diff --git a/ocaml-lsp-server/test/e2e-new/test.ml b/ocaml-lsp-server/test/e2e-new/test.ml index 491c25e21..849657bd0 100644 --- a/ocaml-lsp-server/test/e2e-new/test.ml +++ b/ocaml-lsp-server/test/e2e-new/test.ml @@ -129,18 +129,18 @@ end = struct let cancelled = ref false in Fiber.fork_and_join_unit (fun () -> - Lev_fiber.Timer.Wheel.await timeout - >>| function - | `Cancelled -> () - | `Ok -> - Unix.kill pid Sys.sigkill; - cancelled := true) + Lev_fiber.Timer.Wheel.await timeout + >>| function + | `Cancelled -> () + | `Ok -> + Unix.kill pid Sys.sigkill; + cancelled := true) (fun () -> - let* (server_exit_status : Unix.process_status) = Lev_fiber.waitpid ~pid in - let+ () = - if !cancelled then Fiber.return () else Lev_fiber.Timer.Wheel.cancel timeout - in - server_exit_status) + let* (server_exit_status : Unix.process_status) = Lev_fiber.waitpid ~pid in + let+ () = + if !cancelled then Fiber.return () else Lev_fiber.Timer.Wheel.cancel timeout + in + server_exit_status) in Lev_fiber.run (fun () -> let* wheel = Lev_fiber.Timer.Wheel.create ~delay:3.0 in diff --git a/ocaml-lsp-server/test/e2e-new/type_enclosing.ml b/ocaml-lsp-server/test/e2e-new/type_enclosing.ml index e544b38db..246dc58e6 100644 --- a/ocaml-lsp-server/test/e2e-new/type_enclosing.ml +++ b/ocaml-lsp-server/test/e2e-new/type_enclosing.ml @@ -65,8 +65,9 @@ let%expect_test "Application of function without range end" = } |}] ;; -let%expect_test "Application of function with range end (including the current \ - enclosing) it should not change the result" +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 @@ -120,7 +121,8 @@ let%expect_test "Application of function with range end (excluding the current e } |}] ;; -let%expect_test {| +let%expect_test + {| The cursor is positioned on [x]. We expect to have the type [string] and no other enclosings @@ -148,7 +150,8 @@ let%expect_test {| } |}] ;; -let%expect_test {| +let%expect_test + {| The cursor is positioned on [string_of_int] and we do not give a range. |} = @@ -180,7 +183,8 @@ let%expect_test {| } |}] ;; -let%expect_test {| +let%expect_test + {| The cursor is positioned on [2002]. We expect to have the type [int] and to have two enclosings: @@ -213,7 +217,8 @@ let%expect_test {| } |}] ;; -let%expect_test {| +let%expect_test + {| The cursor is still positioned on [2002] but we ask for the index [1] (the second enclosing). @@ -248,7 +253,8 @@ let%expect_test {| } |}] ;; -let%expect_test {| +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: @@ -304,7 +310,8 @@ end|} } |}] ;; -let%expect_test {| +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. @@ -359,7 +366,8 @@ end|} } |}] ;; -let%expect_test {| +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. @@ -428,7 +436,8 @@ end|} } |}] ;; -let%expect_test {| +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. diff --git a/ocaml-lsp-server/test/e2e-new/type_search.ml b/ocaml-lsp-server/test/e2e-new/type_search.ml index ece053402..58758ccd7 100644 --- a/ocaml-lsp-server/test/e2e-new/type_search.ml +++ b/ocaml-lsp-server/test/e2e-new/type_search.ml @@ -28,8 +28,9 @@ module Util = struct ;; end -let%expect_test "Polarity Search for a simple query that takes an int and returns a \ - string with documentation" +let%expect_test + "Polarity Search for a simple query that takes an int and returns a string with \ + documentation" = let source = "" in let line = 1 in @@ -85,8 +86,9 @@ let%expect_test "Polarity Search for a simple query that takes an int and return |}] ;; -let%expect_test "Polarity Search for a simple query that takes an int and returns a \ - string with no documentation" +let%expect_test + "Polarity Search for a simple query that takes an int and returns a string with no \ + documentation" = let source = "" in let line = 1 in @@ -131,8 +133,9 @@ let%expect_test "Polarity Search for a simple query that takes an int and return ] |}] ;; -let%expect_test "Type Search for a simple query that takes an int and returns a string \ - with no documentation" +let%expect_test + "Type Search for a simple query that takes an int and returns a string with no \ + documentation" = let source = "" in let line = 1 in @@ -177,8 +180,9 @@ let%expect_test "Type Search for a simple query that takes an int and returns a ] |}] ;; -let%expect_test "Type Search for a simple query that takes an int and returns a string \ - with documentation" +let%expect_test + "Type Search for a simple query that takes an int and returns a string with \ + documentation" = let source = "" in let line = 1 in diff --git a/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml b/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml index 90e98d447..8e19f5d84 100644 --- a/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml +++ b/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml @@ -10,9 +10,11 @@ let codelens client textDocument = ;; let%expect_test "disable codelens" = - let source = {ocaml| + let source = + {ocaml| let string = "Hello" -|ocaml} in +|ocaml} + in let req client = let text_document = TextDocumentIdentifier.create ~uri:Helpers.uri in let* () = @@ -30,11 +32,13 @@ let string = "Hello" ;; let%expect_test "enable hover extended" = - let source = {ocaml| + let source = + {ocaml| type foo = int option let foo_value : foo = Some 1 -|ocaml} in +|ocaml} + in let position = Position.create ~line:3 ~character:4 in let req client = let* resp = Hover_extended.hover client position in