Skip to content

fix(lsp): preserve request result wire contracts #2025

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
rgrinberg wants to merge 1 commit into
base: master
Choose a base branch
from
Open

fix(lsp): preserve request result wire contracts #2025

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
118 changes: 93 additions & 25 deletions lsp/src/client_request.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,29 @@ open! Import
open Types
open Extension

type definition_result =
[ `Definition of Definition.t
| `DefinitionLink of DefinitionLink.t list
]

type declaration_result =
[ `Declaration of Declaration.t
| `DeclarationLink of DeclarationLink.t list
]

type workspace_symbol_result =
[ `SymbolInformation of SymbolInformation.t list
| `WorkspaceSymbol of WorkspaceSymbol.t list
]

type _ t =
| Shutdown : unit t
| Initialize : InitializeParams.t -> InitializeResult.t t
| TextDocumentHover : HoverParams.t -> Hover.t option t
| TextDocumentDefinition : DefinitionParams.t -> Locations.t option t
| TextDocumentDeclaration : DeclarationParams.t -> Locations.t option t
| TextDocumentTypeDefinition : TypeDefinitionParams.t -> Locations.t option t
| TextDocumentImplementation : ImplementationParams.t -> Locations.t option t
| TextDocumentDefinition : DefinitionParams.t -> definition_result option t
| TextDocumentDeclaration : DeclarationParams.t -> declaration_result option t
| TextDocumentTypeDefinition : TypeDefinitionParams.t -> definition_result option t
| TextDocumentImplementation : ImplementationParams.t -> definition_result option t
| TextDocumentCompletion :
CompletionParams.t
-> [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] option t
Expand Down Expand Up @@ -39,7 +54,7 @@ type _ t =
| TextDocumentRangesFormatting :
DocumentRangesFormattingParams.t
-> TextEdit.t list option t
| TextDocumentRename : RenameParams.t -> WorkspaceEdit.t t
| TextDocumentRename : RenameParams.t -> WorkspaceEdit.t option t
| TextDocumentLink : DocumentLinkParams.t -> DocumentLink.t list option t
| TextDocumentLinkResolve : DocumentLink.t -> DocumentLink.t t
| TextDocumentMoniker : MonikerParams.t -> Moniker.t list option t
Expand All @@ -50,7 +65,7 @@ type _ t =
]
option
t
| WorkspaceSymbol : WorkspaceSymbolParams.t -> SymbolInformation.t list option t
| WorkspaceSymbol : WorkspaceSymbolParams.t -> workspace_symbol_result option t
| WorkspaceSymbolResolve : WorkspaceSymbol.t -> WorkspaceSymbol.t t
| DebugEcho : DebugEcho.Params.t -> DebugEcho.Result.t t
| DebugTextDocumentGet :
Expand All @@ -59,7 +74,7 @@ type _ t =
| TextDocumentReferences : ReferenceParams.t -> Location.t list option t
| TextDocumentHighlight : DocumentHighlightParams.t -> DocumentHighlight.t list option t
| TextDocumentFoldingRange : FoldingRangeParams.t -> FoldingRange.t list option t
| SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t t
| SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t option t
| CodeAction : CodeActionParams.t -> CodeActionResult.t t
| CodeActionResolve : CodeAction.t -> CodeAction.t t
| CompletionItemResolve : CompletionItem.t -> CompletionItem.t t
Expand All @@ -74,7 +89,7 @@ type _ t =
ColorPresentationParams.t
-> ColorPresentation.t list t
| TextDocumentColor : DocumentColorParams.t -> ColorInformation.t list t
| SelectionRange : SelectionRangeParams.t -> SelectionRange.t list t
| SelectionRange : SelectionRangeParams.t -> SelectionRange.t list option t
| ExecuteCommand : ExecuteCommandParams.t -> Json.t t
| SemanticTokensFull : SemanticTokensParams.t -> SemanticTokens.t option t
| SemanticTokensDelta :
Expand Down Expand Up @@ -111,6 +126,58 @@ type _ t =
}
-> Json.t t

let yojson_of_definition_result (result : definition_result) : Json.t =
match result with
| `Definition definition -> Definition.yojson_of_t definition
| `DefinitionLink links -> Json.To.list DefinitionLink.yojson_of_t links
;;

let definition_result_of_yojson json : definition_result =
Json.Of.untagged_union
"definition result"
[ (fun json -> `Definition (Definition.t_of_yojson json))
; (fun json -> `DefinitionLink (Json.Of.list DefinitionLink.t_of_yojson json))
]
json
;;

let yojson_of_declaration_result (result : declaration_result) : Json.t =
match result with
| `Declaration declaration -> Declaration.yojson_of_t declaration
| `DeclarationLink links -> Json.To.list DeclarationLink.yojson_of_t links
;;

