diff --git a/haskell-lsp-types/haskell-lsp-types.cabal b/haskell-lsp-types/haskell-lsp-types.cabal index 468450cdc..a098e689c 100644 --- a/haskell-lsp-types/haskell-lsp-types.cabal +++ b/haskell-lsp-types/haskell-lsp-types.cabal @@ -39,6 +39,7 @@ library , Language.Haskell.LSP.Types.Message , Language.Haskell.LSP.Types.Progress , Language.Haskell.LSP.Types.Symbol + , Language.Haskell.LSP.Types.Synonyms , Language.Haskell.LSP.Types.TextDocument , Language.Haskell.LSP.Types.Types , Language.Haskell.LSP.Types.Uri diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types.hs index fb0cfeaf7..f29d075e9 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types.hs @@ -14,6 +14,7 @@ module Language.Haskell.LSP.Types , module Language.Haskell.LSP.Types.Message , module Language.Haskell.LSP.Types.Progress , module Language.Haskell.LSP.Types.Symbol + , module Language.Haskell.LSP.Types.Synonyms , module Language.Haskell.LSP.Types.TextDocument , module Language.Haskell.LSP.Types.Types , module Language.Haskell.LSP.Types.Uri @@ -38,6 +39,7 @@ import Language.Haskell.LSP.Types.MarkupContent import Language.Haskell.LSP.Types.Message import Language.Haskell.LSP.Types.Progress import Language.Haskell.LSP.Types.Symbol +import Language.Haskell.LSP.Types.Synonyms import Language.Haskell.LSP.Types.TextDocument import Language.Haskell.LSP.Types.Types import Language.Haskell.LSP.Types.Uri diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Color.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Color.hs index c23b93b31..f83cd2ef2 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Color.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Color.hs @@ -193,4 +193,3 @@ data ColorPresentation = deriveJSON lspOptions ''ColorPresentation - diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MessageFuncs.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MessageFuncs.hs index 7085ed988..fcc4f0e95 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MessageFuncs.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MessageFuncs.hs @@ -138,23 +138,23 @@ fmServerLogMessageNotification mt msg -- ---------------------------------------------------------------------- -fmServerWorkDoneProgressBeginNotification :: J.ProgressParams J.WorkDoneProgressBeginParams -> J.WorkDoneProgressBeginNotification +fmServerWorkDoneProgressBeginNotification :: J.ProgressParams J.WorkDoneProgressBeginParams -> J.ProgressNotification fmServerWorkDoneProgressBeginNotification params = J.NotificationMessage "2.0" J.SProgress (J.Begin <$> params) -- ---------------------------------------------------------------------- -fmServerWorkDoneProgressReportNotification :: J.ProgressParams J.WorkDoneProgressReportParams -> J.WorkDoneProgressReportNotification +fmServerWorkDoneProgressReportNotification :: J.ProgressParams J.WorkDoneProgressReportParams -> J.ProgressNotification fmServerWorkDoneProgressReportNotification params = J.NotificationMessage "2.0" J.SProgress (J.Report <$> params) -- ---------------------------------------------------------------------- -fmServerWorkDoneProgressEndNotification :: J.ProgressParams J.WorkDoneProgressEndParams -> J.WorkDoneProgressEndNotification +fmServerWorkDoneProgressEndNotification :: J.ProgressParams J.WorkDoneProgressEndParams -> J.ProgressNotification fmServerWorkDoneProgressEndNotification params = J.NotificationMessage "2.0" J.SProgress (J.End <$> params) -fmServerWorkDoneProgressCreateRequest :: J.LspId J.WindowWorkDoneProgressCreate -> J.WorkDoneProgressCreateParams -> J.WorkDoneProgressCreateRequest +fmServerWorkDoneProgressCreateRequest :: J.LspId J.WindowWorkDoneProgressCreate -> J.WorkDoneProgressCreateParams -> J.WindowWorkDoneProgressCreateRequest fmServerWorkDoneProgressCreateRequest rid params = J.RequestMessage "2.0" rid J.SWindowWorkDoneProgressCreate params diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Synonyms.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Synonyms.hs new file mode 100644 index 000000000..4ed4ad6fd --- /dev/null +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Synonyms.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} + +module Language.Haskell.LSP.Types.Synonyms where + +import Language.Haskell.LSP.Types.Message +import Language.Haskell.LSP.Types.Types + +-- Server Messages + +-- Window +type ShowMessageNotification = Message WindowShowMessage + +type ShowMessageRequest = Message WindowShowMessageRequest +type ShowMessageResponse = ResponseMessage WindowShowMessageRequest + +type LogMessageNotification = Message WindowLogMessage + +type WindowWorkDoneProgressCreateRequest = Message WindowWorkDoneProgressCreate +type WindowWorkDoneProgressCreateResponse = ResponseMessage WindowWorkDoneProgressCreate + +type ProgressNotification = Message Progress + +type TelemetryNotification = Message TelemetryEvent + +-- Capability +type RegisterCapabilityRequest = Message ClientRegisterCapability +type RegisterCapabilityResponse = ResponseMessage ClientRegisterCapability + +type UnregisterCapabilityRequest = Message ClientUnregisterCapability +type UnregisterCapabilityResponse = ResponseMessage ClientUnregisterCapability + +-- Workspace +type WorkspaceFoldersRequest = Message WorkspaceWorkspaceFolders +type WorkspaceFoldersResponse = ResponseMessage WorkspaceWorkspaceFolders + +type ConfigurationRequest = Message WorkspaceConfiguration +type ConfigurationResponse = ResponseMessage WorkspaceConfiguration + +type ApplyWorkspaceEditRequest = Message WorkspaceApplyEdit +type ApplyWorkspaceEditResponse = ResponseMessage WorkspaceApplyEdit + +-- Document/Diagnostic +type PublishDiagnosticsNotification = Message TextDocumentPublishDiagnostics + +-- Cancel +type CancelNotificationServer = Message CancelRequest + +-- Custom +type CustomServerNotification = Message CustomMethod +type CustomServerRequest = Message CustomMethod + +-- Client Messages + +-- General +type InitializeRequest = Message Initialize +type InitializeResponse = ResponseMessage Initialize + +type InitializedNotification = Message Initialized + +type ShutdownRequest = Message Shutdown +type ShutdownResponse = ResponseMessage Shutdown + +type ExitNotification = Message Exit +type CancelNotification = Message CancelRequest + +-- Workspace +type DidChangeWorkspaceFoldersNotification = Message WorkspaceDidChangeWorkspaceFolders +type DidChangeConfigurationNotification = Message WorkspaceDidChangeConfiguration +type DidChangeWatchedFilesNotification = Message WorkspaceDidChangeWatchedFiles + +type WorkspaceSymbolRequest = Message WorkspaceSymbol +type WorkspaceSymbolsResponse = ResponseMessage WorkspaceSymbol + +type ExecuteCommandRequest = Message WorkspaceExecuteCommand +type ExecuteCommandResponse = ResponseMessage WorkspaceExecuteCommand + +type WorkDoneProgressCancelNotification = Message WorkDoneProgressCancel + +-- Document/Sync +type DidOpenTextDocumentNotification = Message TextDocumentDidOpen +type DidChangeTextDocumentNotification = Message TextDocumentDidChange +type WillSaveTextDocumentNotification = Message TextDocumentWillSave + +type WillSaveWaitUntilTextDocumentRequest = Message TextDocumentWillSaveWaitUntil +type WillSaveWaitUntilTextDocumentResponse = ResponseMessage TextDocumentWillSaveWaitUntil + +type DidSaveTextDocumentNotification = Message TextDocumentDidSave +type DidCloseTextDocumentNotification = Message TextDocumentDidClose + +-- Completion + +type CompletionRequest = Message TextDocumentCompletion +type CompletionResponse = ResponseMessage TextDocumentCompletion + +type CompletionItemResolveRequest = Message CompletionItemResolve +type CompletionItemResolveResponse = ResponseMessage CompletionItemResolve + +-- Queries +type HoverRequest = Message TextDocumentHover +type HoverResponse = ResponseMessage TextDocumentHover + +type SignatureHelpRequest = Message TextDocumentSignatureHelp +type SignatureHelpResponse = ResponseMessage TextDocumentSignatureHelp + +type DefinitionRequest = Message TextDocumentDefinition +type DefinitionResponse = ResponseMessage TextDocumentDefinition + +type TypeDefinitionRequest = Message TextDocumentTypeDefinition +type TypeDefinitionResponse = ResponseMessage TextDocumentTypeDefinition + +type ImplementationRequest = Message TextDocumentImplementation +type ImplementationResponse = ResponseMessage TextDocumentImplementation + +type ReferencesRequest = Message TextDocumentReferences +type ReferencesResponse = ResponseMessage TextDocumentReferences + +type DocumentHighlightRequest = Message TextDocumentDocumentHighlight +type DocumentHighlightsResponse = ResponseMessage TextDocumentDocumentHighlight + +type DocumentSymbolRequest = Message TextDocumentDocumentSymbol +type DocumentSymbolsResponse = ResponseMessage TextDocumentDocumentSymbol + +-- Code Lens/Action/Link + +type CodeActionRequest = Message TextDocumentCodeAction +type CodeActionResponse = ResponseMessage TextDocumentCodeAction + +type CodeLensRequest = Message TextDocumentCodeLens +type CodeLensResponse = ResponseMessage TextDocumentCodeLens + +type CodeLensResolveRequest = Message CodeLensResolve +type CodeLensResolveResponse = ResponseMessage CodeLensResolve + +type DocumentLinkRequest = Message TextDocumentDocumentLink +type DocumentLinkResponse = ResponseMessage TextDocumentDocumentLink + +type DocumentLinkResolveRequest = Message DocumentLinkResolve +type DocumentLinkResolveResponse = ResponseMessage DocumentLinkResolve + +-- Color/Syntax + +type DocumentColorRequest = Message TextDocumentDocumentColor +type DocumentColorResponse = ResponseMessage TextDocumentDocumentColor + +type ColorPresentationRequest = Message TextDocumentColorPresentation +type ColorPresentationResponse = ResponseMessage TextDocumentColorPresentation + + +-- Formatting +type DocumentFormattingRequest = Message TextDocumentFormatting +type DocumentFormattingResponse = ResponseMessage TextDocumentFormatting + +type DocumentRangeFormattingRequest = Message TextDocumentRangeFormatting +type DocumentRangeFormattingResponse = ResponseMessage TextDocumentRangeFormatting + +type DocumentOnTypeFormattingRequest = Message TextDocumentOnTypeFormatting +type DocumentOnTypeFormattingResponse = ResponseMessage TextDocumentOnTypeFormatting + +-- Rename +type RenameRequest = Message TextDocumentRename +type RenameResponse = ResponseMessage TextDocumentRename + +type PrepareRenameRequest = Message TextDocumentPrepareRename +type PrepareRenameResponse = ResponseMessage TextDocumentPrepareRename + +-- Folding +type FoldingRangeRequest = Message TextDocumentFoldingRange +type FoldingRangeResponse = ResponseMessage TextDocumentFoldingRange + +-- Custom +type CustomClientNotification = Message CustomMethod +type CustomClientRequest = Message CustomMethod +type CustomResponse = ResponseMessage CustomMethod diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Types.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Types.hs index 5d243dab9..7ccd5cac3 100644 --- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/Types.hs +++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/Types.hs @@ -232,14 +232,6 @@ instance FromJSON (ResponseParams a) => FromJSON (ResponseMessage a) where fail "ResponseMessage must either have a result or an error" pure rsp --- TODO --- type ErrorResponse = ResponseMessage () - --- --------------------------------------------------------------------- - --- TODO --- type BareResponseMessage = ResponseMessage A.Value - -- --------------------------------------------------------------------- {- $ Notifications and Requests @@ -292,177 +284,6 @@ type family BaseMessage (t :: MethodType) :: Method p t -> Type where BaseMessage Request = RequestMessage BaseMessage Notification = NotificationMessage --- Server Messages - --- Window -type ShowMessageNotification = Message WindowShowMessage -type ShowMessageRequest = Message WindowShowMessageRequest -type ShowMessageResponse = ResponseMessage WindowShowMessageRequest -type LogMessageNotification = Message WindowLogMessage - --- | The window/progress/start notification is sent from the server to the --- client to ask the client to start progress. --- --- @since 0.10.0.0 --- type ProgressStartNotification = ServerMessage WindowProgressStart - --- | The window/progress/report notification is sent from the server to the --- client to report progress for a previously started progress. --- --- @since 0.10.0.0 --- type ProgressReportNotification = ServerMessage WindowProgressReport - --- | The window/progress/done notification is sent from the server to the --- client to stop a previously started progress. --- --- @since 0.10.0.0 --- type ProgressDoneNotification = ServerMessage WindowProgressDone - -type TelemetryNotification = Message TelemetryEvent - --- Capability -type RegisterCapabilityRequest = Message ClientRegisterCapability -type RegisterCapabilityResponse = ResponseMessage ClientRegisterCapability -type UnregisterCapabilityRequest = Message ClientUnregisterCapability -type UnregisterCapabilityResponse = ResponseMessage ClientUnregisterCapability - --- Workspace -type WorkspaceFoldersRequest = Message WorkspaceWorkspaceFolders -type WorkspaceFoldersResponse = ResponseMessage WorkspaceWorkspaceFolders -type ConfigurationRequest = Message WorkspaceConfiguration -type ConfigurationResponse = ResponseMessage WorkspaceConfiguration -type ApplyWorkspaceEditRequest = Message WorkspaceApplyEdit -type ApplyWorkspaceEditResponse = ResponseMessage WorkspaceApplyEdit - --- Document/Diagnostic -type PublishDiagnosticsNotification = Message TextDocumentPublishDiagnostics - --- Cancel -type CancelNotificationServer = Message CancelRequest - --- Custom -type CustomServerNotification = Message CustomMethod -type CustomServerRequest = Message CustomMethod - --- Client Messages - --- General -type InitializeRequest = Message Initialize -type InitializeResponse = ResponseMessage Initialize -type InitializedNotification = Message Initialized -type ShutdownRequest = Message Shutdown -type ShutdownResponse = ResponseMessage Shutdown -type ExitNotification = Message Exit -type CancelNotification = Message CancelRequest - --- Workspace -type DidChangeWorkspaceFoldersNotification = Message WorkspaceDidChangeWorkspaceFolders -type DidChangeConfigurationNotification = Message WorkspaceDidChangeConfiguration -type DidChangeWatchedFilesNotification = Message WorkspaceDidChangeWatchedFiles -type WorkspaceSymbolRequest = Message WorkspaceSymbol -type WorkspaceSymbolsResponse = ResponseMessage WorkspaceSymbol -type ExecuteCommandRequest = Message WorkspaceExecuteCommand -type ExecuteCommandResponse = ResponseMessage WorkspaceExecuteCommand - --- Progress - --- | The window/progress/cancel notification is sent from the client to the server --- to inform the server that the user has pressed the cancel button on the progress UX. --- A server receiving a cancel request must still close a progress using the done notification. --- --- @since 0.10.0.0 -type WorkDoneProgressCreateRequest = Message WindowWorkDoneProgressCreate -type WorkDoneProgressCancelNotification = Message WorkDoneProgressCancel -type WorkDoneProgressBeginNotification = Message Progress -type WorkDoneProgressReportNotification = Message Progress -type WorkDoneProgressEndNotification = Message Progress - --- Document/Sync -type DidOpenTextDocumentNotification = Message TextDocumentDidOpen -type DidChangeTextDocumentNotification = Message TextDocumentDidChange -type WillSaveTextDocumentNotification = Message TextDocumentWillSave -type WillSaveWaitUntilTextDocumentRequest = Message TextDocumentWillSaveWaitUntil -type WillSaveWaitUntilTextDocumentResponse = ResponseMessage TextDocumentWillSaveWaitUntil -type DidSaveTextDocumentNotification = Message TextDocumentDidSave -type DidCloseTextDocumentNotification = Message TextDocumentDidClose - --- Completion - -type CompletionRequest = Message TextDocumentCompletion -type CompletionResponse = ResponseMessage TextDocumentCompletion - -type CompletionItemResolveRequest = Message CompletionItemResolve -type CompletionItemResolveResponse = ResponseMessage CompletionItemResolve - --- Queries -type HoverRequest = Message TextDocumentHover -type HoverResponse = ResponseMessage TextDocumentHover -type SignatureHelpRequest = Message TextDocumentSignatureHelp -type SignatureHelpResponse = ResponseMessage TextDocumentSignatureHelp -type DefinitionRequest = Message TextDocumentDefinition -type DefinitionResponse = ResponseMessage TextDocumentDefinition -type TypeDefinitionRequest = Message TextDocumentTypeDefinition -type TypeDefinitionResponse = ResponseMessage TextDocumentTypeDefinition -type ImplementationRequest = Message TextDocumentImplementation -type ImplementationResponse = ResponseMessage TextDocumentImplementation -type ReferencesRequest = Message TextDocumentReferences -type ReferencesResponse = ResponseMessage TextDocumentReferences -type DocumentHighlightRequest = Message TextDocumentDocumentHighlight -type DocumentHighlightsResponse = ResponseMessage TextDocumentDocumentHighlight -type DocumentSymbolRequest = Message TextDocumentDocumentSymbol -type DocumentSymbolsResponse = ResponseMessage TextDocumentDocumentSymbol - --- Code Lens/Action/Link - -type CodeActionRequest = Message TextDocumentCodeAction -type CodeActionResponse = ResponseMessage TextDocumentCodeAction - -type CodeLensRequest = Message TextDocumentCodeLens -type CodeLensResponse = ResponseMessage TextDocumentCodeLens -type CodeLensResolveRequest = Message CodeLensResolve -type CodeLensResolveResponse = ResponseMessage CodeLensResolve - -type DocumentLinkRequest = Message TextDocumentDocumentLink -type DocumentLinkResponse = ResponseMessage TextDocumentDocumentLink -type DocumentLinkResolveRequest = Message DocumentLinkResolve -type DocumentLinkResolveResponse = ResponseMessage DocumentLinkResolve - --- Color/Syntax - -type DocumentColorRequest = Message TextDocumentDocumentColor -type DocumentColorResponse = ResponseMessage TextDocumentDocumentColor - -type ColorPresentationRequest = Message TextDocumentColorPresentation -type ColorPresentationResponse = ResponseMessage TextDocumentColorPresentation - - --- Formatting -type DocumentFormattingRequest = Message TextDocumentFormatting -type DocumentFormattingResponse = ResponseMessage TextDocumentFormatting - -type DocumentRangeFormattingRequest = Message TextDocumentRangeFormatting -type DocumentRangeFormattingResponse = ResponseMessage TextDocumentRangeFormatting - -type DocumentOnTypeFormattingRequest = Message TextDocumentOnTypeFormatting -type DocumentOnTypeFormattingResponse = ResponseMessage TextDocumentOnTypeFormatting - --- Rename -type RenameRequest = Message TextDocumentRename -type RenameResponse = ResponseMessage TextDocumentRename -type PrepareRenameRequest = Message TextDocumentPrepareRename -type PrepareRenameResponse = ResponseMessage TextDocumentPrepareRename - --- Folding -type FoldingRangeRequest = Message TextDocumentFoldingRange -type FoldingRangeResponse = ResponseMessage TextDocumentFoldingRange - --- Custom -type CustomClientNotification = Message CustomMethod - -type CustomClientRequest = Message CustomMethod - -type CustomResponse = ResponseMessage CustomMethod - data FromServerMessage where FromServerMess :: forall t (m :: Method FromServer t). SMethod m -> Message m -> FromServerMessage FromServerRsp :: forall (m :: Method FromClient Request). SMethod m -> ResponseMessage m -> FromServerMessage @@ -614,79 +435,3 @@ splitServerMethod SWorkspaceApplyEdit = IsServerReq splitServerMethod STextDocumentPublishDiagnostics = IsServerNot splitServerMethod SCancelRequest = IsServerNot splitServerMethod SCustomMethod{} = IsServerEither - --- --------------------------------------------------------------------- -{- -instance Show FromServerMessage where - show = show . A.toJSON - -instance Eq FromServerMessage where - (FromServerMess m1 a) == (FromServerMess m2 b) = case geq m1 m2 of - Nothing -> False - Just Refl -> case splitServerMethod m1 of - IsServerReq -> a == b - IsServerNot -> a == b - IsServerEither -> a == b - (FromServerRsp m1 a) == (FromServerRsp m2 b) = case geq m1 m2 of - Nothing -> False - Just Refl -> case splitClientMethod m1 of - IsClientReq -> a == b - IsClientEither -> a == b - IsClientNot -> error "impossible" - _ == _ = False -instance A.ToJSON FromServerMessage where - toJSON (FromServerMess m x) = case splitServerMethod m of - IsServerReq -> A.toJSON x - IsServerNot -> A.toJSON x - IsServerEither -> A.toJSON x - toJSON (FromServerRsp m x) = case splitClientMethod m of - IsClientReq -> A.toJSON x - IsClientEither -> A.toJSON x - IsClientNot -> error "impossible" - - -instance Show FromClientMessage where - show = show . A.toJSON - -instance Eq FromClientMessage where - (FromClientMess m1 a) == (FromClientMess m2 b) = case geq m1 m2 of - Nothing -> False - Just Refl -> case splitClientMethod m1 of - IsClientReq -> a == b - IsClientNot -> a == b - IsClientEither -> a == b - (FromClientRsp m1 a) == (FromClientRsp m2 b) = case geq m1 m2 of - Nothing -> False - Just Refl -> case splitServerMethod m1 of - IsServerReq -> a == b - IsServerEither -> a == b - IsServerNot -> error "impossible" - _ == _ = False -instance A.ToJSON FromClientMessage where - toJSON (FromClientMess m x) = case splitClientMethod m of - IsClientReq -> A.toJSON x - IsClientNot -> A.toJSON x - IsClientEither -> A.toJSON x - toJSON (FromClientRsp m x) = case splitServerMethod m of - IsServerReq -> A.toJSON x - IsServerEither -> A.toJSON x - IsServerNot -> error "impossible" - - --- Proof that every ClientMessage has a To/FromJSON instance - - -type family Response (t :: Type) :: Type where - Response (RequestMessage m req) = ResponseMessage m rsp - Response (CustomMessage m) = ResponseMessage A.Value - Response a = TypeError ('Text "Messages of type " :<>: ShowType a :<>: - 'Text " cannot be responded too") -type family ServerResponse (m :: ClientMethod) :: Type where - ServerResponse m = Response (ClientMessage m) -type family ClientResponse (m :: ServerMethod) :: Type where - ClientResponse m = Response (ServerMessage m) - - - - --}