Support change annotations (#302)

* Add missing code action caps

* Add missing rename caps

* Allow unknown completion item tags

* ChangeAnnotations and AnnotatedTextEdits

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

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)

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

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)

lsp-test/test/DummyServer.hs

@@ -144,7 +144,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
@@ -161,6 +161,7 @@ handlers =
                 Nothing
                 Nothing
                 (Just (Command "" "deleteThis" Nothing))
+                Nothing
         resp $ Right $ InR <$> codeActions
      , requestHandler STextDocumentCompletion $ \_req resp -> do
         let res = CompletionList True (List [item])

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

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)
@@ -120,7 +122,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))
@@ -153,7 +155,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)
@@ -198,6 +200,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

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

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 =

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
@@ -242,6 +243,8 @@ makeFieldsNoPrefix ''DocumentFilter
 
 -- WorkspaceEdit
 makeFieldsNoPrefix ''TextEdit
+makeFieldsNoPrefix ''ChangeAnnotation
+makeFieldsNoPrefix ''AnnotatedTextEdit
 makeFieldsNoPrefix ''VersionedTextDocumentIdentifier
 makeFieldsNoPrefix ''TextDocumentEdit
 makeFieldsNoPrefix ''CreateFileOptions
@@ -252,6 +255,7 @@ makeFieldsNoPrefix ''DeleteFileOptions
 makeFieldsNoPrefix ''DeleteFile
 makeFieldsNoPrefix ''WorkspaceEdit
 makeFieldsNoPrefix ''WorkspaceEditClientCapabilities
+makeFieldsNoPrefix ''WorkspaceEditChangeAnnotationClientCapabilities
 
 -- Workspace Folders
 makeFieldsNoPrefix ''WorkspaceFolder

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