let declaration_result_of_yojson json : declaration_result =
Json.Of.untagged_union
"declaration result"
[ (fun json -> `Declaration (Declaration.t_of_yojson json))
; (fun json -> `DeclarationLink (Json.Of.list DeclarationLink.t_of_yojson json))
]
json
;;

let yojson_of_workspace_symbol_result (result : workspace_symbol_result) : Json.t =
match result with
| `SymbolInformation symbols -> Json.To.list SymbolInformation.yojson_of_t symbols
| `WorkspaceSymbol symbols -> Json.To.list WorkspaceSymbol.yojson_of_t symbols
;;

let workspace_symbol_result_of_yojson json : workspace_symbol_result =
let is_workspace_symbol = function
| `Assoc fields ->
Option.is_some (List.assoc_opt "data" fields)
||
(match List.assoc_opt "location" fields with
| Some (`Assoc location) -> Option.is_none (List.assoc_opt "range" location)
| _ -> false)
| _ -> false
in
match json with
| `List (symbol :: _) when is_workspace_symbol symbol ->
`WorkspaceSymbol (Json.Of.list WorkspaceSymbol.t_of_yojson json)
| _ -> `SymbolInformation (Json.Of.list SymbolInformation.t_of_yojson json)
;;

let yojson_of_DocumentSymbol ds : Json.t =
Json.Option.yojson_of_t
(function
Expand Down Expand Up @@ -148,14 +215,14 @@ let yojson_of_result (type a) (req : a t) (result : a) =
| Shutdown, () -> `Null
| Initialize _, result -> InitializeResult.yojson_of_t result
| TextDocumentDeclaration _, result ->
Json.Conv.yojson_of_option Locations.yojson_of_t result
Json.Option.yojson_of_t yojson_of_declaration_result result
| TextDocumentHover _, result -> Json.Option.yojson_of_t Hover.yojson_of_t result
| TextDocumentDefinition _, result ->
Json.Option.yojson_of_t Locations.yojson_of_t result
Json.Option.yojson_of_t yojson_of_definition_result result
| TextDocumentTypeDefinition _, result ->
Json.Option.yojson_of_t Locations.yojson_of_t result
Json.Option.yojson_of_t yojson_of_definition_result result
| TextDocumentImplementation _, result ->
Json.Option.yojson_of_t Locations.yojson_of_t result
Json.Option.yojson_of_t yojson_of_definition_result result
| TextDocumentCompletion _, result -> yojson_of_Completion result
| TextDocumentCodeLens _, result -> Json.To.list CodeLens.yojson_of_t result
| TextDocumentCodeLensResolve _, result -> CodeLens.yojson_of_t result
Expand All @@ -169,7 +236,8 @@ let yojson_of_result (type a) (req : a t) (result : a) =
Json.Option.yojson_of_t (Json.To.list TextEdit.yojson_of_t) result
| TextDocumentRangesFormatting _, result ->
Json.Option.yojson_of_t (Json.To.list TextEdit.yojson_of_t) result
| TextDocumentRename _, result -> WorkspaceEdit.yojson_of_t result
| TextDocumentRename _, result ->
Json.Option.yojson_of_t WorkspaceEdit.yojson_of_t result
| DocumentSymbol _, result -> yojson_of_DocumentSymbol result
| DebugEcho _, result -> DebugEcho.Result.yojson_of_t result
| DebugTextDocumentGet _, result -> DebugTextDocumentGet.Result.yojson_of_t result
Expand All @@ -181,7 +249,7 @@ let yojson_of_result (type a) (req : a t) (result : a) =
Json.Option.yojson_of_t (Json.To.list FoldingRange.yojson_of_t) result
| TextDocumentMoniker _, result ->
Json.Option.yojson_of_t (Json.To.list Moniker.yojson_of_t) result
| SignatureHelp _, result -> SignatureHelp.yojson_of_t result
| SignatureHelp _, result -> Json.Option.yojson_of_t SignatureHelp.yojson_of_t result
| CodeAction _, result -> CodeActionResult.yojson_of_t result
| CodeActionResolve _, result -> CodeAction.yojson_of_t result
| CompletionItemResolve _, result -> CompletionItem.yojson_of_t result
Expand All @@ -195,11 +263,12 @@ let yojson_of_result (type a) (req : a t) (result : a) =
Json.Option.yojson_of_t (Json.To.list DocumentLink.yojson_of_t) result
| TextDocumentLinkResolve _, result -> DocumentLink.yojson_of_t result
| WorkspaceSymbol _, result ->
Json.Option.yojson_of_t (Json.To.list SymbolInformation.yojson_of_t) result
Json.Option.yojson_of_t yojson_of_workspace_symbol_result result
| TextDocumentColorPresentation _, result ->
Json.To.list ColorPresentation.yojson_of_t result
| TextDocumentColor _, result -> Json.To.list ColorInformation.yojson_of_t result
| SelectionRange _, result -> Json.yojson_of_list SelectionRange.yojson_of_t result
| SelectionRange _, result ->
Json.Option.yojson_of_t (Json.To.list SelectionRange.yojson_of_t) result
| SemanticTokensFull _, result ->
Json.Option.yojson_of_t SemanticTokens.yojson_of_t result
| SemanticTokensDelta _, result -> yojson_of_SemanticTokensDelta result
Expand Down Expand Up @@ -556,10 +625,10 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a =
| Shutdown -> unit_of_yojson json
| Initialize _ -> InitializeResult.t_of_yojson json
| TextDocumentHover _ -> option_of_yojson Hover.t_of_yojson json
| TextDocumentDefinition _ -> option_of_yojson Locations.t_of_yojson json
| TextDocumentDeclaration _ -> option_of_yojson Locations.t_of_yojson json
| TextDocumentTypeDefinition _ -> option_of_yojson Locations.t_of_yojson json
| TextDocumentImplementation _ -> option_of_yojson Locations.t_of_yojson json
| TextDocumentDefinition _ -> option_of_yojson definition_result_of_yojson json
| TextDocumentDeclaration _ -> option_of_yojson declaration_result_of_yojson json
| TextDocumentTypeDefinition _ -> option_of_yojson definition_result_of_yojson json
| TextDocumentImplementation _ -> option_of_yojson definition_result_of_yojson json
| TextDocumentCompletion _ ->
option_of_yojson
(Json.Of.untagged_union
Expand All @@ -577,7 +646,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a =
option_of_yojson (list_of_yojson TextEdit.t_of_yojson) json
| TextDocumentRangesFormatting _ ->
option_of_yojson (list_of_yojson TextEdit.t_of_yojson) json
| TextDocumentRename _ -> WorkspaceEdit.t_of_yojson json
| TextDocumentRename _ -> option_of_yojson WorkspaceEdit.t_of_yojson json
| TextDocumentLink _ -> option_of_yojson (list_of_yojson DocumentLink.t_of_yojson) json
| TextDocumentLinkResolve _ -> DocumentLink.t_of_yojson json
| TextDocumentMoniker _ -> option_of_yojson (list_of_yojson Moniker.t_of_yojson) json
Expand All @@ -590,8 +659,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a =
`SymbolInformation (list_of_yojson SymbolInformation.t_of_yojson json))
])
json
| WorkspaceSymbol _ ->
option_of_yojson (list_of_yojson SymbolInformation.t_of_yojson) json
| WorkspaceSymbol _ -> option_of_yojson workspace_symbol_result_of_yojson json
| DebugEcho _ -> DebugEcho.Result.t_of_yojson json
| DebugTextDocumentGet _ -> DebugTextDocumentGet.Result.t_of_yojson json
| TextDocumentReferences _ ->
Expand All @@ -600,7 +668,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a =
option_of_yojson (list_of_yojson DocumentHighlight.t_of_yojson) json
| TextDocumentFoldingRange _ ->
option_of_yojson (list_of_yojson FoldingRange.t_of_yojson) json
| SignatureHelp _ -> SignatureHelp.t_of_yojson json
| SignatureHelp _ -> option_of_yojson SignatureHelp.t_of_yojson json
| CodeAction _ -> CodeActionResult.t_of_yojson json
| CodeActionResolve _ -> CodeAction.t_of_yojson json
| CompletionItemResolve _ -> CompletionItem.t_of_yojson json
Expand All @@ -612,7 +680,7 @@ let response_of_json (type a) (t : a t) (json : Json.t) : a =
option_of_yojson (list_of_yojson TextEdit.t_of_yojson) json
| TextDocumentColorPresentation _ -> list_of_yojson ColorPresentation.t_of_yojson json
| TextDocumentColor _ -> list_of_yojson ColorInformation.t_of_yojson json
| SelectionRange _ -> list_of_yojson SelectionRange.t_of_yojson json
| SelectionRange _ -> option_of_yojson (list_of_yojson SelectionRange.t_of_yojson) json
| ExecuteCommand _ -> json
| SemanticTokensFull _ -> option_of_yojson SemanticTokens.t_of_yojson json
| SemanticTokensDelta _ ->
Expand Down
31 changes: 23 additions & 8 deletions lsp/src/client_request.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,29 @@ open! Import
open Types
open Extension

type definition_result =
[ `Definition of Definition.t
| `DefinitionLink of DefinitionLink.t list
]

type declaration_result =
[ `Declaration of Declaration.t
| `DeclarationLink of DeclarationLink.t list
]

type workspace_symbol_result =
[ `SymbolInformation of SymbolInformation.t list
| `WorkspaceSymbol of WorkspaceSymbol.t list
]

type _ t =
| Shutdown : unit t
| Initialize : InitializeParams.t -> InitializeResult.t t
| TextDocumentHover : HoverParams.t -> Hover.t option t
| TextDocumentDefinition : DefinitionParams.t -> Locations.t option t
| TextDocumentDeclaration : DeclarationParams.t -> Locations.t option t
| TextDocumentTypeDefinition : TypeDefinitionParams.t -> Locations.t option t
| TextDocumentImplementation : ImplementationParams.t -> Locations.t option t
| TextDocumentDefinition : DefinitionParams.t -> definition_result option t
| TextDocumentDeclaration : DeclarationParams.t -> declaration_result option t
| TextDocumentTypeDefinition : TypeDefinitionParams.t -> definition_result option t
| TextDocumentImplementation : ImplementationParams.t -> definition_result option t
| TextDocumentCompletion :
CompletionParams.t
-> [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] option t
Expand Down Expand Up @@ -39,7 +54,7 @@ type _ t =
| TextDocumentRangesFormatting :
DocumentRangesFormattingParams.t
-> TextEdit.t list option t
| TextDocumentRename : RenameParams.t -> WorkspaceEdit.t t
| TextDocumentRename : RenameParams.t -> WorkspaceEdit.t option t
| TextDocumentLink : DocumentLinkParams.t -> DocumentLink.t list option t
| TextDocumentLinkResolve : DocumentLink.t -> DocumentLink.t t
| TextDocumentMoniker : MonikerParams.t -> Moniker.t list option t
Expand All @@ -50,7 +65,7 @@ type _ t =
]
option
t
| WorkspaceSymbol : WorkspaceSymbolParams.t -> SymbolInformation.t list option t
| WorkspaceSymbol : WorkspaceSymbolParams.t -> workspace_symbol_result option t
| WorkspaceSymbolResolve : WorkspaceSymbol.t -> WorkspaceSymbol.t t
| DebugEcho : DebugEcho.Params.t -> DebugEcho.Result.t t
| DebugTextDocumentGet :
Expand All @@ -59,7 +74,7 @@ type _ t =
| TextDocumentReferences : ReferenceParams.t -> Location.t list option t
| TextDocumentHighlight : DocumentHighlightParams.t -> DocumentHighlight.t list option t
| TextDocumentFoldingRange : FoldingRangeParams.t -> FoldingRange.t list option t
| SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t t
| SignatureHelp : SignatureHelpParams.t -> SignatureHelp.t option t
| CodeAction : CodeActionParams.t -> CodeActionResult.t t
| CodeActionResolve : CodeAction.t -> CodeAction.t t
| CompletionItemResolve : CompletionItem.t -> CompletionItem.t t
Expand All @@ -74,7 +89,7 @@ type _ t =
ColorPresentationParams.t
-> ColorPresentation.t list t
| TextDocumentColor : DocumentColorParams.t -> ColorInformation.t list t
| SelectionRange : SelectionRangeParams.t -> SelectionRange.t list t
| SelectionRange : SelectionRangeParams.t -> SelectionRange.t list option t
| ExecuteCommand : ExecuteCommandParams.t -> Json.t t
| SemanticTokensFull : SemanticTokensParams.t -> SemanticTokens.t option t
| SemanticTokensDelta :
Expand Down
25 changes: 0 additions & 25 deletions lsp/src/types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57487,28 +57487,3 @@ module CodeActionResult = struct
| _ -> Json.error "CodeActionResult" json
;;
end

module Locations = struct
type t =
[ `Location of Location.t list
| `LocationLink of LocationLink.t list
]

let yojson_of_t (t : t) : Json.t =
match t with
| `Location xs -> `List (List.map ~f:Location.yojson_of_t xs)
| `LocationLink l -> `List (List.map ~f:LocationLink.yojson_of_t l)
;;

let t_of_yojson (json : Json.t) : t =
match json with
| `Assoc _ -> `Location [ Location.t_of_yojson json ]
| `List [] -> `Location []
| `List (x :: xs) ->
(match Location.t_of_yojson x with
| loc -> `Location (loc :: List.map ~f:Location.t_of_yojson xs)
| exception Of_yojson_error (_, _) ->
`LocationLink (List.map ~f:LocationLink.t_of_yojson (x :: xs)))
| _ -> Json.error "Locations.t" json
;;
end
9 changes: 0 additions & 9 deletions lsp/src/types.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6274,12 +6274,3 @@ module CodeActionResult : sig

include Json.Jsonable.S with type t := t
end

module Locations : sig
type t =
[ `Location of Location.t list
| `LocationLink of LocationLink.t list
]

include Json.Jsonable.S with type t := t
end
Loading
Loading