From f175ca7c83ee56779efce9468a57b87d2c1c95b7 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sat, 6 Mar 2021 23:59:08 +0000 Subject: [PATCH 1/4] Add missing code action caps --- lsp-test/test/DummyServer.hs | 1 + .../src/Language/LSP/Types/Capabilities.hs | 4 ++ .../src/Language/LSP/Types/CodeAction.hs | 41 +++++++++++++++++-- lsp-types/src/Language/LSP/Types/Lens.hs | 1 + src/Language/LSP/Server/Processing.hs | 6 +-- 5 files changed, 47 insertions(+), 6 deletions(-) diff --git a/lsp-test/test/DummyServer.hs b/lsp-test/test/DummyServer.hs index b9ceaf407..599bcc5dc 100644 --- a/lsp-test/test/DummyServer.hs +++ b/lsp-test/test/DummyServer.hs @@ -160,6 +160,7 @@ handlers = Nothing Nothing (Just (Command "" "deleteThis" Nothing)) + Nothing resp $ Right $ InR <$> codeActions , requestHandler STextDocumentCompletion $ \_req resp -> do let res = CompletionList True (List [item]) diff --git a/lsp-types/src/Language/LSP/Types/Capabilities.hs b/lsp-types/src/Language/LSP/Types/Capabilities.hs index dd482456b..69adb3488 100644 --- a/lsp-types/src/Language/LSP/Types/Capabilities.hs +++ b/lsp-types/src/Language/LSP/Types/Capabilities.hs @@ -194,6 +194,10 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus dynamicReg (since 3 8 (CodeActionLiteralSupport caKs)) (since 3 15 True) + (since 3 16 True) + (since 3 16 True) + (since 3 16 (CodeActionResolveClientCapabilities (List []))) + (since 3 16 True) caKs = CodeActionKindClientCapabilities (List [ CodeActionQuickFix , CodeActionRefactor diff --git a/lsp-types/src/Language/LSP/Types/CodeAction.hs b/lsp-types/src/Language/LSP/Types/CodeAction.hs index e847f9554..76a5c8562 100644 --- a/lsp-types/src/Language/LSP/Types/CodeAction.hs +++ b/lsp-types/src/Language/LSP/Types/CodeAction.hs @@ -116,6 +116,13 @@ data CodeActionLiteralSupport = deriveJSON lspOptions ''CodeActionLiteralSupport +data CodeActionResolveClientCapabilities = + CodeActionResolveClientCapabilities + { _properties :: List Text -- ^ The properties that a client can resolve lazily. + } deriving (Show, Read, Eq) + +deriveJSON lspOptions ''CodeActionResolveClientCapabilities + data CodeActionClientCapabilities = CodeActionClientCapabilities { -- | Whether code action supports dynamic registration. _dynamicRegistration :: Maybe Bool, @@ -124,7 +131,30 @@ data CodeActionClientCapabilities = CodeActionClientCapabilities -- Since 3.8.0 _codeActionLiteralSupport :: Maybe CodeActionLiteralSupport, -- | Whether code action supports the `isPreferred` property. Since LSP 3.15.0 - _isPreferredSupport :: Maybe Bool + _isPreferredSupport :: Maybe Bool, + -- | Whether code action supports the `disabled` property. + -- + -- @since 3.16.0 + _disabledSupport :: Maybe Bool, + -- | Whether code action supports the `data` property which is + -- preserved between a `textDocument/codeAction` and a + -- `codeAction/resolve` request. + -- + -- @since 3.16.0 + _dataSupport :: Maybe Bool, + -- | Whether the client supports resolving additional code action + -- properties via a separate `codeAction/resolve` request. + -- + -- @since 3.16.0 + _resolveSupport :: Maybe CodeActionResolveClientCapabilities, + -- | Whether the client honors the change annotations in + -- text edits and resource operations returned via the + -- `CodeAction#edit` property by for example presenting + -- the workspace edit in the user interface and asking + -- for confirmation. + -- + -- @since 3.16.0 + _honorsChangeAnnotations :: Maybe Bool } deriving (Show, Read, Eq) @@ -133,7 +163,7 @@ deriveJSON lspOptions ''CodeActionClientCapabilities -- ------------------------------------- makeExtendingDatatype "CodeActionOptions" [''WorkDoneProgressOptions] - [("_codeActionKinds", [t| Maybe (List CodeActionKind) |])] + [("_codeActionKinds", [t| Maybe (List CodeActionKind) |]), ("_resolveProvider", [t| Maybe Bool |]) ] deriveJSON lspOptions ''CodeActionOptions makeExtendingDatatype "CodeActionRegistrationOptions" @@ -205,7 +235,12 @@ data CodeAction = -- | A command this code action executes. If a code action -- provides an edit and a command, first the edit is -- executed and then the command. - _command :: Maybe Command + _command :: Maybe Command, + -- | A data entry field that is preserved on a code action between + -- a `textDocument/codeAction` and a `codeAction/resolve` request. + -- + -- @since 3.16.0 + _xdata :: Maybe Value } deriving (Read, Show, Eq) deriveJSON lspOptions ''CodeAction diff --git a/lsp-types/src/Language/LSP/Types/Lens.hs b/lsp-types/src/Language/LSP/Types/Lens.hs index a3fc8eda8..d8aa03f6f 100644 --- a/lsp-types/src/Language/LSP/Types/Lens.hs +++ b/lsp-types/src/Language/LSP/Types/Lens.hs @@ -139,6 +139,7 @@ makeFieldsNoPrefix ''DeclarationParams makeFieldsNoPrefix ''CodeActionKindClientCapabilities makeFieldsNoPrefix ''CodeActionLiteralSupport makeFieldsNoPrefix ''CodeActionClientCapabilities +makeFieldsNoPrefix ''CodeActionResolveClientCapabilities makeFieldsNoPrefix ''CodeActionOptions makeFieldsNoPrefix ''CodeActionRegistrationOptions makeFieldsNoPrefix ''CodeActionContext diff --git a/src/Language/LSP/Server/Processing.hs b/src/Language/LSP/Server/Processing.hs index 25a8eed77..164f57e3a 100644 --- a/src/Language/LSP/Server/Processing.hs +++ b/src/Language/LSP/Server/Processing.hs @@ -210,9 +210,9 @@ inferServerCapabilities clientCaps o h = codeActionProvider | clientSupportsCodeActionKinds - , supported_b STextDocumentCodeAction = Just $ - maybe (InL True) (InR . CodeActionOptions Nothing . Just . List) - (codeActionKinds o) + , supported_b STextDocumentCodeAction = Just $ case codeActionKinds o of + Just ks -> InR $ CodeActionOptions Nothing (Just (List ks)) (supported SCodeLensResolve) + Nothing -> InL True | supported_b STextDocumentCodeAction = Just (InL True) | otherwise = Just (InL False) From 1e5a5678f9640bfb8d31720a007c5f536627291b Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sun, 7 Mar 2021 18:25:14 +0000 Subject: [PATCH 2/4] Add missing rename caps --- .../src/Language/LSP/Types/Capabilities.hs | 2 +- lsp-types/src/Language/LSP/Types/Rename.hs | 30 +++++++++++++++++++ 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/lsp-types/src/Language/LSP/Types/Capabilities.hs b/lsp-types/src/Language/LSP/Types/Capabilities.hs index 69adb3488..4d3304f0c 100644 --- a/lsp-types/src/Language/LSP/Types/Capabilities.hs +++ b/lsp-types/src/Language/LSP/Types/Capabilities.hs @@ -116,7 +116,7 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus (Just (CodeLensClientCapabilities dynamicReg)) (Just (DocumentLinkClientCapabilities dynamicReg (since 3 15 True))) (since 3 6 (DocumentColorClientCapabilities dynamicReg)) - (Just (RenameClientCapabilities dynamicReg (since 3 12 True))) + (Just (RenameClientCapabilities dynamicReg (since 3 12 True) (since 3 16 PsIdentifier) (since 3 16 True))) (Just publishDiagnosticsCapabilities) (since 3 10 foldingRangeCapability) (since 3 5 (SelectionRangeClientCapabilities dynamicReg)) diff --git a/lsp-types/src/Language/LSP/Types/Rename.hs b/lsp-types/src/Language/LSP/Types/Rename.hs index c0113b159..2a98e2304 100644 --- a/lsp-types/src/Language/LSP/Types/Rename.hs +++ b/lsp-types/src/Language/LSP/Types/Rename.hs @@ -3,14 +3,29 @@ module Language.LSP.Types.Rename where +import Data.Aeson import Data.Aeson.TH import Data.Text (Text) +import Data.Scientific (Scientific) import Language.LSP.Types.Location import Language.LSP.Types.TextDocument import Language.LSP.Types.Progress import Language.LSP.Types.Utils +data PrepareSupportDefaultBehavior = + PsIdentifier | + PsUnknown Scientific + deriving (Read, Show, Eq) + +instance ToJSON PrepareSupportDefaultBehavior where + toJSON PsIdentifier = Number 1 + toJSON (PsUnknown i) = Number i + +instance FromJSON PrepareSupportDefaultBehavior where + parseJSON (Number 1) = pure PsIdentifier + parseJSON _ = mempty + data RenameClientCapabilities = RenameClientCapabilities { -- | Whether rename supports dynamic registration. @@ -20,6 +35,21 @@ data RenameClientCapabilities = -- -- Since LSP 3.12.0 , _prepareSupport :: Maybe Bool + -- | Client supports the default behavior result + -- (`{ defaultBehavior: boolean }`). + -- + -- The value indicates the default behavior used by the client. + -- + -- @since 3.16.0 + , prepareSupportDefaultBehavior :: Maybe PrepareSupportDefaultBehavior + -- | Whether the client honors the change annotations in + -- text edits and resource operations returned via the + -- rename request's workspace edit by for example presenting + -- the workspace edit in the user interface and asking + -- for confirmation. + -- + -- @since 3.16.0 + , honorsChangeAnnotations :: Maybe Bool } deriving (Show, Read, Eq) deriveJSON lspOptions ''RenameClientCapabilities From 7662232efcdcfe10015e9a4cd43e5530b46a6d5a Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sun, 7 Mar 2021 18:26:31 +0000 Subject: [PATCH 3/4] Allow unknown completion item tags --- lsp-types/src/Language/LSP/Types/Capabilities.hs | 2 +- lsp-types/src/Language/LSP/Types/Completion.hs | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/lsp-types/src/Language/LSP/Types/Capabilities.hs b/lsp-types/src/Language/LSP/Types/Capabilities.hs index 4d3304f0c..f81a01b0e 100644 --- a/lsp-types/src/Language/LSP/Types/Capabilities.hs +++ b/lsp-types/src/Language/LSP/Types/Capabilities.hs @@ -149,7 +149,7 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus CompletionItemKindClientCapabilities (Just ciKs) completionItemTagsCapabilities = - CompletionItemTagsClientCapabilities (List [ CtDeprecated ]) + CompletionItemTagsClientCapabilities (List [ CitDeprecated ]) ciKs | maj >= 3 && min >= 4 = List (oldCiKs ++ newCiKs) diff --git a/lsp-types/src/Language/LSP/Types/Completion.hs b/lsp-types/src/Language/LSP/Types/Completion.hs index b6d844164..30b443fa8 100644 --- a/lsp-types/src/Language/LSP/Types/Completion.hs +++ b/lsp-types/src/Language/LSP/Types/Completion.hs @@ -100,14 +100,16 @@ instance A.FromJSON CompletionItemKind where data CompletionItemTag -- | Render a completion as obsolete, usually using a strike-out. - = CtDeprecated + = CitDeprecated + | CitUnknown Scientific deriving (Eq, Ord, Show, Read) instance A.ToJSON CompletionItemTag where - toJSON CtDeprecated = A.Number 1 + toJSON CitDeprecated = A.Number 1 + toJSON (CitUnknown i) = A.Number i instance A.FromJSON CompletionItemTag where - parseJSON (A.Number 1) = pure CtDeprecated + parseJSON (A.Number 1) = pure CitDeprecated parseJSON _ = mempty data CompletionItemTagsClientCapabilities = From 4dc01ef8ac8f7ad5a9c6544ce6147a74e19d597b Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sun, 7 Mar 2021 18:56:48 +0000 Subject: [PATCH 4/4] ChangeAnnotations and AnnotatedTextEdits --- example/Reactor.hs | 4 +- lsp-test/src/Language/LSP/Test.hs | 10 +- lsp-test/src/Language/LSP/Test/Files.hs | 2 +- lsp-test/src/Language/LSP/Test/Session.hs | 12 +- lsp-test/test/DummyServer.hs | 2 +- lsp-test/test/Test.hs | 2 +- .../src/Language/LSP/Types/Capabilities.hs | 4 +- lsp-types/src/Language/LSP/Types/Lens.hs | 3 + .../src/Language/LSP/Types/WorkspaceEdit.hs | 114 +++++++++++++++++- lsp-types/src/Language/LSP/VFS.hs | 23 ++-- src/Language/LSP/Server/Core.hs | 11 +- 11 files changed, 154 insertions(+), 33 deletions(-) diff --git a/example/Reactor.hs b/example/Reactor.hs index 5ce387feb..f0c618045 100644 --- a/example/Reactor.hs +++ b/example/Reactor.hs @@ -227,10 +227,10 @@ handle = mconcat newName = params ^. J.newName vdoc <- getVersionedTextDoc (params ^. J.textDocument) -- Replace some text at the position with what the user entered - let edit = J.TextEdit (J.mkRange l c l (c + T.length newName)) newName + let edit = J.InL $ J.TextEdit (J.mkRange l c l (c + T.length newName)) newName tde = J.TextDocumentEdit vdoc (J.List [edit]) -- "documentChanges" field is preferred over "changes" - rsp = J.WorkspaceEdit Nothing (Just (J.List [J.InL tde])) + rsp = J.WorkspaceEdit Nothing (Just (J.List [J.InL tde])) Nothing responder (Right rsp) , requestHandler J.STextDocumentHover $ \req responder -> do diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index ae2453065..fad6b965f 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -604,16 +604,16 @@ applyEdit doc edit = do let supportsDocChanges = fromMaybe False $ do let mWorkspace = caps ^. LSP.workspace C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace - C.WorkspaceEditClientCapabilities mDocChanges _ _ <- mEdit + C.WorkspaceEditClientCapabilities mDocChanges _ _ _ _ <- mEdit mDocChanges let wEdit = if supportsDocChanges then - let docEdit = TextDocumentEdit verDoc (List [edit]) - in WorkspaceEdit Nothing (Just (List [InL docEdit])) + let docEdit = TextDocumentEdit verDoc (List [InL edit]) + in WorkspaceEdit Nothing (Just (List [InL docEdit])) Nothing else let changes = HashMap.singleton (doc ^. uri) (List [edit]) - in WorkspaceEdit (Just changes) Nothing + in WorkspaceEdit (Just changes) Nothing Nothing let req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) updateState (FromServerMess SWorkspaceApplyEdit req) @@ -728,7 +728,7 @@ formatRange doc opts range = do applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session () applyTextEdits doc edits = - let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing + let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing Nothing -- Send a dummy message to updateState so it can do bookkeeping req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit) in updateState (FromServerMess SWorkspaceApplyEdit req) diff --git a/lsp-test/src/Language/LSP/Test/Files.hs b/lsp-test/src/Language/LSP/Test/Files.hs index 231f3e659..d27511264 100644 --- a/lsp-test/src/Language/LSP/Test/Files.hs +++ b/lsp-test/src/Language/LSP/Test/Files.hs @@ -84,7 +84,7 @@ mapUris f event = newDocChanges = fmap (fmap swapDocumentChangeUri) $ e ^. documentChanges newChanges = fmap (swapKeys f) $ e ^. changes - in WorkspaceEdit newChanges newDocChanges + in WorkspaceEdit newChanges newDocChanges Nothing swapKeys :: (Uri -> Uri) -> HM.HashMap Uri b -> HM.HashMap Uri b swapKeys f = HM.foldlWithKey' (\acc k v -> HM.insert (f k) v acc) HM.empty diff --git a/lsp-test/src/Language/LSP/Test/Session.hs b/lsp-test/src/Language/LSP/Test/Session.hs index 61695686e..43c87ccc1 100644 --- a/lsp-test/src/Language/LSP/Test/Session.hs +++ b/lsp-test/src/Language/LSP/Test/Session.hs @@ -8,6 +8,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} module Language.LSP.Test.Session ( Session(..) @@ -400,9 +401,12 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do return $ s { vfs = newVFS } getParamsFromTextDocumentEdit :: TextDocumentEdit -> DidChangeTextDocumentParams - getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) = - let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits - in DidChangeTextDocumentParams docId (List changeEvents) + getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) = + DidChangeTextDocumentParams docId (List $ map editToChangeEvent edits) + + editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent + editToChangeEvent (InR e) = TextDocumentContentChangeEvent (Just $ e ^. range) Nothing (e ^. newText) + editToChangeEvent (InL e) = TextDocumentContentChangeEvent (Just $ e ^. range) Nothing (e ^. newText) getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams getParamsFromDocumentChange (InL textDocumentEdit) = Just $ getParamsFromTextDocumentEdit textDocumentEdit @@ -419,7 +423,7 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do textDocumentEdits uri edits = do vers <- textDocumentVersions uri - pure $ map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip vers edits + pure $ map (\(v, e) -> TextDocumentEdit v (List [InL e])) $ zip vers edits getChangeParams uri (List edits) = do map <$> pure getParamsFromTextDocumentEdit <*> textDocumentEdits uri (reverse edits) diff --git a/lsp-test/test/DummyServer.hs b/lsp-test/test/DummyServer.hs index 599bcc5dc..6e7e70e2e 100644 --- a/lsp-test/test/DummyServer.hs +++ b/lsp-test/test/DummyServer.hs @@ -143,7 +143,7 @@ handlers = edit = List [TextEdit (mkRange 0 0 0 5) "howdy"] params = ApplyWorkspaceEditParams (Just "Howdy edit") $ - WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing + WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing Nothing resp $ Right Null void $ sendRequest SWorkspaceApplyEdit params (const (pure ())) , requestHandler STextDocumentCodeAction $ \req resp -> do diff --git a/lsp-test/test/Test.hs b/lsp-test/test/Test.hs index 98269582c..713c11950 100644 --- a/lsp-test/test/Test.hs +++ b/lsp-test/test/Test.hs @@ -368,4 +368,4 @@ docChangesCaps :: ClientCapabilities docChangesCaps = def { _workspace = Just workspaceCaps } where workspaceCaps = def { _workspaceEdit = Just editCaps } - editCaps = WorkspaceEditClientCapabilities (Just True) Nothing Nothing + editCaps = WorkspaceEditClientCapabilities (Just True) Nothing Nothing Nothing Nothing diff --git a/lsp-types/src/Language/LSP/Types/Capabilities.hs b/lsp-types/src/Language/LSP/Types/Capabilities.hs index f81a01b0e..798ccf679 100644 --- a/lsp-types/src/Language/LSP/Types/Capabilities.hs +++ b/lsp-types/src/Language/LSP/Types/Capabilities.hs @@ -42,7 +42,9 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus (Just (WorkspaceEditClientCapabilities (Just True) (since 3 13 resourceOperations) - Nothing)) + Nothing + (since 3 16 True) + (since 3 16 (WorkspaceEditChangeAnnotationClientCapabilities (Just True))))) (Just (DidChangeConfigurationClientCapabilities dynamicReg)) (Just (DidChangeWatchedFilesClientCapabilities dynamicReg)) (Just symbolCapabilities) diff --git a/lsp-types/src/Language/LSP/Types/Lens.hs b/lsp-types/src/Language/LSP/Types/Lens.hs index d8aa03f6f..c0eb40ff2 100644 --- a/lsp-types/src/Language/LSP/Types/Lens.hs +++ b/lsp-types/src/Language/LSP/Types/Lens.hs @@ -243,6 +243,8 @@ makeFieldsNoPrefix ''DocumentFilter -- WorkspaceEdit makeFieldsNoPrefix ''TextEdit +makeFieldsNoPrefix ''ChangeAnnotation +makeFieldsNoPrefix ''AnnotatedTextEdit makeFieldsNoPrefix ''VersionedTextDocumentIdentifier makeFieldsNoPrefix ''TextDocumentEdit makeFieldsNoPrefix ''CreateFileOptions @@ -253,6 +255,7 @@ makeFieldsNoPrefix ''DeleteFileOptions makeFieldsNoPrefix ''DeleteFile makeFieldsNoPrefix ''WorkspaceEdit makeFieldsNoPrefix ''WorkspaceEditClientCapabilities +makeFieldsNoPrefix ''WorkspaceEditChangeAnnotationClientCapabilities -- Workspace Folders makeFieldsNoPrefix ''WorkspaceFolder diff --git a/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs b/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs index d61851125..7b39aff85 100644 --- a/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs +++ b/lsp-types/src/Language/LSP/Types/WorkspaceEdit.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Language.LSP.Types.WorkspaceEdit where @@ -13,6 +14,7 @@ import qualified Data.HashMap.Strict as H import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T +import Data.Hashable import Language.LSP.Types.Common import Language.LSP.Types.Location @@ -30,13 +32,47 @@ data TextEdit = deriveJSON lspOptions ''TextEdit +-- --------------------------------------------------------------------- + +{-| +Additional information that describes document changes. + +@since 3.16.0 +-} +data ChangeAnnotation = + ChangeAnnotation + { -- | A human-readable string describing the actual change. The string + -- is rendered prominent in the user interface. + _label :: Text + -- | A flag which indicates that user confirmation is needed + -- before applying the change. + , _needsConfirmation :: Maybe Bool + -- | A human-readable string which is rendered less prominent in + -- the user interface. + , _description :: Maybe Text + } deriving (Show, Read, Eq) + +deriveJSON lspOptions ''ChangeAnnotation + +{-| +An identifier referring to a change annotation managed by a workspace +edit. + +@since 3.16.0 +-} +newtype ChangeAnnotationIdentifier = ChangeAnnotationIdentifierId Text + deriving (Show, Read, Eq, FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable) + +makeExtendingDatatype "AnnotatedTextEdit" [''TextEdit] + [("_annotationId", [t| ChangeAnnotationIdentifier |]) ] +deriveJSON lspOptions ''AnnotatedTextEdit -- --------------------------------------------------------------------- data TextDocumentEdit = TextDocumentEdit { _textDocument :: VersionedTextDocumentIdentifier - , _edits :: List TextEdit + , _edits :: List (TextEdit |? AnnotatedTextEdit) } deriving (Show, Read, Eq) deriveJSON lspOptions ''TextDocumentEdit @@ -61,6 +97,10 @@ data CreateFile = _uri :: Uri -- | Additional options , _options :: Maybe CreateFileOptions + -- | An optional annotation identifer describing the operation. + -- + -- @since 3.16.0 + , _annotationId :: Maybe ChangeAnnotationIdentifier } deriving (Show, Read, Eq) instance ToJSON CreateFile where @@ -69,6 +109,7 @@ instance ToJSON CreateFile where [ Just $ "kind" .= ("create" :: Text) , Just $ "uri" .= _uri , ("options" .=) <$> _options + , ("annotationId" .=) <$> _annotationId ] instance FromJSON CreateFile where @@ -78,6 +119,7 @@ instance FromJSON CreateFile where $ fail $ "Expected kind \"create\" but got " ++ show kind _uri <- o .: "uri" _options <- o .:? "options" + _annotationId <- o .:? "annotationId" pure CreateFile{..} -- Rename file options @@ -100,6 +142,10 @@ data RenameFile = , _newUri :: Uri -- | Rename options. , _options :: Maybe RenameFileOptions + -- | An optional annotation identifer describing the operation. + -- + -- @since 3.16.0 + , _annotationId :: Maybe ChangeAnnotationIdentifier } deriving (Show, Read, Eq) instance ToJSON RenameFile where @@ -109,6 +155,7 @@ instance ToJSON RenameFile where , Just $ "oldUri" .= _oldUri , Just $ "newUri" .= _newUri , ("options" .=) <$> _options + , ("annotationId" .=) <$> _annotationId ] instance FromJSON RenameFile where @@ -119,6 +166,7 @@ instance FromJSON RenameFile where _oldUri <- o .: "oldUri" _newUri <- o .: "newUri" _options <- o .:? "options" + _annotationId <- o .:? "annotationId" pure RenameFile{..} -- Delete file options @@ -139,6 +187,10 @@ data DeleteFile = _uri :: Uri -- | Delete options. , _options :: Maybe DeleteFileOptions + -- | An optional annotation identifer describing the operation. + -- + -- @since 3.16.0 + , _annotationId :: Maybe ChangeAnnotationIdentifier } deriving (Show, Read, Eq) instance ToJSON DeleteFile where @@ -147,6 +199,7 @@ instance ToJSON DeleteFile where [ Just $ "kind" .= ("delete" :: Text) , Just $ "uri" .= _uri , ("options" .=) <$> _options + , ("annotationId" .=) <$> _annotationId ] instance FromJSON DeleteFile where @@ -156,9 +209,9 @@ instance FromJSON DeleteFile where $ fail $ "Expected kind \"delete\" but got " ++ show kind _uri <- o .: "uri" _options <- o .:? "options" + _annotationId <- o .:? "annotationId" pure DeleteFile{..} - -- --------------------------------------------------------------------- -- | `TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile` is a bit mouthful, here's the synonym @@ -167,17 +220,42 @@ type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile -- --------------------------------------------------------------------- type WorkspaceEditMap = H.HashMap Uri (List TextEdit) +type ChangeAnnotationMap = H.HashMap ChangeAnnotationIdentifier ChangeAnnotation data WorkspaceEdit = WorkspaceEdit - { _changes :: Maybe WorkspaceEditMap - , _documentChanges :: Maybe (List DocumentChange) + { + -- | Holds changes to existing resources. + _changes :: Maybe WorkspaceEditMap + -- | Depending on the client capability + -- `workspace.workspaceEdit.resourceOperations` document changes are either + -- an array of `TextDocumentEdit`s to express changes to n different text + -- documents where each text document edit addresses a specific version of + -- a text document. Or it can contain above `TextDocumentEdit`s mixed with + -- create, rename and delete file / folder operations. + -- + -- Whether a client supports versioned document edits is expressed via + -- `workspace.workspaceEdit.documentChanges` client capability. + -- + -- If a client neither supports `documentChanges` nor + -- `workspace.workspaceEdit.resourceOperations` then only plain `TextEdit`s + -- using the `changes` property are supported. + , _documentChanges :: Maybe (List DocumentChange) + -- | A map of change annotations that can be referenced in + -- `AnnotatedTextEdit`s or create, rename and delete file / folder + -- operations. + -- + -- Whether clients honor this property depends on the client capability + -- `workspace.changeAnnotationSupport`. + -- + -- @since 3.16.0 + , _changeAnnotations :: Maybe ChangeAnnotationMap } deriving (Show, Read, Eq) instance Semigroup WorkspaceEdit where - (WorkspaceEdit a b) <> (WorkspaceEdit c d) = WorkspaceEdit (a <> c) (b <> d) + (WorkspaceEdit a b c) <> (WorkspaceEdit a' b' c') = WorkspaceEdit (a <> a') (b <> b') (c <> c') instance Monoid WorkspaceEdit where - mempty = WorkspaceEdit Nothing Nothing + mempty = WorkspaceEdit Nothing Nothing Nothing deriveJSON lspOptions ''WorkspaceEdit @@ -220,6 +298,17 @@ instance FromJSON FailureHandlingKind where parseJSON (String "undo") = pure FailureHandlingUndo parseJSON _ = mempty +data WorkspaceEditChangeAnnotationClientCapabilities = + WorkspaceEditChangeAnnotationClientCapabilities + { + -- | Whether the client groups edits with equal labels into tree nodes, + -- for instance all edits labelled with "Changes in Strings" would + -- be a tree node. + groupsOnLabel :: Maybe Bool + } deriving (Show, Read, Eq) + +deriveJSON lspOptions ''WorkspaceEditChangeAnnotationClientCapabilities + data WorkspaceEditClientCapabilities = WorkspaceEditClientCapabilities { _documentChanges :: Maybe Bool -- ^The client supports versioned document @@ -230,6 +319,19 @@ data WorkspaceEditClientCapabilities = -- | The failure handling strategy of a client if applying the workspace edit -- fails. , _failureHandling :: Maybe FailureHandlingKind + -- | Whether the client normalizes line endings to the client specific + -- setting. + -- + -- If set to `true` the client will normalize line ending characters + -- in a workspace edit to the client specific new line character(s). + -- + -- @since 3.16.0 + , _normalizesLineEndings :: Maybe Bool + -- | Whether the client in general supports change annotations on text edits, + -- create file, rename file and delete file changes. + -- + -- @since 3.16.0 + , _changeAnnotationSupport :: Maybe WorkspaceEditChangeAnnotationClientCapabilities } deriving (Show, Read, Eq) deriveJSON lspOptions ''WorkspaceEditClientCapabilities diff --git a/lsp-types/src/Language/LSP/VFS.hs b/lsp-types/src/Language/LSP/VFS.hs index 647d83f2b..608276698 100644 --- a/lsp-types/src/Language/LSP/VFS.hs +++ b/lsp-types/src/Language/LSP/VFS.hs @@ -6,6 +6,7 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} {-| Handles the "Language.LSP.Types.TextDocumentDidChange" \/ @@ -130,7 +131,7 @@ updateVFS f vfs@VFS{vfsMap} = vfs { vfsMap = f vfsMap } -- --------------------------------------------------------------------- applyCreateFile :: J.CreateFile -> VFS -> VFS -applyCreateFile (J.CreateFile uri options) = +applyCreateFile (J.CreateFile uri options _ann) = updateVFS $ Map.insertWith (\ new old -> if shouldOverwrite then new else old) (J.toNormalizedUri uri) @@ -150,7 +151,7 @@ applyCreateFile (J.CreateFile uri options) = Just (J.CreateFileOptions (Just False) (Just False)) -> False -- `overwrite` wins over `ignoreIfExists` applyRenameFile :: J.RenameFile -> VFS -> VFS -applyRenameFile (J.RenameFile oldUri' newUri' options) vfs = +applyRenameFile (J.RenameFile oldUri' newUri' options _ann) vfs = let oldUri = J.toNormalizedUri oldUri' newUri = J.toNormalizedUri newUri' in case Map.lookup oldUri (vfsMap vfs) of @@ -178,7 +179,7 @@ applyRenameFile (J.RenameFile oldUri' newUri' options) vfs = -- NOTE: we are ignoring the `recursive` option here because we don't know which file is a directory applyDeleteFile :: J.DeleteFile -> VFS -> VFS -applyDeleteFile (J.DeleteFile uri _options) = +applyDeleteFile (J.DeleteFile uri _options _ann) = updateVFS $ Map.delete (J.toNormalizedUri uri) @@ -186,7 +187,7 @@ applyTextDocumentEdit :: J.TextDocumentEdit -> VFS -> IO VFS applyTextDocumentEdit (J.TextDocumentEdit vid (J.List edits)) vfs = do -- all edits are supposed to be applied at once -- so apply from bottom up so they don't affect others - let sortedEdits = sortOn (Down . (^. J.range)) edits + let sortedEdits = sortOn (Down . editRange) edits changeEvents = map editToChangeEvent sortedEdits ps = J.DidChangeTextDocumentParams vid (J.List changeEvents) notif = J.NotificationMessage "" J.STextDocumentDidChange ps @@ -194,8 +195,14 @@ applyTextDocumentEdit (J.TextDocumentEdit vid (J.List edits)) vfs = do mapM_ (debugM "haskell-lsp.applyTextDocumentEdit") ls return vfs' - where - editToChangeEvent (J.TextEdit range text) = J.TextDocumentContentChangeEvent (Just range) Nothing text + where + editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range + editRange (J.InR e) = e ^. J.range + editRange (J.InL e) = e ^. J.range + + editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent + editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent (Just $ e ^. J.range) Nothing (e ^. J.newText) + editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent (Just $ e ^. J.range) Nothing (e ^. J.newText) applyDocumentChange :: J.DocumentChange -> VFS -> IO VFS applyDocumentChange (J.InL change) = applyTextDocumentEdit change @@ -207,7 +214,7 @@ applyDocumentChange (J.InR (J.InR (J.InR change))) = return . applyDeleteFile ch changeFromServerVFS :: VFS -> J.Message 'J.WorkspaceApplyEdit -> IO VFS changeFromServerVFS initVfs (J.RequestMessage _ _ _ params) = do let J.ApplyWorkspaceEditParams _label edit = params - J.WorkspaceEdit mChanges mDocChanges = edit + J.WorkspaceEdit mChanges mDocChanges _anns = edit case mDocChanges of Just (J.List docChanges) -> applyDocumentChanges docChanges Nothing -> case mChanges of @@ -218,7 +225,7 @@ changeFromServerVFS initVfs (J.RequestMessage _ _ _ params) = do where changeToTextDocumentEdit acc uri edits = - acc ++ [J.TextDocumentEdit (J.VersionedTextDocumentIdentifier uri (Just 0)) edits] + acc ++ [J.TextDocumentEdit (J.VersionedTextDocumentIdentifier uri (Just 0)) (fmap J.InL edits)] applyDocumentChanges :: [J.DocumentChange] -> IO VFS applyDocumentChanges = foldM (flip applyDocumentChange) initVfs . sortOn project diff --git a/src/Language/LSP/Server/Core.hs b/src/Language/LSP/Server/Core.hs index 2ea84ff5e..ba5db19f7 100644 --- a/src/Language/LSP/Server/Core.hs +++ b/src/Language/LSP/Server/Core.hs @@ -50,6 +50,7 @@ import qualified Data.List as L import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map.Strict as Map import Data.Maybe +import Data.Ord (Down (Down)) import qualified Data.Text as T import Data.Text ( Text ) import qualified Data.UUID as UUID @@ -759,7 +760,7 @@ handleIOException logFile _ = do -- | The changes in a workspace edit should be applied from the end of the file -- toward the start. Sort them into this order. reverseSortEdit :: J.WorkspaceEdit -> J.WorkspaceEdit -reverseSortEdit (J.WorkspaceEdit cs dcs) = J.WorkspaceEdit cs' dcs' +reverseSortEdit (J.WorkspaceEdit cs dcs anns) = J.WorkspaceEdit cs' dcs' anns where cs' :: Maybe J.WorkspaceEditMap cs' = (fmap . fmap ) sortTextEdits cs @@ -768,12 +769,14 @@ reverseSortEdit (J.WorkspaceEdit cs dcs) = J.WorkspaceEdit cs' dcs' dcs' = (fmap . fmap) sortOnlyTextDocumentEdits dcs sortTextEdits :: J.List J.TextEdit -> J.List J.TextEdit - sortTextEdits (J.List edits) = J.List (L.sortBy down edits) + sortTextEdits (J.List edits) = J.List (L.sortOn (Down . (^. J.range)) edits) sortOnlyTextDocumentEdits :: J.DocumentChange -> J.DocumentChange sortOnlyTextDocumentEdits (J.InL (J.TextDocumentEdit td (J.List edits))) = J.InL $ J.TextDocumentEdit td (J.List edits') where - edits' = L.sortBy down edits + edits' = L.sortOn (Down . editRange) edits sortOnlyTextDocumentEdits (J.InR others) = J.InR others - down (J.TextEdit r1 _) (J.TextEdit r2 _) = r2 `compare` r1 + editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range + editRange (J.InR e) = e ^. J.range + editRange (J.InL e) = e ^. J.range